Changes On Branch 72e1cbdd569213e7
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch unchained Through [72e1cbdd56] Excluding Merge-Ins

This is equivalent to a diff from 8d9bc901e3 to 72e1cbdd56

2024-09-14
12:24
Add generci/tclDate.h. check-in: 5d0a381167 user: pooryorick tags: unchained, INCOMPATIBLE_LICENSE
12:16
Merge [8d9bc901e37c4f27]: 3th "load" argument should be Titlecase Fix registry library name for Tcl ... check-in: 72e1cbdd56 user: pooryorick tags: unchained, INCOMPATIBLE_LICENSE
12:14
Further fix to fossil tracking to that merging clock.tcl from trunk affects clock.tcl, not clockclas... check-in: 045cc4e183 user: pooryorick tags: unchained, INCOMPATIBLE_LICENSE
2024-09-11
06:31
Add tcl::idna, expr operators, oo to changes.md check-in: 52a5f4ab95 user: apnadkarni tags: trunk, main
2024-09-10
19:58
3th "load" argument should be Titlecase Fix registry library name for Tcl 9 check-in: 8d9bc901e3 user: jan.nijtmans tags: trunk, main
19:48
3th "load" argument should be Titlecase check-in: e75679b59a user: jan.nijtmans tags: core-8-branch
13:27
merge 8.7 check-in: a4c3f6a3e8 user: dgp tags: trunk, main

Changes to .fossil-settings/ignore-glob.
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
56
57
58
59
60
61
62

63
64
65
66

67
68
69
70
71







-




-





unix/dltest/*.o
unix/dltest/*.sl
unix/dltest/*.so
unix/tcl.pc
unix/tclIndex
unix/Tcl-Info.plist
unix/Tclsh-Info.plist
unix/pkgs8/*
unix/pkgs/*
win/Debug*
win/Release*
win/*.manifest
win/pkgs8/*
win/pkgs/*
win/coffbase.txt
win/tcl.hpj
win/nmakehlp.out
win/nmhlp-out.txt
Changes to .github/workflows/linux-build.yml.
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
12
13
14
15
16
17
18

19
20
21
22
23
24
25







-







jobs:
  gcc:
    runs-on: ubuntu-22.04
    strategy:
      matrix:
        config:
          - ""
          - "CFLAGS=-DTCL_NO_DEPRECATED=1"
          - "--disable-shared"
          - "--disable-zipfs"
          - "--enable-symbols"
          - "--enable-symbols=mem"
          - "--enable-symbols=all"
          - "CFLAGS=-ftrapv"
          # Duplicated below
Changes to .github/workflows/win-build.yml.
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
62
63
64
65
66
67
68

69
70
71
72
73
74
75







-







      run:
        shell: msys2 {0}
        working-directory: win
    strategy:
      matrix:
        config:
          - ""
          - "CFLAGS=-DTCL_NO_DEPRECATED=1"
          - "--disable-shared"
          - "--disable-zipfs"
          - "--enable-symbols"
          - "--enable-symbols=mem"
          - "--enable-symbols=all"
    # Using powershell means we need to explicitly stop on failure
    steps:
Changes to .gitignore.
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
52
53
54
55
56
57
58

59
60
61
62

63
64
65
66
67







-




-





libtommath/*.tex
macosx/configure
unix/autoMkindex.tcl
unix/dltest.marker
unix/dltest/embtest
unix/tcl.pc
unix/tclIndex
unix/pkgs8/*
unix/pkgs/*
win/Debug*
win/Release*
win/*.manifest
win/pkgs8/*
win/pkgs/*
win/coffbase.txt
win/tcl.hpj
win/nmakehlp.out
win/nmhlp-out.txt
Added COPYING.





















































































































































































































































































































































































































































































































































































































































































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
                    GNU AFFERO GENERAL PUBLIC LICENSE
                       Version 3, 19 November 2007

 Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
 Everyone is permitted to copy and distribute verbatim copies
 of this license document, but changing it is not allowed.

                            Preamble

  The GNU Affero General Public License is a free, copyleft license for
software and other kinds of works, specifically designed to ensure
cooperation with the community in the case of network server software.

  The licenses for most software and other practical works are designed
to take away your freedom to share and change the works.  By contrast,
our General Public Licenses are intended to guarantee your freedom to
share and change all versions of a program--to make sure it remains free
software for all its users.

  When we speak of free software, we are referring to freedom, not
price.  Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
them if you wish), that you receive source code or can get it if you
want it, that you can change the software or use pieces of it in new
free programs, and that you know you can do these things.

  Developers that use our General Public Licenses protect your rights
with two steps: (1) assert copyright on the software, and (2) offer
you this License which gives you legal permission to copy, distribute
and/or modify the software.

  A secondary benefit of defending all users' freedom is that
improvements made in alternate versions of the program, if they
receive widespread use, become available for other developers to
incorporate.  Many developers of free software are heartened and
encouraged by the resulting cooperation.  However, in the case of
software used on network servers, this result may fail to come about.
The GNU General Public License permits making a modified version and
letting the public access it on a server without ever releasing its
source code to the public.

  The GNU Affero General Public License is designed specifically to
ensure that, in such cases, the modified source code becomes available
to the community.  It requires the operator of a network server to
provide the source code of the modified version running there to the
users of that server.  Therefore, public use of a modified version, on
a publicly accessible server, gives the public access to the source
code of the modified version.

  An older license, called the Affero General Public License and
published by Affero, was designed to accomplish similar goals.  This is
a different license, not a version of the Affero GPL, but Affero has
released a new version of the Affero GPL which permits relicensing under
this license.

  The precise terms and conditions for copying, distribution and
modification follow.

                       TERMS AND CONDITIONS

  0. Definitions.

  "This License" refers to version 3 of the GNU Affero General Public License.

  "Copyright" also means copyright-like laws that apply to other kinds of
works, such as semiconductor masks.

  "The Program" refers to any copyrightable work licensed under this
License.  Each licensee is addressed as "you".  "Licensees" and
"recipients" may be individuals or organizations.

  To "modify" a work means to copy from or adapt all or part of the work
in a fashion requiring copyright permission, other than the making of an
exact copy.  The resulting work is called a "modified version" of the
earlier work or a work "based on" the earlier work.

  A "covered work" means either the unmodified Program or a work based
on the Program.

  To "propagate" a work means to do anything with it that, without
permission, would make you directly or secondarily liable for
infringement under applicable copyright law, except executing it on a
computer or modifying a private copy.  Propagation includes copying,
distribution (with or without modification), making available to the
public, and in some countries other activities as well.

  To "convey" a work means any kind of propagation that enables other
parties to make or receive copies.  Mere interaction with a user through
a computer network, with no transfer of a copy, is not conveying.

  An interactive user interface displays "Appropriate Legal Notices"
to the extent that it includes a convenient and prominently visible
feature that (1) displays an appropriate copyright notice, and (2)
tells the user that there is no warranty for the work (except to the
extent that warranties are provided), that licensees may convey the
work under this License, and how to view a copy of this License.  If
the interface presents a list of user commands or options, such as a
menu, a prominent item in the list meets this criterion.

  1. Source Code.

  The "source code" for a work means the preferred form of the work
for making modifications to it.  "Object code" means any non-source
form of a work.

  A "Standard Interface" means an interface that either is an official
standard defined by a recognized standards body, or, in the case of
interfaces specified for a particular programming language, one that
is widely used among developers working in that language.

  The "System Libraries" of an executable work include anything, other
than the work as a whole, that (a) is included in the normal form of
packaging a Major Component, but which is not part of that Major
Component, and (b) serves only to enable use of the work with that
Major Component, or to implement a Standard Interface for which an
implementation is available to the public in source code form.  A
"Major Component", in this context, means a major essential component
(kernel, window system, and so on) of the specific operating system
(if any) on which the executable work runs, or a compiler used to
produce the work, or an object code interpreter used to run it.

  The "Corresponding Source" for a work in object code form means all
the source code needed to generate, install, and (for an executable
work) run the object code and to modify the work, including scripts to
control those activities.  However, it does not include the work's
System Libraries, or general-purpose tools or generally available free
programs which are used unmodified in performing those activities but
which are not part of the work.  For example, Corresponding Source
includes interface definition files associated with source files for
the work, and the source code for shared libraries and dynamically
linked subprograms that the work is specifically designed to require,
such as by intimate data communication or control flow between those
subprograms and other parts of the work.

  The Corresponding Source need not include anything that users
can regenerate automatically from other parts of the Corresponding
Source.

  The Corresponding Source for a work in source code form is that
same work.

  2. Basic Permissions.

  All rights granted under this License are granted for the term of
copyright on the Program, and are irrevocable provided the stated
conditions are met.  This License explicitly affirms your unlimited
permission to run the unmodified Program.  The output from running a
covered work is covered by this License only if the output, given its
content, constitutes a covered work.  This License acknowledges your
rights of fair use or other equivalent, as provided by copyright law.

  You may make, run and propagate covered works that you do not
convey, without conditions so long as your license otherwise remains
in force.  You may convey covered works to others for the sole purpose
of having them make modifications exclusively for you, or provide you
with facilities for running those works, provided that you comply with
the terms of this License in conveying all material for which you do
not control copyright.  Those thus making or running the covered works
for you must do so exclusively on your behalf, under your direction
and control, on terms that prohibit them from making any copies of
your copyrighted material outside their relationship with you.

  Conveying under any other circumstances is permitted solely under
the conditions stated below.  Sublicensing is not allowed; section 10
makes it unnecessary.

  3. Protecting Users' Legal Rights From Anti-Circumvention Law.

  No covered work shall be deemed part of an effective technological
measure under any applicable law fulfilling obligations under article
11 of the WIPO copyright treaty adopted on 20 December 1996, or
similar laws prohibiting or restricting circumvention of such
measures.

  When you convey a covered work, you waive any legal power to forbid
circumvention of technological measures to the extent such circumvention
is effected by exercising rights under this License with respect to
the covered work, and you disclaim any intention to limit operation or
modification of the work as a means of enforcing, against the work's
users, your or third parties' legal rights to forbid circumvention of
technological measures.

  4. Conveying Verbatim Copies.

  You may convey verbatim copies of the Program's source code as you
receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice;
keep intact all notices stating that this License and any
non-permissive terms added in accord with section 7 apply to the code;
keep intact all notices of the absence of any warranty; and give all
recipients a copy of this License along with the Program.

  You may charge any price or no price for each copy that you convey,
and you may offer support or warranty protection for a fee.

  5. Conveying Modified Source Versions.

  You may convey a work based on the Program, or the modifications to
produce it from the Program, in the form of source code under the
terms of section 4, provided that you also meet all of these conditions:

    a) The work must carry prominent notices stating that you modified
    it, and giving a relevant date.

    b) The work must carry prominent notices stating that it is
    released under this License and any conditions added under section
    7.  This requirement modifies the requirement in section 4 to
    "keep intact all notices".

    c) You must license the entire work, as a whole, under this
    License to anyone who comes into possession of a copy.  This
    License will therefore apply, along with any applicable section 7
    additional terms, to the whole of the work, and all its parts,
    regardless of how they are packaged.  This License gives no
    permission to license the work in any other way, but it does not
    invalidate such permission if you have separately received it.

    d) If the work has interactive user interfaces, each must display
    Appropriate Legal Notices; however, if the Program has interactive
    interfaces that do not display Appropriate Legal Notices, your
    work need not make them do so.

  A compilation of a covered work with other separate and independent
works, which are not by their nature extensions of the covered work,
and which are not combined with it such as to form a larger program,
in or on a volume of a storage or distribution medium, is called an
"aggregate" if the compilation and its resulting copyright are not
used to limit the access or legal rights of the compilation's users
beyond what the individual works permit.  Inclusion of a covered work
in an aggregate does not cause this License to apply to the other
parts of the aggregate.

  6. Conveying Non-Source Forms.

  You may convey a covered work in object code form under the terms
of sections 4 and 5, provided that you also convey the
machine-readable Corresponding Source under the terms of this License,
in one of these ways:

    a) Convey the object code in, or embodied in, a physical product
    (including a physical distribution medium), accompanied by the
    Corresponding Source fixed on a durable physical medium
    customarily used for software interchange.

    b) Convey the object code in, or embodied in, a physical product
    (including a physical distribution medium), accompanied by a
    written offer, valid for at least three years and valid for as
    long as you offer spare parts or customer support for that product
    model, to give anyone who possesses the object code either (1) a
    copy of the Corresponding Source for all the software in the
    product that is covered by this License, on a durable physical
    medium customarily used for software interchange, for a price no
    more than your reasonable cost of physically performing this
    conveying of source, or (2) access to copy the
    Corresponding Source from a network server at no charge.

    c) Convey individual copies of the object code with a copy of the
    written offer to provide the Corresponding Source.  This
    alternative is allowed only occasionally and noncommercially, and
    only if you received the object code with such an offer, in accord
    with subsection 6b.

    d) Convey the object code by offering access from a designated
    place (gratis or for a charge), and offer equivalent access to the
    Corresponding Source in the same way through the same place at no
    further charge.  You need not require recipients to copy the
    Corresponding Source along with the object code.  If the place to
    copy the object code is a network server, the Corresponding Source
    may be on a different server (operated by you or a third party)
    that supports equivalent copying facilities, provided you maintain
    clear directions next to the object code saying where to find the
    Corresponding Source.  Regardless of what server hosts the
    Corresponding Source, you remain obligated to ensure that it is
    available for as long as needed to satisfy these requirements.

    e) Convey the object code using peer-to-peer transmission, provided
    you inform other peers where the object code and Corresponding
    Source of the work are being offered to the general public at no
    charge under subsection 6d.

  A separable portion of the object code, whose source code is excluded
from the Corresponding Source as a System Library, need not be
included in conveying the object code work.

  A "User Product" is either (1) a "consumer product", which means any
tangible personal property which is normally used for personal, family,
or household purposes, or (2) anything designed or sold for incorporation
into a dwelling.  In determining whether a product is a consumer product,
doubtful cases shall be resolved in favor of coverage.  For a particular
product received by a particular user, "normally used" refers to a
typical or common use of that class of product, regardless of the status
of the particular user or of the way in which the particular user
actually uses, or expects or is expected to use, the product.  A product
is a consumer product regardless of whether the product has substantial
commercial, industrial or non-consumer uses, unless such uses represent
the only significant mode of use of the product.

  "Installation Information" for a User Product means any methods,
procedures, authorization keys, or other information required to install
and execute modified versions of a covered work in that User Product from
a modified version of its Corresponding Source.  The information must
suffice to ensure that the continued functioning of the modified object
code is in no case prevented or interfered with solely because
modification has been made.

  If you convey an object code work under this section in, or with, or
specifically for use in, a User Product, and the conveying occurs as
part of a transaction in which the right of possession and use of the
User Product is transferred to the recipient in perpetuity or for a
fixed term (regardless of how the transaction is characterized), the
Corresponding Source conveyed under this section must be accompanied
by the Installation Information.  But this requirement does not apply
if neither you nor any third party retains the ability to install
modified object code on the User Product (for example, the work has
been installed in ROM).

  The requirement to provide Installation Information does not include a
requirement to continue to provide support service, warranty, or updates
for a work that has been modified or installed by the recipient, or for
the User Product in which it has been modified or installed.  Access to a
network may be denied when the modification itself materially and
adversely affects the operation of the network or violates the rules and
protocols for communication across the network.

  Corresponding Source conveyed, and Installation Information provided,
in accord with this section must be in a format that is publicly
documented (and with an implementation available to the public in
source code form), and must require no special password or key for
unpacking, reading or copying.

  7. Additional Terms.

  "Additional permissions" are terms that supplement the terms of this
License by making exceptions from one or more of its conditions.
Additional permissions that are applicable to the entire Program shall
be treated as though they were included in this License, to the extent
that they are valid under applicable law.  If additional permissions
apply only to part of the Program, that part may be used separately
under those permissions, but the entire Program remains governed by
this License without regard to the additional permissions.

  When you convey a copy of a covered work, you may at your option
remove any additional permissions from that copy, or from any part of
it.  (Additional permissions may be written to require their own
removal in certain cases when you modify the work.)  You may place
additional permissions on material, added by you to a covered work,
for which you have or can give appropriate copyright permission.

  Notwithstanding any other provision of this License, for material you
add to a covered work, you may (if authorized by the copyright holders of
that material) supplement the terms of this License with terms:

    a) Disclaiming warranty or limiting liability differently from the
    terms of sections 15 and 16 of this License; or

    b) Requiring preservation of specified reasonable legal notices or
    author attributions in that material or in the Appropriate Legal
    Notices displayed by works containing it; or

    c) Prohibiting misrepresentation of the origin of that material, or
    requiring that modified versions of such material be marked in
    reasonable ways as different from the original version; or

    d) Limiting the use for publicity purposes of names of licensors or
    authors of the material; or

    e) Declining to grant rights under trademark law for use of some
    trade names, trademarks, or service marks; or

    f) Requiring indemnification of licensors and authors of that
    material by anyone who conveys the material (or modified versions of
    it) with contractual assumptions of liability to the recipient, for
    any liability that these contractual assumptions directly impose on
    those licensors and authors.

  All other non-permissive additional terms are considered "further
restrictions" within the meaning of section 10.  If the Program as you
received it, or any part of it, contains a notice stating that it is
governed by this License along with a term that is a further
restriction, you may remove that term.  If a license document contains
a further restriction but permits relicensing or conveying under this
License, you may add to a covered work material governed by the terms
of that license document, provided that the further restriction does
not survive such relicensing or conveying.

  If you add terms to a covered work in accord with this section, you
must place, in the relevant source files, a statement of the
additional terms that apply to those files, or a notice indicating
where to find the applicable terms.

  Additional terms, permissive or non-permissive, may be stated in the
form of a separately written license, or stated as exceptions;
the above requirements apply either way.

  8. Termination.

  You may not propagate or modify a covered work except as expressly
provided under this License.  Any attempt otherwise to propagate or
modify it is void, and will automatically terminate your rights under
this License (including any patent licenses granted under the third
paragraph of section 11).

  However, if you cease all violation of this License, then your
license from a particular copyright holder is reinstated (a)
provisionally, unless and until the copyright holder explicitly and
finally terminates your license, and (b) permanently, if the copyright
holder fails to notify you of the violation by some reasonable means
prior to 60 days after the cessation.

  Moreover, your license from a particular copyright holder is
reinstated permanently if the copyright holder notifies you of the
violation by some reasonable means, this is the first time you have
received notice of violation of this License (for any work) from that
copyright holder, and you cure the violation prior to 30 days after
your receipt of the notice.

  Termination of your rights under this section does not terminate the
licenses of parties who have received copies or rights from you under
this License.  If your rights have been terminated and not permanently
reinstated, you do not qualify to receive new licenses for the same
material under section 10.

  9. Acceptance Not Required for Having Copies.

  You are not required to accept this License in order to receive or
run a copy of the Program.  Ancillary propagation of a covered work
occurring solely as a consequence of using peer-to-peer transmission
to receive a copy likewise does not require acceptance.  However,
nothing other than this License grants you permission to propagate or
modify any covered work.  These actions infringe copyright if you do
not accept this License.  Therefore, by modifying or propagating a
covered work, you indicate your acceptance of this License to do so.

  10. Automatic Licensing of Downstream Recipients.

  Each time you convey a covered work, the recipient automatically
receives a license from the original licensors, to run, modify and
propagate that work, subject to this License.  You are not responsible
for enforcing compliance by third parties with this License.

  An "entity transaction" is a transaction transferring control of an
organization, or substantially all assets of one, or subdividing an
organization, or merging organizations.  If propagation of a covered
work results from an entity transaction, each party to that
transaction who receives a copy of the work also receives whatever
licenses to the work the party's predecessor in interest had or could
give under the previous paragraph, plus a right to possession of the
Corresponding Source of the work from the predecessor in interest, if
the predecessor has it or can get it with reasonable efforts.

  You may not impose any further restrictions on the exercise of the
rights granted or affirmed under this License.  For example, you may
not impose a license fee, royalty, or other charge for exercise of
rights granted under this License, and you may not initiate litigation
(including a cross-claim or counterclaim in a lawsuit) alleging that
any patent claim is infringed by making, using, selling, offering for
sale, or importing the Program or any portion of it.

  11. Patents.

  A "contributor" is a copyright holder who authorizes use under this
License of the Program or a work on which the Program is based.  The
work thus licensed is called the contributor's "contributor version".

  A contributor's "essential patent claims" are all patent claims
owned or controlled by the contributor, whether already acquired or
hereafter acquired, that would be infringed by some manner, permitted
by this License, of making, using, or selling its contributor version,
but do not include claims that would be infringed only as a
consequence of further modification of the contributor version.  For
purposes of this definition, "control" includes the right to grant
patent sublicenses in a manner consistent with the requirements of
this License.

  Each contributor grants you a non-exclusive, worldwide, royalty-free
patent license under the contributor's essential patent claims, to
make, use, sell, offer for sale, import and otherwise run, modify and
propagate the contents of its contributor version.

  In the following three paragraphs, a "patent license" is any express
agreement or commitment, however denominated, not to enforce a patent
(such as an express permission to practice a patent or covenant not to
sue for patent infringement).  To "grant" such a patent license to a
party means to make such an agreement or commitment not to enforce a
patent against the party.

  If you convey a covered work, knowingly relying on a patent license,
and the Corresponding Source of the work is not available for anyone
to copy, free of charge and under the terms of this License, through a
publicly available network server or other readily accessible means,
then you must either (1) cause the Corresponding Source to be so
available, or (2) arrange to deprive yourself of the benefit of the
patent license for this particular work, or (3) arrange, in a manner
consistent with the requirements of this License, to extend the patent
license to downstream recipients.  "Knowingly relying" means you have
actual knowledge that, but for the patent license, your conveying the
covered work in a country, or your recipient's use of the covered work
in a country, would infringe one or more identifiable patents in that
country that you have reason to believe are valid.

  If, pursuant to or in connection with a single transaction or
arrangement, you convey, or propagate by procuring conveyance of, a
covered work, and grant a patent license to some of the parties
receiving the covered work authorizing them to use, propagate, modify
or convey a specific copy of the covered work, then the patent license
you grant is automatically extended to all recipients of the covered
work and works based on it.

  A patent license is "discriminatory" if it does not include within
the scope of its coverage, prohibits the exercise of, or is
conditioned on the non-exercise of one or more of the rights that are
specifically granted under this License.  You may not convey a covered
work if you are a party to an arrangement with a third party that is
in the business of distributing software, under which you make payment
to the third party based on the extent of your activity of conveying
the work, and under which the third party grants, to any of the
parties who would receive the covered work from you, a discriminatory
patent license (a) in connection with copies of the covered work
conveyed by you (or copies made from those copies), or (b) primarily
for and in connection with specific products or compilations that
contain the covered work, unless you entered into that arrangement,
or that patent license was granted, prior to 28 March 2007.

  Nothing in this License shall be construed as excluding or limiting
any implied license or other defenses to infringement that may
otherwise be available to you under applicable patent law.

  12. No Surrender of Others' Freedom.

  If conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License.  If you cannot convey a
covered work so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you may
not convey it at all.  For example, if you agree to terms that obligate you
to collect a royalty for further conveying from those to whom you convey
the Program, the only way you could satisfy both those terms and this
License would be to refrain entirely from conveying the Program.

  13. Remote Network Interaction; Use with the GNU General Public License.

  Notwithstanding any other provision of this License, if you modify the
Program, your modified version must prominently offer all users
interacting with it remotely through a computer network (if your version
supports such interaction) an opportunity to receive the Corresponding
Source of your version by providing access to the Corresponding Source
from a network server at no charge, through some standard or customary
means of facilitating copying of software.  This Corresponding Source
shall include the Corresponding Source for any work covered by version 3
of the GNU General Public License that is incorporated pursuant to the
following paragraph.

  Notwithstanding any other provision of this License, you have
permission to link or combine any covered work with a work licensed
under version 3 of the GNU General Public License into a single
combined work, and to convey the resulting work.  The terms of this
License will continue to apply to the part which is the covered work,
but the work with which it is combined will remain governed by version
3 of the GNU General Public License.

  14. Revised Versions of this License.

  The Free Software Foundation may publish revised and/or new versions of
the GNU Affero General Public License from time to time.  Such new versions
will be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.

  Each version is given a distinguishing version number.  If the
Program specifies that a certain numbered version of the GNU Affero General
Public License "or any later version" applies to it, you have the
option of following the terms and conditions either of that numbered
version or of any later version published by the Free Software
Foundation.  If the Program does not specify a version number of the
GNU Affero General Public License, you may choose any version ever published
by the Free Software Foundation.

  If the Program specifies that a proxy can decide which future
versions of the GNU Affero General Public License can be used, that proxy's
public statement of acceptance of a version permanently authorizes you
to choose that version for the Program.

  Later license versions may give you additional or different
permissions.  However, no additional obligations are imposed on any
author or copyright holder as a result of your choosing to follow a
later version.

  15. Disclaimer of Warranty.

  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.

  16. Limitation of Liability.

  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.

  17. Interpretation of Sections 15 and 16.

  If the disclaimer of warranty and limitation of liability provided
above cannot be given local legal effect according to their terms,
reviewing courts shall apply local law that most closely approximates
an absolute waiver of all civil liability in connection with the
Program, unless a warranty or assumption of liability accompanies a
copy of the Program in return for a fee.

                     END OF TERMS AND CONDITIONS

            How to Apply These Terms to Your New Programs

  If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.

  To do so, attach the following notices to the program.  It is safest
to attach them to the start of each source file to most effectively
state the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.

    <one line to give the program's name and a brief idea of what it does.>
    Copyright (C) <year>  <name of author>

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU Affero 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 Affero General Public License for more details.

    You should have received a copy of the GNU Affero General Public License
    along with this program.  If not, see <https://www.gnu.org/licenses/>.

Also add information on how to contact you by electronic and paper mail.

  If your software can interact with users remotely through a computer
network, you should also make sure that it provides a way for users to
get its source.  For example, if your program is a web application, its
interface could display a "Source" link that leads users to an archive
of the code.  There are many ways you could offer source, and different
solutions will be better for different programs; see section 13 for the
specific requirements.

  You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU AGPL, see
<https://www.gnu.org/licenses/>.
Changes to compat/dlfcn.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
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

-
-
-
-
-
-














+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * dlfcn.h --
 *
 *	This file provides a replacement for the header file "dlfcn.h"
 *	on systems where dlfcn.h is missing.  It's primary use is for
 *	AIX, where Tcl emulates the dl library.
 *
 *	This file is subject to the following copyright notice, which is
 *	different from the notice used elsewhere in Tcl but rougly
 *	equivalent in meaning.
 *
 *	Copyright (c) 1992,1993,1995,1996, Jens-Uwe Mager, Helios Software GmbH
 *	Not derived from licensed software.
 *
 *	Permission is granted to freely use, copy, modify, and redistribute
 *	this software, provided that the author is not construed to be liable
 *	for any results of using the software, alterations are clearly marked
 *	as such, and this notice is not modified.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.
 *
 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * dlfcn.h --
 *
 *	This file provides a replacement for the header file "dlfcn.h"
 *	on systems where dlfcn.h is missing.  It's primary use is for
 *	AIX, where Tcl emulates the dl library.
 *
 * This is an unpublished work copyright (c) 1992 HELIOS Software GmbH
 * 30159 Hannover, Germany
 */

#ifndef __dlfcn_h__
#define __dlfcn_h__

Changes to compat/fake-rfc2553.c.
22
23
24
25
26
27
28









29
30
31
32
33
34
35
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44







+
+
+
+
+
+
+
+
+







 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 * SUCH DAMAGE.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.
 *
 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * Pseudo-implementation of RFC2553 name / address resolution functions
 *
 * But these functions are not implemented correctly. The minimum subset
 * is implemented for ssh use only. For example, this routine assumes
 * that ai_family is AF_INET. Don't use it for another purpose.
Changes to compat/fake-rfc2553.h.
22
23
24
25
26
27
28









29
30
31
32
33
34
35
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44







+
+
+
+
+
+
+
+
+







 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 * SUCH DAMAGE.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * Pseudo-implementation of RFC2553 name / address resolution functions
 *
 * But these functions are not implemented correctly. The minimum subset
 * is implemented for ssh use only. For example, this routine assumes
 * that ai_family is AF_INET. Don't use it for another purpose.
Changes to compat/gettod.c.
1
2
3
4
5
6
7
8
9
10
11

















12
13
14
15
16
17
18
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

-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * gettod.c --
 *
 *	This file provides the gettimeofday function on systems
 *	that only have the System V ftime function.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * gettod.c --
 *
 *	This file provides the gettimeofday function on systems
 *	that only have the System V ftime function.
 *
*/

#include "tclPort.h"
#include <sys/timeb.h>

#undef timezone

int
Changes to compat/mkstemp.c.
1
2
3
4
5
6
7
8
9
10









11
12
13
14
15
16
17
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










+
+
+
+
+
+
+
+
+







/*
 * mkstemp.c --
 *
 *	Source code for the "mkstemp" library routine.
 *
 * Copyright (c) 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

#include <errno.h>
#include <fcntl.h>
#include <stdlib.h>
#include <unistd.h>
#include <string.h>

Changes to compat/string.h.
1
2
3
4
5
6
7
8
9
10
11









12
13
14
15
16
17
18
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











+
+
+
+
+
+
+
+
+







/*
 * string.h --
 *
 *	Declarations of ANSI C library procedures for string handling.
 *
 * Copyright (c) 1991-1993 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

#ifndef _STRING
#define _STRING

/*
 * The following #include is needed to define size_t. (This used to include
 * sys/stdtypes.h but that doesn't exist on older versions of SunOS, e.g.
Changes to compat/strncasecmp.c.
1
2
3
4
5
6
7
8
9
10
11









12
13
14
15
16
17
18
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











+
+
+
+
+
+
+
+
+







/*
 * strncasecmp.c --
 *
 *	Source code for the "strncasecmp" library routine.
 *
 * Copyright (c) 1988-1993 The Regents of the University of California.
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

#include "tclPort.h"

/*
 * This array is designed for mapping upper and lower case letter together for
 * a case independent comparison. The mappings are based upon ASCII character
 * sequences.
Changes to compat/waitpid.c.
1
2
3
4
5
6
7
8
9
10
11
12
13









14
15
16
17
18
19
20
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













+
+
+
+
+
+
+
+
+







/*
 * waitpid.c --
 *
 *	This procedure emulates the POSIX waitpid kernel call on BSD systems
 *	that don't have waitpid but do have wait3. This code is based on a
 *	prototype version written by Mark Diekhans and Karl Lehenbauer.
 *
 * Copyright (c) 1993 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

#include "tclPort.h"

#ifndef pid_t
#define pid_t int
#endif

Deleted compat/zlib/win32/zdll.lib.

cannot compute difference between binary files

Deleted compat/zlib/win32/zlib1.dll.

cannot compute difference between binary files

Deleted compat/zlib/win64-arm/libz.dll.a.

cannot compute difference between binary files

Deleted compat/zlib/win64-arm/zdll.lib.

cannot compute difference between binary files

Deleted compat/zlib/win64-arm/zlib1.dll.

cannot compute difference between binary files

Deleted compat/zlib/win64/libz.dll.a.

cannot compute difference between binary files

Deleted compat/zlib/win64/zdll.lib.

cannot compute difference between binary files

Deleted compat/zlib/win64/zlib1.dll.

cannot compute difference between binary files

Changes to doc/Access.3.
1
2
3
4
5







6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19





+
+
+
+
+
+
+







'\"
'\" Copyright (c) 1998-1999 Scriptics Corporation
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_Access 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_Access, Tcl_Stat \- check file permissions and other attributes
.SH SYNOPSIS
Changes to doc/AddErrInfo.3.
1
2
3
4
5
6







7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20






+
+
+
+
+
+
+







'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_AddErrorInfo 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_GetReturnOptions, Tcl_SetReturnOptions, Tcl_AddErrorInfo, Tcl_AppendObjToErrorInfo, Tcl_AddObjErrorInfo, Tcl_SetObjErrorCode, Tcl_SetErrorCode, Tcl_SetErrorLine, Tcl_GetErrorLine, Tcl_PosixError, Tcl_LogCommandInfo \- retrieve or record information about errors and other return options
.SH SYNOPSIS
Changes to doc/Alloc.3.
1
2
3
4
5







6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19





+
+
+
+
+
+
+







'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_Alloc 3 9.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_Alloc, Tcl_Free, Tcl_Realloc, Tcl_AttemptAlloc, Tcl_AttemptRealloc, Tcl_GetMemoryInfo \- allocate or free heap memory
.SH SYNOPSIS
Changes to doc/AllowExc.3.
1
2
3
4
5
6







7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20






+
+
+
+
+
+
+







'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_AllowExceptions 3 7.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_AllowExceptions \- allow all exceptions in next script evaluation
.SH SYNOPSIS
Changes to doc/AppInit.3.
1
2
3
4
5
6







7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20






+
+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_AppInit 3 7.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_AppInit \- perform application-specific initialization
.SH SYNOPSIS
Changes to doc/Encoding.3.
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
100
101
102
103
104
105
106



107
108
109
110
111
112
113







-
-
-







converted. \fBTCL_ENCODING_END\fR signifies that the source buffer is the last
block in a (potentially multi-block) input stream, telling the conversion
routine to perform any finalization that needs to occur after the last
byte is converted and then to reset to an initial state. The
\fBTCL_PROFILE_*\fR bits defined in the \fBPROFILES\fR section below
control the encoding profile to be used for dealing with invalid data or
other errors in the encoding transform.
The flag \fBTCL_ENCODING_STOPONERROR\fR has no effect,
it only has meaning in Tcl 8.x.
.PP
Some flags bits may not be usable with some functions as noted in the
function descriptions below.
.AP Tcl_EncodingState *statePtr in/out
Used when converting a (generally long or indefinite length) byte stream
in a piece-by-piece fashion.  The conversion routine stores its current
state in \fI*statePtr\fR after \fIsrc\fR (the buffer containing the
current piece) has been converted; that state information must be passed
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
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







-
-
-
-
-
-
-
+
+
+
+
+
+
+











-
+







.PP
.CS
.ta 1.5i
# Encoding file: iso2022-jp, escape-driven
E
init		{}
final		{}
iso8859-1	\ex1B(B
jis0201		\ex1B(J
jis0208		\ex1B$@
jis0208		\ex1B$B
jis0212		\ex1B$(D
gb2312		\ex1B$A
ksc5601		\ex1B$(C
iso8859-1	\ex1b(B
jis0201		\ex1b(J
jis0208		\ex1b$@
jis0208		\ex1b$B
jis0212		\ex1b$(D
gb2312		\ex1b$A
ksc5601		\ex1b$(C
.CE
.PP
In the file, the first column represents an option and the second column
is the associated value.  \fBinit\fR is a string to emit or expect before
the first character is converted, while \fBfinal\fR is a string to emit
or expect after the last character.  All other options are names of
table-based encodings; the associated value is the escape-sequence that
marks that encoding.  Tcl syntax is used for the values; in the above
example, for instance,
.QW \fB{}\fR
represents the empty string and
.QW \fB\ex1B\fR
.QW \fB\ex1b\fR
represents character 27.
.PP
When \fBTcl_GetEncoding\fR encounters an encoding \fIname\fR that has not
been loaded, it attempts to load an encoding file called \fIname\fB.enc\fR
from the \fBencoding\fR subdirectory of each directory that Tcl searches
for its script library.  If the encoding file exists, but is
malformed, an error message will be left in \fIinterp\fR.
585
586
587
588
589
590
591
592

593
594
595
596
597
598
599
582
583
584
585
586
587
588

589
590
591
592
593
594
595
596







-
+







Encoding profiles define the manner in which errors in the encoding transforms
are handled by the encoding functions. An application can specify the profile
to be used by OR-ing the \fBflags\fR parameter passed to the function
with at most one of \fBTCL_ENCODING_PROFILE_TCL8\fR,
\fBTCL_ENCODING_PROFILE_STRICT\fR or \fBTCL_ENCODING_PROFILE_REPLACE\fR.
These correspond to the \fBtcl8\fR, \fBstrict\fR and \fBreplace\fR profiles
respectively. If none are specified, a version-dependent default profile is used.
For Tcl 9.0, the default profile is \fBstrict\fR.
The default profile is \fBstrict\fR.
.PP
For details about profiles, see the \fBPROFILES\fR section in
the documentation of the \fBencoding\fR command.
.SH "SEE ALSO"
encoding(n)
.SH KEYWORDS
utf, encoding, convert
Changes to doc/ObjectType.3.
1
2
3
4
5
6
7
8
9
10
11




12
13
14
15
16
17
18
1
2
3
4
5
6
7
8
9
10

11
12
13
14
15
16
17
18
19
20
21










-
+
+
+
+







'\"
'\" Copyright (c) 1996-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.
'\"
.TH Tcl_ObjType 3 9.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_RegisterObjType, Tcl_GetObjType, Tcl_AppendAllObjTypes, Tcl_ConvertToType, Tcl_FreeInternalRep, Tcl_InitStringRep, Tcl_HasStringRep, Tcl_StoreInternalRep, Tcl_FetchInternalRep  \- manipulate Tcl value types
Tcl_RegisterObjType, Tcl_GetObjType, Tcl_AppendAllObjTypes, Tcl_ConvertToType
	,Tcl_FreeInternalRep, Tcl_InitStringRep, Tcl_HasStringRep
	,Tcl_NewObjInterface, Tcl_NewObjType
	, Tcl_StoreInternalRep, Tcl_FetchInternalRep  \- manipulate Tcl value types
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_RegisterObjType\fR(\fItypePtr\fR)
.sp
const Tcl_ObjType *
29
30
31
32
33
34
35






36
37
38
39
40
41
42
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51







+
+
+
+
+
+







.sp
char *
\fBTcl_InitStringRep\fR(\fIobjPtr, bytes, numBytes\fR)
.sp
int
\fBTcl_HasStringRep\fR(\fIobjPtr\fR)
.sp
Tcl_ObjInterface *
Tcl_NewObjInterface()
.sp
Tcl_ObjType *
\fBTcl_NewObjType\fR()
.sp
void
\fBTcl_StoreInternalRep\fR(\fIobjPtr, typePtr, irPtr\fR)
.sp
Tcl_ObjInternalRep *
\fBTcl_FetchInternalRep\fR(\fIobjPtr, typePtr\fR)
.fi
.SH ARGUMENTS
66
67
68
69
70
71
72









73
74
75
76
77
78
79
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97







+
+
+
+
+
+
+
+
+








.SH DESCRIPTION
.PP
The procedures in this man page manage Tcl value types (sometimes
referred to as object types or \fBTcl_ObjType\fRs for historical reasons).
They are used to register new value types, look up types,
and force conversions from one type to another.
.PP
\fBTcl_NewObjType\fR allocates a new \fBTcl_ObjType\fR and returns a
pointer to it.
.PP
\fBTcl_NewObjInterface\fR allocates a new \fBTcl_ObjInterface\fR and returns a
pointer to it.
.PP
\fBTcl_ObjTypeSetInterface\fR sets the given \fBTcl_ObjInterface\fB for the
given \fBTcl_ObjType\fR.
.PP
\fBTcl_RegisterObjType\fR registers a new Tcl value type
in the table of all value types that \fBTcl_GetObjType\fR
can look up by name.  There are other value types supported by Tcl
as well, which Tcl chooses not to register.  Extensions can likewise
choose to register the value types they create or not.
The argument \fItypePtr\fR points to a Tcl_ObjType structure that
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
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







-
+
-
-
-
-
-
-
+
+
+
+
+









-
-
-
-
-
-
-
-
-
-







.CE
where the contents are exactly the existing contents of the union in the
\fIinternalRep\fR field of the \fITcl_Obj\fR struct.
This definition permits us to pass internal representations and pointers to
them as arguments and results in public routines.
.SH "THE TCL_OBJTYPE STRUCTURE"
.PP
Extension writers can define new value types by defining four to twelve
Extension writers can define new value types by defining procedures for the
procedures and initializing a Tcl_ObjType structure to describe the
type.  Extension writers may also pass a pointer to their Tcl_ObjType
structure to \fBTcl_RegisterObjType\fR if they wish to permit other
extensions to look up their Tcl_ObjType by name with the
\fBTcl_GetObjType\fR routine.  The \fBTcl_ObjType\fR structure is
defined as follows:
funtion types described below.  An extension may also pass to
\fBTcl_RegisterObjType\fR a pointer to a custom Tcl_ObjType structure in order
to permit other extensions to look up the Tcl_ObjType by name with the
\fBTcl_GetObjType\fR routine.  The \fBTcl_ObjType\fR structure is defined as
follows:
.PP
.CS
typedef struct {
    const char *\fIname\fR;
    Tcl_FreeInternalRepProc *\fIfreeIntRepProc\fR;
    Tcl_DupInternalRepProc *\fIdupIntRepProc\fR;
    Tcl_UpdateStringProc *\fIupdateStringProc\fR;
    Tcl_SetFromAnyProc *\fIsetFromAnyProc\fR;
    size_t \fIversion\fR;
    /* List emulation functions - ObjType Version 1 & 2 */
    Tcl_ObjTypeLengthProc *lengthProc;
    /* List emulation functions - ObjType Version 2 */
    Tcl_ObjTypeIndexProc *\fIindexProc\fR;
    Tcl_ObjTypeSliceProc *\fIsliceProc\fR;
    Tcl_ObjTypeReverseProc *\fIreverseProc\fR;
    Tcl_ObjTypeGetElements *\fIgetElementsProc\fR;
    Tcl_ObjTypeSetElement *\fIsetElementProc\fR;
    Tcl_ObjTypeReplaceProc *\fIreplaceProc\fR;
    Tcl_ObjTypeInOperatorProc *\fIinOperProc\fR;
} \fBTcl_ObjType\fR;
.CE
.SS "THE NAME FIELD"
.PP
The \fIname\fR member describes the name of the type, e.g. \fBint\fR.
When a type is registered, this is the name used by callers
of \fBTcl_GetObjType\fR to lookup the type.  For unregistered
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
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







-
+


-
+

-
+
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
+
+
-
-
+
-
-
+
+
+
-
-

-
-
-
-
-
-
-
+
-
-
-
-
-
+
-
-
+
-
-
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
+
+
+
-
+

-
-
-
-
+
+
+
+
-
-
-
-
-
+
-
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
+
+

-
-
-
-
+
+
+
-
+

-
-
-
-
-
+
+
+
+
+
-
-
+

-
-
+
-
-
-
-
-
-
-
+
+
-
-
-
-
-







Note that if a subsidiary value has its reference count reduced to zero
during the running of a \fIfreeIntRepProc\fR, that value may be not freed
immediately, in order to limit stack usage. However, the value will be freed
before the outermost current \fBTcl_DecrRefCount\fR returns.
.SS "THE VERSION FIELD"
.PP
The \fIversion\fR member provides for future extensibility of the
structure and should be set to \fBTCL_OBJTYPE_V0\fR for compatibility
structure and should be set to 0 for compatibility
of ObjType definitions prior to version 9.0. Specifics about versions
will be described further in the sections below.
.SH "ABSTRACT LIST TYPES"
.SH "OTHER OPERATIONS"
.PP
Additional fields in the Tcl_ObjType descriptor allow for control over
A procedure for each of the type definitions below may be registered for
how custom data values can be manipulated using Tcl's List commands
without converting the value to a List type. This requires the custom
type to provide functions that will perform the given operation on the
custom data representation.  Not all functions are required. In the
absence of a particular function (set to NULL), the fallback is to
allow the internal List operation to perform the operation, most
applying an operation to the Tcl_Obj value.  For example, if a function of type
likely causing the value type to be converted to a traditional list.
.SS "SCALAR VALUE TYPES"
.PP
For a custom value type that is scalar or atomic in nature, i.e., not
a divisible collection, version \fBTCL_OBJTYPE_V1\fR is
recommended. In this case, List commands will treat the scalar value
as if it where a list of length 1, and not convert the value to a List
type.
.SS "VERSION 2: ABSTRACT LISTS"
.PP
Version 2, \fBTCL_OBJTYPE_V2\fR, allows full List support when the
functions described below are provided.  This allows for script level
use of the List commands without causing the type of the Tcl_Obj value
\fITcl_ObjInterfaceStringLengthProc\fR is registered, then if provides the
length of the string representation of the value.  If a function of type
to be converted to a list.
.SS "THE LENGTHPROC FIELD"
.PP
The \fBLengthProc\fR function correlates with the \fBTcl_ListObjLength\fR
C API. The function returns the number of elements in the list. It
\fITcl_ObjInterfaceListLengthProc\fR is registered, then it provides the number
of items in the list represented by the value.  It is not necessary to
is used in every List operation and is required for all Abstract List
implementations.
implement all procedures.  If a particular procedure is NULL, Tcl attempts
.CS
typedef Tcl_Size
to interpret the value as a type which supports the requested operation.  For
example, to perform a list index operation, The Tcl_Obj may be interpreted as
\fBtclListType\fR if possible.
(Tcl_ObjTypeLengthProc) (Tcl_Obj *listPtr);
.CE
.PP
.SS "THE INDEXPROC FIELD"
.PP
The \fBIndexProc\fR function correlates with with the
\fBTcl_ListObjIndex\fR C API. The function returns a Tcl_Obj value for
the element at the specified index.
.CS
typedef int (\fBTcl_ObjTypeIndexProc\fR) (
See the following typedef lines in
    Tcl_Interp *interp,
    Tcl_Obj *listPtr,
    Tcl_Size index,
    Tcl_Obj** elemObj);
.CE
.cs
.SS "THE SLICEPROC FIELD"
.PP
tcl.h
The \fBSliceProc\fR correlates with the \fBlrange\fR command,
returning a new List or Abstract List for the portion of the original
list specified.
.CS
.ce
typedef int (\fBTcl_ObjTypeSliceProc\fR) (
    Tcl_Interp *interp,
    Tcl_Obj *listPtr,
for the procedures that may registered.
    Tcl_Size fromIdx,
    Tcl_Size toIdx,
    Tcl_Obj **newObjPtr);
.CE
.SS "THE REVERSEPROC FIELD"
.PP
The \fBReverseProc\fR correlates with the \fBlreverse\fR command,
returning a List or Abstract List that has the same elements as the

.RS
list operations
input Abstract List, with the elements in the reverse order.
.RS
.CS
typedef int (\fBTcl_ObjTypeReverseProc\fR) (
    Tcl_Interp *interp,
    Tcl_Obj *listPtr,
    Tcl_Obj **newObjPtr);
Tcl_ObjInterfaceListAllProc
Tcl_ObjInterfaceListAppendProc
Tcl_ObjInterfaceListAppendlistProc
Tcl_ObjInterfaceListContainsProc
.CE
.SS "THE GETELEMENTS FIELD"
.PP
The \fBGetElements\fR function returns a count and a pointer to an
array of Tcl_Obj values for the entire Abstract List. This
Tcl_ObjInterfaceListIndexProc
correlates to the \fBTcl_ListObjGetElements\fR C API call.
.CS
typedef int (\fBTcl_ObjTypeGetElements\fR) (
    Tcl_Interp *interp,
    Tcl_Obj *listPtr,
    Tcl_Size *objcptr,
    Tcl_Obj ***objvptr);
Tcl_ObjInterfaceListIndexEndProc
Tcl_ObjInterfaceListIsSortedProc
Tcl_ObjInterfaceListLengthProc
Tcl_ObjInterfaceListRangeProc
Tcl_ObjInterfaceListRangeEndProc
.CE
.SS "THE SETELEMENT FIELD"
.PP
The \fBSetElement\fR function replaces the element within the
specified list at the give index. This function correlates to the
\fBlset\fR command.
.CS
typedef Tcl_Obj *(\fBTcl_ObjTypeSetElement\fR) (
    Tcl_Interp *interp,
    Tcl_Obj *listPtr,
Tcl_ObjInterfaceListReplaceProc
Tcl_ObjInterfaceListReplaceListProc
Tcl_ObjInterfaceListReverseProc
    Tcl_Size indexCount,
    Tcl_Obj *const indexArray[],
    Tcl_Obj *valueObj);
Tcl_ObjInterfaceListSetProc
Tcl_ObjInterfaceListSetDeepProc
.CE
.SS "REPLACEPROC FIELD"
.PP
The \fBReplaceProc\fR returns a new list after modifying the list
replacing the elements to be deleted, and adding the elements to be
.RE

string operations
inserted. This function correlates to the \fBTcl_ListObjReplace\fR C API.
.RS
.CS
typedef int (\fBTcl_ObjTypeReplaceProc\fR) (
    Tcl_Interp *interp,
    Tcl_Obj *listObj,
    Tcl_Size first,
    Tcl_Size numToDelete,
Tcl_ObjInterfaceStringIndexProc
Tcl_ObjInterfaceStringIndexEndProc
Tcl_ObjInterfaceStringIsEmptyProc
Tcl_ObjInterfaceStringLengthProc
Tcl_ObjInterfaceStringRangeProc
    Tcl_Size numToInsert,
    Tcl_Obj *const insertObjs[]);
Tcl_ObjInterfaceStringRangeEndProc
.CE
.SS "THE INOPERPROC FIELD"
.PP
.RE
The \fBInOperProc\fR function determines whether the value is present in the
given list, according to equivalent string comparison of elements. The
\fBboolResult\fR is set to 1 (true) if the value is present, and 0
(false) if it is not present. This function implements the "in" and
"ni" math operators for an abstract list.
.CS
typedef int (\fBTcl_ObjTypeInOperatorProc\fR) (
.RE

    Tcl_Interp *interp,
    Tcl_Obj *valueObj,
    Tcl_Obj *listObj,
    int *boolResult);
.CE
.SH "REFERENCE COUNT MANAGEMENT"
.PP
The \fIobjPtr\fR argument to \fBTcl_AppendAllObjTypes\fR should be an unshared
value; this function will not modify the reference count of that value, but
will modify its contents. If \fIobjPtr\fR is not (interpretable as) a list,
this function will set the interpreter result and produce an error; using an
unshared empty value is strongly recommended.
Changes to doc/SaveInterpState.3.
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
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



+








-
+
+















-
+

-
+

-
+



-
-
-
+
+
-

-
+
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
+
+

-
+
-
-
-
-
+
+
-

-
-
-
-
-
-
-
+
-
-
+
+


'\"
'\" Copyright (c) 1997 Sun Microsystems, Inc.
'\" Contributions from Don Porter, NIST, 2004. (not subject to US copyright)
'\" Copyright (c) 2018 Nathan Coulter.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_SaveInterpState 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_SaveInterpState, Tcl_RestoreInterpState, Tcl_DiscardInterpState \- save and restore an interpreter's state
Tcl_SaveInterpState, Tcl_RestoreInterpState, Tcl_DiscardInterpState \- Save and restore the
state of an an interpreter.
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_InterpState
\fBTcl_SaveInterpState\fR(\fIinterp, status\fR)
.sp
int
\fBTcl_RestoreInterpState\fR(\fIinterp, state\fR)
.sp
\fBTcl_DiscardInterpState\fR(\fIstate\fR)
.fi
.SH ARGUMENTS
.AS Tcl_InterpState savedPtr
.AP Tcl_Interp *interp in
Interpreter for which state should be saved.
The interpreter for the operation.
.AP int status in
Return code value to save as part of interpreter state.
The return code for the state.
.AP Tcl_InterpState state in
Saved state token to be restored or discarded.
A token for saved state.
.BE
.SH DESCRIPTION
.PP
These routines allows a C procedure to take a snapshot of the current
state of an interpreter so that it can be restored after a call
to \fBTcl_Eval\fR or some other routine that modifies the interpreter
These routines save the state of an interpreter before a call to a routine such
as \fBTcl_Eval\fR, and restore the state afterwards.
state.
.PP
\fBTcl_SaveInterpState\fR stores a snapshot of the interpreter state in
\fBTcl_SaveInterpState\fR saves the parts of \fIinterp\fR that comprise the
an opaque token returned by \fBTcl_SaveInterpState\fR.  That token
value may then be passed back to one of \fBTcl_RestoreInterpState\fR
or \fBTcl_DiscardInterpState\fR, depending on whether the interp
state is to be restored.  So long as one of the latter two routines
is called, Tcl will take care of memory management.
.PP
\fBTcl_SaveInterpState\fR takes a snapshot of those portions of
interpreter state that make up the full result of script evaluation.
This include the interpreter result, the return code (passed in
as the \fIstatus\fR argument, and any return options, including
\fB\-errorinfo\fR and \fB\-errorcode\fR when an error is in progress.
result of a script, including the resulting value, the return code passed as
\fIstatus\fR, and any options such as \fB\-errorinfo\fR and \fB\-errorcode\fR.
This snapshot is returned as an opaque token of type \fBTcl_InterpState\fR.
The call to \fBTcl_SaveInterpState\fR does not itself change the
state of the interpreter.
It returns a token for the saved state.  The interpreter result is not reset
and no interpreter state is changed.
.PP
\fBTcl_RestoreInterpState\fR accepts a \fBTcl_InterpState\fR token
\fBTcl_RestoreInterpState\fR restores the state indicated by \fIstate\fR and
previously returned by \fBTcl_SaveInterpState\fR and restores the
state of the interp to the state held in that snapshot.  The return
value of \fBTcl_RestoreInterpState\fR is the status value originally
passed to \fBTcl_SaveInterpState\fR when the snapshot token was
returns the \fIstatus\fR originally passed in the corresponding call to
\fBTcl_SaveInterpState\fR.
created.
.PP
\fBTcl_DiscardInterpState\fR is called to release a \fBTcl_InterpState\fR
token previously returned by \fBTcl_SaveInterpState\fR when that
snapshot is not to be restored to an interp.
.PP
The \fBTcl_InterpState\fR token returned by \fBTcl_SaveInterpState\fR
must eventually be passed to either \fBTcl_RestoreInterpState\fR
or \fBTcl_DiscardInterpState\fR to avoid a memory leak.  Once
If a saved state is not restored, \fBTcl_DiscardInterpState\fR must be called
the \fBTcl_InterpState\fR token is passed to one of them, the
token is no longer valid and should not be used anymore.
to release it.  A token used to discard or restore state must not be used
again.
.SH KEYWORDS
result, state, interp
Changes to doc/SetResult.3.
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
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







-
+

-
+

-
-
+

-
+


-
-
+
+
-

-
+

-
+





-
-
+
+
-
-
+
-
-
+
-
-
+
-
-
+
-
-
+
-
+

-
+
-

-
-
-
-
-
-
-

-
-
+
+
-
-
-

-
+
-
-
+
-
-
-
-
-
+
+
-
-
+

-
+
-
-
+
+
-
-
-
+
-
-
+

-
+
-
-
-
-
-
-
-
+
-
-
+

-
+
-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
+
+
+
-
-
-
+
+

-
-
+
+
-
-
-
-
-
+
+

+
+



-
-
-
+
+
-
-
+

-
+
-
-
-
-
-
+
+
-
-
-
-
-
+
+
+
-
-
-
-
+
+
+






-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





\fBTcl_TransferResult\fR(\fIsourceInterp, code, targetInterp\fR)
.sp
\fBTcl_AppendElement\fR(\fIinterp, element\fR)
.fi
.SH ARGUMENTS
.AS Tcl_FreeProc sourceInterp out
.AP Tcl_Interp *interp out
Interpreter whose result is to be modified or read.
The interpreter get or set the result for.
.AP Tcl_Obj *objPtr in
Tcl value to become result for \fIinterp\fR.
A value to set the result to.
.AP char *result in
String value to become result for \fIinterp\fR or to be
appended to the existing result.
The string value set the result to, or to append to the existing result.
.AP "const char" *element in
String value to append as a list element
The string value to append as a list element
to the existing result of \fIinterp\fR.
.AP Tcl_FreeProc *freeProc in
Address of procedure to call to release storage at
\fIresult\fR, or \fBTCL_STATIC\fR, \fBTCL_DYNAMIC\fR, or
Pointer to a procedure to call to release storage at
\fIresult\fR.
\fBTCL_VOLATILE\fR.
.AP Tcl_Interp *sourceInterp in
Interpreter that the result and return options should be transferred from.
The interpreter to transfer the result and return options from.
.AP Tcl_Interp *targetInterp in
Interpreter that the result and return options should be transferred to.
The interpreter to transfer the result and return options to.
.AP int code in
Return code value that controls transfer of return options.
.BE
.SH DESCRIPTION
.PP
The procedures described here are utilities for manipulating the
result value in a Tcl interpreter.
These procedures manipulate the result of an interpreter.  Some procedures
provide a Tcl_Obj interface while others provide a string interface.  For
The interpreter result may be either a Tcl value or a string.
For example, \fBTcl_SetObjResult\fR and \fBTcl_SetResult\fR
example, \fBTcl_SetObjResult\fR accepts a Tcl_Obj and \fBTcl_SetResult\fR
set the interpreter result to, respectively, a value and a string.
Similarly, \fBTcl_GetObjResult\fR and \fBTcl_GetStringResult\fR
accepts a char *.  Similarly, \fBTcl_GetObjResult\fR produces a Tcl_Obj * and
return the interpreter result as a value and as a string.
The procedures always keep the string and value forms
\fBTcl_GetStringResult\fR produces a char *.  The procedures can be mixed and
of the interpreter result consistent.
For example, if \fBTcl_SetObjResult\fR is called to set
matched.  For example, if \fBTcl_SetObjResult\fR is called to set the result to
the result to a value,
then \fBTcl_GetStringResult\fR is called,
a Tcl_Obj value, and then \fBTcl_GetStringResult\fR is called, it returns a
it will return the value's string representation.
char * (but see caveats below).
.PP
\fBTcl_SetObjResult\fR
\fBTcl_SetObjResult\fR sets \fIobjPtr\fR as the result for \fIinterp\fR,
arranges for \fIobjPtr\fR to be the result for \fIinterp\fR,
replacing any existing result.
The result is left pointing to the value
referenced by \fIobjPtr\fR.
\fIobjPtr\fR's reference count is incremented
since there is now a new reference to it from \fIinterp\fR.
The reference count for any old result value
is decremented and the old result value is freed if no
references to it remain.
.PP
\fBTcl_GetObjResult\fR returns the result for \fIinterp\fR as a value.
The value's reference count is not incremented;
\fBTcl_GetObjResult\fR returns the result for \fIinterp\fR, without
incrementing its reference count.
if the caller needs to retain a long-term pointer to the value
they should use \fBTcl_IncrRefCount\fR to increment its reference count
in order to keep it from being freed too early or accidentally changed.
.PP
\fBTcl_SetResult\fR
\fBTcl_SetResult\fR sets \fIresult\fR as the result for \fIinterp\fR, replacing
arranges for \fIresult\fR to be the result for the current Tcl
command in \fIinterp\fR, replacing any existing result.
any existing result, and calls \fIfreeProc\fR to free \fIresult\fR.  See \fBTHE
The \fIfreeProc\fR argument specifies how to manage the storage
for the \fIresult\fR argument;
it is discussed in the section
\fBTHE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT\fR below.
If \fIresult\fR is \fBNULL\fR, then \fIfreeProc\fR is ignored
TCL_FREEPROC ARGUMENT TO TCL_SETRESULT\fR below.  If \fIresult\fR is
\fBNULL\fR, ignores \fIfreeProc\fR and sets the result for \fIinterp\fR to
and \fBTcl_SetResult\fR
re-initializes \fIinterp\fR's result to point to an empty string.
point to the empty string.
.PP
\fBTcl_GetStringResult\fR returns the result for \fIinterp\fR as a string.
\fBTcl_GetStringResult\fR returns the result for \fIinterp\fR as a string, i.e.
If the result was set to a value by a \fBTcl_SetObjResult\fR call,
the value form will be converted to a string and returned.
the bytes of the Tcl_Obj for the result, which can be decoded using
\fBTcl_UtfToExternal\fR.  This value is freed when its corresponding Tcl_Obj is
If the value's string representation contains null bytes,
this conversion will lose information.
For this reason, programmers are encouraged to
freed.Programmers are encouraged to use the newer Tcl_Obj API procedures, e.g.
write their code to use the new value API procedures
and to call \fBTcl_GetObjResult\fR instead.
to call \fBTcl_GetObjResult\fR instead.
.PP
\fBTcl_ResetResult\fR clears the result for \fIinterp\fR
\fBTcl_ResetResult\fR sets the empty string as the result for \fIinterp\fR and
and leaves the result in its normal empty initialized state.
If the result is a value,
its reference count is decremented and the result is left
pointing to an unshared value representing an empty string.
If the result is a dynamically allocated string, its memory is free*d
and the result is left as a empty string.
\fBTcl_ResetResult\fR also clears the error state managed by
clears the error state managed by \fBTcl_AddErrorInfo\fR,
\fBTcl_AddErrorInfo\fR, \fBTcl_AddObjErrorInfo\fR,
and \fBTcl_SetErrorCode\fR.
\fBTcl_AddObjErrorInfo\fR, and \fBTcl_SetErrorCode\fR.
.PP
\fBTcl_AppendResult\fR makes it easy to build up Tcl results in pieces.
\fBTcl_AppendResult\fR builds up a result from smaller pieces, appending each
It takes each of its \fIresult\fR arguments and appends them in order
to the current result associated with \fIinterp\fR.
\fIresult\fR in order to the current result for \fIinterp\fR.  It may be called
If the result is in its initialized empty state (e.g. a command procedure
was just invoked or \fBTcl_ResetResult\fR was just called),
then \fBTcl_AppendResult\fR sets the result to the concatenation of
its \fIresult\fR arguments.
\fBTcl_AppendResult\fR may be called repeatedly as additional pieces
of the result are produced.
repeatedly as additional pieces of the result are produced, and manages the
\fBTcl_AppendResult\fR takes care of all the
storage management issues associated with managing \fIinterp\fR's
result, such as allocating a larger result area if necessary.
It also manages conversion to and from the \fIresult\fR field of the
\fIinterp\fR so as to handle backward-compatibility with old-style
storage for the \fIinterp\fR's result, allocating a larger result area if
necessary.  It also manages conversion to and from the \fIresult\fR field of
the \fIinterp\fR to handle backward-compatibility with old-style extensions.
extensions.
Any number of \fIresult\fR arguments may be passed in a single
call; the last argument in the list must be (char *)NULL.
Any number of \fIresult\fR arguments may be passed in a single call; the last
argument in the list must be (char *)NULL.
.PP
\fBTcl_TransferResult\fR transfers interpreter state from \fIsourceInterp\fR
to \fItargetInterp\fR. The two interpreters must have been created in the
\fBTcl_TransferResult\fR transfers interpreter state from \fIsourceInterp\fR to
\fItargetInterp\fR, both of which must have been created in the same thread,
same thread.  If \fIsourceInterp\fR and \fItargetInterp\fR are the same,
nothing is done. Otherwise, \fBTcl_TransferResult\fR moves the result
from \fIsourceInterp\fR to \fItargetInterp\fR, and resets the result
in \fIsourceInterp\fR. It also moves the return options dictionary as
controlled by the return code value \fIcode\fR in the same manner
resets the result in \fIsourceInterp\fR, and moves the return options
dictionary as controlled by the return code value \fIcode\fR in the same manner
as \fBTcl_GetReturnOptions\fR.
.PP
If \fIsourceInterp\fR and \fItargetInterp\fR are the same, nothing is done.
.SH "DEPRECATED INTERFACES"
.SS "OLD STRING PROCEDURES"
.PP
Use of the following procedures is deprecated
since they manipulate the Tcl result as a string.
Procedures such as \fBTcl_SetObjResult\fR
The following procedures are deprecated since they manipulate the Tcl result as
a string.  Procedures such as \fBTcl_SetObjResult\fR can be significantly more
that manipulate the result as a value
can be significantly more efficient.
efficient.
.PP
\fBTcl_AppendElement\fR is similar to \fBTcl_AppendResult\fR in
\fBTcl_AppendElement\fR is like \fBTcl_AppendResult\fR, but it appends only one
that it allows results to be built up in pieces.
However, \fBTcl_AppendElement\fR takes only a single \fIelement\fR
argument and it appends that argument to the current result
as a proper Tcl list element.
\fBTcl_AppendElement\fR adds backslashes or braces if necessary
piece, and also appends that piece as a list item.
\fBTcl_AppendElement\fR adds backslashes or braces as necessary to ensure that
to ensure that \fIinterp\fR's result can be parsed as a list and that
\fIelement\fR will be extracted as a single element.
Under normal conditions, \fBTcl_AppendElement\fR will add a space
character to \fIinterp\fR's result just before adding the new
list element, so that the list elements in the result are properly
\fIelement\fR is properly formatted as a list item.  Under normal conditions,
\fBTcl_AppendElement\fR adds a space character to \fIinterp\fR's result just
before adding the new list element, so that the list elements in the result are
separated.
However if the new list element is the first in a list or sub-list
(i.e. \fIinterp\fR's current result is empty, or consists of the
single character
properly separated.  However if the new list element is the first item in the
list or sublist (i.e. \fIinterp\fR's current result is empty, or consists of
the single character
.QW { ,
or ends in the characters
.QW " {" )
then no space is added.
.SH "THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT"
.PP
\fBTcl_SetResult\fR's \fIfreeProc\fR argument specifies how
the Tcl system is to manage the storage for the \fIresult\fR argument.
If \fBTcl_SetResult\fR or \fBTcl_SetObjResult\fR are called
at a time when \fIinterp\fR holds a string result,
they do whatever is necessary to dispose of the old string result
(see the \fBTcl_Interp\fR manual entry for details on this).
.PP
If \fIfreeProc\fR is \fBTCL_STATIC\fR it means that \fIresult\fR
refers to an area of static storage that is guaranteed not to be
modified until at least the next call to \fBTcl_Eval\fR.
If \fIfreeProc\fR
\fIFreeProc\fR has the following type:
is \fBTCL_DYNAMIC\fR it means that \fIresult\fR was allocated with a call
to \fBTcl_Alloc\fR and is now the property of the Tcl system.
\fBTcl_SetResult\fR will arrange for the string's storage to be
released by calling \fBTcl_Free\fR when it is no longer needed.
If \fIfreeProc\fR is \fBTCL_VOLATILE\fR it means that \fIresult\fR
points to an area of memory that is likely to be overwritten when
\fBTcl_SetResult\fR returns (e.g. it points to something in a stack frame).
In this case \fBTcl_SetResult\fR will make a copy of the string in
dynamically allocated storage and arrange for the copy to be the
result for the current Tcl command.
.PP
If \fIfreeProc\fR is not one of the values \fBTCL_STATIC\fR,
\fBTCL_DYNAMIC\fR, and \fBTCL_VOLATILE\fR, then it is the address
of a procedure that Tcl should call to free the string.
This allows applications to use non-standard storage allocators.
When Tcl no longer needs the storage for the string, it will
call \fIfreeProc\fR. \fIFreeProc\fR should have arguments and
result that match the type \fBTcl_FreeProc\fR:
.PP
.CS
typedef void \fBTcl_FreeProc\fR(
        void *\fIblockPtr\fR);
.CE
.PP
When \fIfreeProc\fR is called, its \fIblockPtr\fR will be set to
the value of \fIresult\fR passed to \fBTcl_SetResult\fR.
When \fIfreeProc\fR is called, \fIblockPtr\fR is the \fIresult\fR value passed
to \fBTcl_SetResult\fR.

.SH "REFERENCE COUNT MANAGEMENT"
.PP
The interpreter result is one of the main places that owns references to
values, along with the bytecode execution stack, argument lists, variables,
and the list and dictionary collection values.
.PP
\fBTcl_SetObjResult\fR takes a value with an arbitrary reference count
\fI(specifically including zero)\fR and guarantees to increment the reference
count. If code wishes to continue using the value after setting it as the
result, it should add its own reference to it with \fBTcl_IncrRefCount\fR.
.PP
\fBTcl_GetObjResult\fR returns the current interpreter result value. This will
have a reference count of at least 1. If the caller wishes to keep the
interpreter result value, it should increment its reference count.
.PP
\fBTcl_GetStringResult\fR does not manipulate reference counts, but the string
it returns is owned by (and has a lifetime controlled by) the current
interpreter result value; it should be copied instead of being relied upon to
persist after the next Tcl API call, as most Tcl operations can modify the
interpreter result.
.PP
\fBTcl_SetResult\fR, \fBTcl_AppendResult\fR,
\fBTcl_AppendElement\fR, and \fBTcl_ResetResult\fR all modify the interpreter
result. They may cause the old interpreter result to have its reference count
decremented and a new interpreter result to be allocated. After they have been
called, the reference count of the interpreter result is guaranteed to be 1.
.SH "SEE ALSO"
Tcl_AddErrorInfo, Tcl_CreateObjCommand, Tcl_SetErrorCode, Tcl_Interp,
Tcl_GetReturnOptions
.SH KEYWORDS
append, command, element, list, value, result, return value, interpreter
Changes to doc/Tcl.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
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
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



+



+
+
+
+
+
+












+
-
-
-
+
+
+
-
-
-
-
-
+
+
-
-
-
-
+
+
+
+
+
-
-
-
-
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
+
-
-
-
-
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+

-
-
-
+
-
-
-
-
-
-
+
+
+
+
+
+

+
-
+
-
-
-
-
-
+
+
+
+
+
-
-
-
-
+
+
+
-
-
-
-
-
-
-
+
-
-
-
+
+
+

-
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+

-
-
+
+
-
-
+
+
+
-




-
+
-
-
-
-



-
-
-
-
-
-
-
-
+



-
-
-
+
-
-
-
+
-
-
+
-
-
-
+
+
-
-
-
-
-
-
-

+
+
-
-
+
+

-
-
+
-
-
-
+
+
-
-
-
-
+
+





+
-
+


+
-
+


+
-
+


+
-
+


+
-
+


+
-
+


+
-
+



-
-
-
+
+
+
-
-
-
+
+


+





-
-
-
-
+
+
+
-
-



-
+
-
-
-
+



-
+
-
-
-
+



-
+
-
-
-
+
+
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
+






'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2023 Nathan Coulter
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH Tcl n "8.6" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.SH NAME
Tcl \- Tool Command Language
.SH SYNOPSIS
Summary of Tcl language syntax.
.BE
.SH DESCRIPTION
.PP
The following rules define the syntax and semantics of the Tcl language:
.
.IP "[1] \fBCommands.\fR"
A Tcl script is a string containing one or more commands.
Semi-colons and newlines are command separators unless quoted as
.IP "[1] \fBScript.\fR"
A script is composed of zero or more commands delimited by semi-colons or
newlines.
described below.
Close brackets are command terminators during command substitution
(see below) unless quoted.
.IP "[2] \fBEvaluation.\fR"
A command is evaluated in two steps.
.IP "[2] \fBCommand.\fR"
A command is composed of zero or more words delimited by whitespace.  The
First, the Tcl interpreter breaks the command into \fIwords\fR
and performs substitutions as described below.
These substitutions are performed in the same way for all
commands.
replacement for a substitution is included verbatim in the word. For example, a
space in the replacement is included in the word rather than becoming a
delimiter, and \fI\\\\\fR becomes a single backslash in the word.  Each word is
processed from left to right and each substitution is performed as soon as it
is complete.
Secondly, the first word is used to locate a routine to
carry out the command, and the remaining words of the command are
passed to that routine.
The routine is free to interpret each of its words
For example, the command
.RS
.PP
.CS
set y [set x 0][incr x][incr x]
in any way it likes, such as an integer, variable name, list,
or Tcl script.
Different commands interpret their words differently.
.IP "[3] \fBWords.\fR"
.CE
.PP
is composed of three words, and sets the value of \fIy\fR to \fI012\fR.
.PP
If hash
.PQ #
is the first character of what would otherwise be the first word of a command,
all characters up to the next newline are ignored.
.RE
.
.IP "[3] \fBBraced word.\fR"
Words of a command are separated by white space (except for
newlines, which are command separators).
.IP "[4] \fBDouble quotes.\fR"
If the first character of a word is double-quote
If a word is enclosed in braces
.PQ {
and
.PQ } ""
, the braces are removed and the enclosed characters become the word.  No
substitutions are performed.  Nested pairs of braces may occur within the word.
A brace preceded by an odd number of backslashes is not considered part of a
pair, and neither brace nor the backslashes are removed from the word.
.
.IP "[4] \fBQuoted word.\fR"
If a word is enclosed in double quotes
.PQ \N'34'
then the word is terminated by the next double-quote character.
, the double quotes are removed and the enclosed characters become the word.
If semi-colons, close brackets, or white space characters
(including newlines) appear between the quotes then they are treated
as ordinary characters and included in the word.
Command substitution, variable substitution, and backslash substitution
Substitutions are performed.
.
.IP "[5] \fBList.\fR"
A list has the form of a single command.  Newline is whitespace, and semicolon
has no special interpretation.  There is no script evaluation so there is no
argument expansion, variable substitution, or command substitution: Dollar-sign
are performed on the characters between the quotes as described below.
The double-quotes are not retained as part of the word.
.IP "[5] \fBArgument expansion.\fR"
If a word starts with the string
and open bracket have no special interpretation, and what would be argument
expansion in a script is invalid in a list.
.
.IP "[6] \fBArgument expansion.\fR"
If
.QW {*}
followed by a non-whitespace character, then the leading
.QW {*}
is removed and the rest of the word is parsed and substituted as any other
prefixes a word, it is removed.  After any remaining enclosing braces or quotes
word. After substitution, the word is parsed as a list (without command or
variable substitutions; backslash substitutions are performed as is normal for
a list and individual internal words may be surrounded by either braces or
double-quote characters), and its words are added to the command being
substituted. For instance,
.QW "cmd a {*}{b [c]} d {*}{$e f {g h}}"
are processed and applicable substitutions performed, the word, which must
be a list, is removed from the command, and in its place each word in the
list becomes an additional word in the command.  For example,
.CS
cmd a {*}{b [c]} d {*}{$e f {g h}}
.CE
is equivalent to
.CS
.QW "cmd a b {[c]} d {$e} f {g h}" .
cmd a b {[c]} d {$e} f {g h} .
.IP "[6] \fBBraces.\fR"
If the first character of a word is an open brace
.PQ {
and rule [5] does not apply, then
the word is terminated by the matching close brace
.CE
.
.IP "[7] \fBEvaluation.\fR"
To evaluate a script, an interpreter evaluates each successive command.  The
first word identifies a procedure, and the remaining words are passed to that
.PQ } "" .
Braces nest within the word: for each additional open
brace there must be an additional close brace (however,
if an open brace or close brace within the word is
procedure for further evaluation.  The procedure interprets each argument in
its own way, e.g. as an integer, variable name, list, mathematical expression,
script, or in some other arbitrary way.  The result of the last command is the
quoted with a backslash then it is not counted in locating the
matching close brace).
No substitutions are performed on the characters between the
braces except for backslash-newline substitutions described
below, nor do semi-colons, newlines, close brackets,
or white space receive any special interpretation.
The word will consist of exactly the characters between the
result of the script.
outer braces, not including the braces themselves.
.IP "[7] \fBCommand substitution.\fR"
If a word contains an open bracket
.
.IP "[8] \fBCommand substitution.\fR"
Each pair of brackets
.PQ [
then Tcl performs \fIcommand substitution\fR.
and
To do this it invokes the Tcl interpreter recursively to process
the characters following the open bracket as a Tcl script.
The script may contain any number of commands and must be terminated
by a close bracket
.PQ ] "" .
The result of the script (i.e. the result of its last command) is
.PQ ] ""
encloses a script and is replaced by the result of that script.
substituted into the word in place of the brackets and all of the
characters between them.
There may be any number of command substitutions in a single word.
Command substitution is not performed on words enclosed in braces.
.IP "[8] \fBVariable substitution.\fR"
If a word contains a dollar-sign
.IP "[9] \fBVariable substitution.\fR"
Each of the following forms begins with dollar sign
.PQ $
followed by one of the forms
described below, then Tcl performs \fIvariable
and is replaced by the value of the identified variable.  \fIname\fR names the
variable and is composed of ASCII letters (\fBA\fR\(en\fBZ\fR and
substitution\fR:  the dollar-sign and the following characters are
replaced in the word by the value of a variable.
\fBa\fR\(en\fBz\fR), digits (\fB0\fR\(en\fB9\fR), underscores, or namespace
delimiters (two or more colons).  \fIindex\fR is the name of an individual
variable within an array variable, and may be empty.
Variable substitution may take any of the following forms:
.RS
.TP 15
\fB$\fIname\fR
.
\fIName\fR is the name of a scalar variable;  the name is a sequence
\fIname\fR may not be empty.
of one or more characters that are a letter, digit, underscore,
or namespace separators (two or more colons).
Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR,
\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR).
.TP 15
\fB$\fIname\fB(\fIindex\fB)\fR
.
\fIName\fR gives the name of an array variable and \fIindex\fR gives
the name of an element within that array.
\fIName\fR must contain only letters, digits, underscores, and
namespace separators, and may be an empty string.
Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR,
\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR).
Command substitutions, variable substitutions, and backslash
substitutions are performed on the characters of \fIindex\fR.
\fIname\fR may be empty.  Substitutions are performed on \fIindex\fR.
.TP 15
\fB${\fIname\fB}\fR
.
\fIName\fR is the name of a scalar variable or array element.  It may contain
any characters whatsoever except for close braces.  It indicates an array
element if \fIname\fR is in the form
\fIname\fR may be empty.
.QW \fIarrayName\fB(\fIindex\fB)\fR
where \fIarrayName\fR does not contain any open parenthesis characters,
.QW \fB(\fR ,
.TP 15
or close brace characters,
.QW \fB}\fR ,
\fB${\fIname(index)\fB}\fR
and \fIindex\fR can be any sequence of characters except for close brace
characters.  No further
substitutions are performed during the parsing of \fIname\fR.
.
\fIname\fR may be empty. No substitutions are performed.
.PP
There may be any number of variable substitutions in a single word.
Variable substitution is not performed on words enclosed in braces.
.PP
Note that variables may contain character sequences other than those listed
above, but in that case other mechanisms must be used to access them (e.g.,
via the \fBset\fR command's single-argument form).
.RE
Variables that are not accessible through one of the forms above may be
accessed through other mechanisms, e.g. the \fBset\fR command.
.IP "[9] \fBBackslash substitution.\fR"
If a backslash
.IP "[10] \fBBackslash substitution.\fR"
Each backslash
.PQ \e
appears within a word then \fIbackslash substitution\fR occurs.
In all cases but those described below the backslash is dropped and
that is not part of one of the forms listed below is removed, and the next
the following character is treated as an ordinary
character and included in the word.
This allows characters such as double quotes, close brackets,
character is included in the word verbatim, which allows the inclusion of
characters that would normally be interpreted, namely whitespace, braces,
and dollar signs to be included in words without triggering
special processing.
The following table lists the backslash sequences that are
handled specially, along with the value that replaces each sequence.
brackets, double quote, dollar sign, and backslash.  The following sequences
are replaced as described:
.RS
.RS
.RS
.TP 7
\e\fBa\fR
.
Audible alert (bell) (Unicode U+000007).
Audible alert (bell) (U+7).
.TP 7
\e\fBb\fR
.
Backspace (Unicode U+000008).
Backspace (U+8).
.TP 7
\e\fBf\fR
.
Form feed (Unicode U+00000C).
Form feed (U+C).
.TP 7
\e\fBn\fR
.
Newline (Unicode U+00000A).
Newline (U+A).
.TP 7
\e\fBr\fR
.
Carriage-return (Unicode U+00000D).
Carriage-return (U+D).
.TP 7
\e\fBt\fR
.
Tab (Unicode U+000009).
Tab (U+9).
.TP 7
\e\fBv\fR
.
Vertical tab (Unicode U+00000B).
Vertical tab (U+B).
.TP 7
\e\fB<newline>\fIwhiteSpace\fR
.
A single space character replaces the backslash, newline, and all spaces
and tabs after the newline.  This backslash sequence is unique in that it
is replaced in a separate pre-pass before the command is actually parsed.
Newline preceded by an odd number of backslashes, along with the consecutive
spaces and tabs that immediately follow it, is replaced by a single space.
Because this happens before the command is split into words, it occurs even
This means that it will be replaced even when it occurs between braces,
and the resulting space will be treated as a word separator if it is not
in braces or quotes.
within braced words, and if the resulting space may subsequently be treated as
a word delimiter.
.TP 7
\e\e
.
Backslash
.PQ \e "" .
.TP 7
\e\fIooo\fR
.
The digits \fIooo\fR (one, two, or three of them) give a eight-bit octal
value for the Unicode character that will be inserted, in the range
\fI000\fR\(en\fI377\fR (i.e., the range U+000000\(enU+0000FF).
The parser will stop just before this range overflows, or when
Up to three octal digits form an eight-bit value for a Unicode character in the
range \fI0\fR\(en\fI377\fR, i.e. U+0\(enU+FF.  Only the digits that result in a
number in this range are consumed.
the maximum of three digits is reached.  The upper bits of the Unicode
character will be 0.
.TP 7
\e\fBx\fIhh\fR
.
The hexadecimal digits \fIhh\fR (one or two of them) give an eight-bit
Up to two hexadecimal digits form an eight-bit value for a Unicode character in
hexadecimal value for the Unicode character that will be inserted.  The upper
bits of the Unicode character will be 0 (i.e., the character will be in the
range U+000000\(enU+0000FF).
the range \fI0\fR\(en\fIFF\fR.
.TP 7
\e\fBu\fIhhhh\fR
.
The hexadecimal digits \fIhhhh\fR (one, two, three, or four of them) give a
Up to four hexadecimal digits form a 16-bit value for a Unicode character in
sixteen-bit hexadecimal value for the Unicode character that will be
inserted.  The upper bits of the Unicode character will be 0 (i.e., the
character will be in the range U+000000\(enU+00FFFF).
the range \fI0\fR\(en\fIFFFF\fR.
.TP 7
\e\fBU\fIhhhhhhhh\fR
.
The hexadecimal digits \fIhhhhhhhh\fR (one up to eight of them) give a
Up to eight hexadecimal digits form a 21-bit value for a Unicode character in
twenty-one-bit hexadecimal value for the Unicode character that will be
inserted, in the range U+000000\(enU+10FFFF.  The parser will stop just
before this range overflows, or when the maximum of eight digits
the range \fI0\fR\(en\fI10FFFF\fR.  Only the digits that result in a number in
this range are consumed.
is reached.  The upper bits of the Unicode character will be 0.
.RE
.RE
.PP
Backslash substitution is not performed on words enclosed in braces,
except for backslash-newline as described above.
.RE
.IP "[10] \fBComments.\fR"
If a hash character
.PQ #
appears at a point where Tcl is
expecting the first character of the first word of a command,
then the hash character and the characters that follow it, up
through the next newline, are treated as a comment and ignored.
The comment character only has significance when it appears
at the beginning of a command.
.IP "[11] \fBOrder of substitution.\fR"
Each character is processed exactly once by the Tcl interpreter
as part of creating the words of a command.
For example, if variable substitution occurs then no further
substitutions are performed on the value of the variable;  the
value is inserted into the word verbatim.
If command substitution occurs then the nested command is
processed entirely by the recursive call to the Tcl interpreter;
no substitutions are performed before making the recursive
call and no additional substitutions are performed on the result
of the nested script.
.RS
.PP
Substitutions take place from left to right, and each substitution is
evaluated completely before attempting to evaluate the next.  Thus, a
sequence like
.PP
.CS
set y [set x 0][incr x][incr x]
.CE
.PP
will always set the variable \fIy\fR to the value, \fI012\fR.
.RE
.IP "[12] \fBSubstitution and word boundaries.\fR"
Substitutions do not affect the word boundaries of a command,
except for argument expansion as specified in rule [5].
For example, during variable substitution the entire value of
the variable becomes part of a single word, even if the variable's
value contains spaces.
.
.SH KEYWORDS
backslash, command, comment, script, substitution, variable
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/abstract.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH abstract n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::abstract \- a class that does not allow direct instances of itself
Changes to doc/after.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH after n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
after \- Execute a command after a time delay
Changes to doc/append.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH append n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
append \- Append to variable
Changes to doc/array.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH array n 8.7 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
array \- Manipulate array variables
Changes to doc/bgerror.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH bgerror n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
bgerror \- Command invoked to process background errors
Changes to doc/binary.n.
1
2
3
4
5
6
7






8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20







+
+
+
+
+
+







'\"
'\" Copyright (c) 1997 Sun Microsystems, Inc.
'\" Copyright (c) 2008 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH binary n 8.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
binary \- Insert and extract fields from binary strings
.SH SYNOPSIS
247
248
249
250
251
252
253
254

255
256
257
258
259
260
261
253
254
255
256
257
258
259

260
261
262
263
264
265
266
267







-
+







.PP
which returns a binary string equivalent to:
.PP
.CS
\fB\e254\fR
.CE
.PP
(i.e. \fB\exAC\fR) by
(i.e. \fB\exac\fR) by
truncating the high-bits of the character, and which is probably not
what is desired.
.RE
.IP \fBA\fR 5
This form is the same as \fBa\fR except that spaces are used for
padding instead of nulls.  For example,
.RS
305
306
307
308
309
310
311
312

313
314
315
316
317
318
319
311
312
313
314
315
316
317

318
319
320
321
322
323
324
325







-
+







.CS
\fBbinary format\fR B5B* 11100 111000011010
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\exE0\exE1\exA0\fR
\fB\exe0\exe1\exa0\fR
.CE
.RE
.IP \fBH\fR 5
Stores a string of \fIcount\fR hexadecimal digits in high-to-low
within each byte in the output binary string.  \fIArg\fR must contain a
sequence of characters in the set
.QW 0123456789abcdefABCDEF .
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
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







-
+














-
+







.CS
\fBbinary format\fR H3H*H2 ab DEF 987
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\exAB\ex00\exDE\exF0\ex98\fR
\fB\exab\ex00\exde\exf0\ex98\fR
.CE
.RE
.IP \fBh\fR 5
This form is the same as \fBH\fR except that the digits are stored in
low-to-high order within each byte. This is seldom required. For example,
.RS
.PP
.CS
\fBbinary format\fR h3h*h2 AB def 987
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\exBA\ex00\exED\ex0F\ex89\fR
\fB\exba\ex00\exed\ex0f\ex89\fR
.CE
.RE
.IP \fBc\fR 5
Stores one or more 8-bit integer values in the output string.  If no
\fIcount\fR is specified, then \fIarg\fR must consist of an integer
value. If \fIcount\fR is specified, \fIarg\fR must consist of a list
containing at least that many integers. The low-order 8 bits of each integer
369
370
371
372
373
374
375
376

377
378
379
380
381
382
383
375
376
377
378
379
380
381

382
383
384
385
386
387
388
389







-
+







.CS
\fBbinary format\fR c3cc* {3 -3 128 1} 260 {2 5}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\ex03\exFD\ex80\ex04\ex02\ex05\fR
\fB\ex03\exfd\ex80\ex04\ex02\ex05\fR
.CE
.PP
whereas:
.PP
.CS
\fBbinary format\fR c {2 5}
.CE
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
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







-
+















-
+







.CS
\fBbinary format\fR s3 {3 -3 258 1}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\ex03\ex00\exFD\exFF\ex02\ex01\fR
\fB\ex03\ex00\exfd\exff\ex02\ex01\fR
.CE
.RE
.IP \fBS\fR 5
This form is the same as \fBs\fR except that it stores one or more
16-bit integers in big-endian byte order in the output string.  For
example,
.RS
.PP
.CS
\fBbinary format\fR S3 {3 -3 258 1}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\ex00\ex03\exFF\exFD\ex01\ex02\fR
\fB\ex00\ex03\exff\exfd\ex01\ex02\fR
.CE
.RE
.IP \fBt\fR 5
This form (mnemonically \fItiny\fR) is the same as \fBs\fR and \fBS\fR
except that it stores the 16-bit integers in the output string in the
native byte order of the machine where the Tcl script is running.
To determine what the native byte order of the machine is, refer to
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
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







-
+















-
+







.CS
\fBbinary format\fR i3 {3 -3 65536 1}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\ex03\ex00\ex00\ex00\exFD\exFF\exFF\exFF\ex00\ex00\ex01\ex00\fR
\fB\ex03\ex00\ex00\ex00\exfd\exff\exff\exff\ex00\ex00\ex01\ex00\fR
.CE
.RE
.IP \fBI\fR 5
This form is the same as \fBi\fR except that it stores one or more one
or more 32-bit integers in big-endian byte order in the output string.
For example,
.RS
.PP
.CS
\fBbinary format\fR I3 {3 -3 65536 1}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\ex00\ex00\ex00\ex03\exFF\exFF\exFF\exFD\ex00\ex01\ex00\ex00\fR
\fB\ex00\ex00\ex00\ex03\exff\exff\exff\exfd\ex00\ex01\ex00\ex00\fR
.CE
.RE
.IP \fBn\fR 5
This form (mnemonically \fInumber\fR or \fInormal\fR) is the same as
\fBi\fR and \fBI\fR except that it stores the 32-bit integers in the
output string in the native byte order of the machine where the Tcl
script is running.
516
517
518
519
520
521
522
523

524
525
526
527
528
529
530
522
523
524
525
526
527
528

529
530
531
532
533
534
535
536







-
+







.CS
\fBbinary format\fR f2 {1.6 3.4}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\exCD\exCC\exCC\ex3F\ex9A\ex99\ex59\ex40\fR
\fB\excd\excc\excc\ex3f\ex9a\ex99\ex59\ex40\fR
.CE
.RE
.IP \fBr\fR 5
This form (mnemonically \fIreal\fR) is the same as \fBf\fR except that
it stores the single-precision floating point numbers in little-endian
order.  This conversion only produces meaningful output when used on
machines which use the IEEE floating point representation (very
542
543
544
545
546
547
548
549

550
551
552
553
554
555
556
548
549
550
551
552
553
554

555
556
557
558
559
560
561
562







-
+







.CS
\fBbinary format\fR d1 {1.6}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\ex9A\ex99\ex99\ex99\ex99\ex99\exF9\ex3F\fR
\fB\ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f\fR
.CE
.RE
.IP \fBq\fR 5
This form (mnemonically the mirror of \fBd\fR) is the same as \fBd\fR
except that it stores the double-precision floating point numbers in
little-endian order.  This conversion only produces meaningful output
when used on machines which use the IEEE floating point representation
795
796
797
798
799
800
801
802

803
804
805
806
807
808
809
801
802
803
804
805
806
807

808
809
810
811
812
813
814
815







-
+







.QW \fB*\fR ,
then all of the remaining hex digits in \fIstring\fR will be
scanned. If \fIcount\fR is omitted, then one hex digit will be
scanned. For example,
.RS
.PP
.CS
\fBbinary scan\fR \ex07\exC6\ex05\ex1F\ex34 H3H* var1 var2
\fBbinary scan\fR \ex07\exC6\ex05\ex1f\ex34 H3H* var1 var2
.CE
.PP
will return \fB2\fR with \fB07c\fR stored in \fIvar1\fR and
\fB051f34\fR stored in \fIvar2\fR.
.RE
.IP \fBh\fR 5
This form is the same as \fBH\fR, except the digits are taken in
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
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







-
+













-
+







.QW \fB*\fR ,
then all of the remaining bytes in \fIstring\fR will be scanned.  If
\fIcount\fR is omitted, then one 16-bit integer will be scanned.  For
example,
.RS
.PP
.CS
\fBbinary scan\fR \ex05\ex00\ex07\ex00\exF0\exFF s2s* var1 var2
\fBbinary scan\fR \ex05\ex00\ex07\ex00\exf0\exff s2s* var1 var2
.CE
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.  Note that the integers returned are signed unless
\fBsu\fR is used in place of \fBs\fR.
.RE
.IP \fBS\fR 5
This form is the same as \fBs\fR except that the data is interpreted
as \fIcount\fR 16-bit integers represented in big-endian byte
order.  For example,
.RS
.PP
.CS
\fBbinary scan\fR \ex00\ex05\ex00\ex07\exFF\exF0 S2S* var1 var2
\fBbinary scan\fR \ex00\ex05\ex00\ex07\exff\exf0 S2S* var1 var2
.CE
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.
.RE
.IP \fBt\fR 5
The data is interpreted as \fIcount\fR 16-bit signed integers
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
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







-
+















-
+







.QW \fB*\fR ,
then all of the remaining bytes in \fIstring\fR will be scanned.  If
\fIcount\fR is omitted, then one 32-bit integer will be scanned.  For
example,
.RS
.PP
.CS
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exF0\exFF\exFF\exFF
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff
\fBbinary scan\fR $str i2i* var1 var2
.CE
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.  Note that the integers returned are signed unless
\fBiu\fR is used in place of \fBi\fR.
.RE
.IP \fBI\fR 5
This form is the same as \fBI\fR except that the data is interpreted
as \fIcount\fR 32-bit signed integers represented in big-endian byte
order, or as unsigned if \fBu\fR is placed
immediately after the \fBI\fR.  For example,
.RS
.PP
.CS
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exFF\exFF\exFF\exF0
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0
\fBbinary scan\fR $str I2I* var1 var2
.CE
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.
.RE
.IP \fBn\fR 5
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
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







-
+














-
+







.QW \fB*\fR ,
then all of the remaining bytes in \fIstring\fR will be scanned.  If
\fIcount\fR is omitted, then one 64-bit integer will be scanned.  For
example,
.RS
.PP
.CS
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exF0\exFF\exFF\exFF
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff
\fBbinary scan\fR $str wi* var1 var2
.CE
.PP
will return \fB2\fR with \fB30064771077\fR stored in \fIvar1\fR and
\fB\-16\fR stored in \fIvar2\fR.
.RE
.IP \fBW\fR 5
This form is the same as \fBw\fR except that the data is interpreted
as \fIcount\fR 64-bit signed integers represented in big-endian byte
order, or as unsigned if \fBu\fR is placed
immediately after the \fBW\fR.  For example,
.RS
.PP
.CS
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exFF\exFF\exFF\exF0
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0
\fBbinary scan\fR $str WI* var1 var2
.CE
.PP
will return \fB2\fR with \fB21474836487\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.
.RE
.IP \fBm\fR 5
973
974
975
976
977
978
979
980

981
982
983
984
985
986
987
979
980
981
982
983
984
985

986
987
988
989
990
991
992
993







-
+







bytes that are scanned may vary.  If the data does not represent a
valid floating point number, the resulting value is undefined and
compiler dependent.  For example, on a Windows system running on an
Intel Pentium processor,
.RS
.PP
.CS
\fBbinary scan\fR \ex3F\exCC\exCC\exCD f var1
\fBbinary scan\fR \ex3f\excc\excc\excd f var1
.CE
.PP
will return \fB1\fR with \fB1.6000000238418579\fR stored in
\fIvar1\fR.
.RE
.IP \fBr\fR 5
This form is the same as \fBf\fR except that the data is interpreted
997
998
999
1000
1001
1002
1003
1004

1005
1006
1007
1008
1009
1010
1011
1003
1004
1005
1006
1007
1008
1009

1010
1011
1012
1013
1014
1015
1016
1017







-
+







This form is the same as \fBf\fR except that the data is interpreted
as \fIcount\fR double-precision floating point numbers in the
machine's native representation. For example, on a Windows system
running on an Intel Pentium processor,
.RS
.PP
.CS
\fBbinary scan\fR \ex9A\ex99\ex99\ex99\ex99\ex99\exF9\ex3F d var1
\fBbinary scan\fR \ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f d var1
.CE
.PP
will return \fB1\fR with \fB1.6000000000000001\fR
stored in \fIvar1\fR.
.RE
.IP \fBq\fR 5
This form is the same as \fBd\fR except that the data is interpreted
Changes to doc/break.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH break n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
break \- Abort looping command
Changes to doc/callback.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH callback n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
callback, mymethod \- generate callbacks to methods
Changes to doc/catch.n.
1
2
3
4
5
6
7






8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20







+
+
+
+
+
+







'\"
'\" Copyright (c) 1993-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Contributions from Don Porter, NIST, 2003.  (not subject to US copyright)
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH catch n "8.5" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
catch \- Evaluate script and trap exceptional returns
Changes to doc/cd.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH cd n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
cd \- Change working directory
Changes to doc/chan.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
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
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


+



+
+
+
+
+
+
+
+





-
+

-
+



-
-
+
+
-
-
-
-
-
+
+
+
+




-
-
-
+
+
+
-
-
-




-
-
+
+
-
-
-
-
-
-
-
-
-
+


-
-
+
+
-
-
-
-
+
+
+

+
-
+
-
-
-
-
+
+
+

-
-
+
+
+
+
+

-
-
+
-
-
+
-
-
-
-
-

-
-
+
+
+
-

-
-
-
+
-
+
+

-
-
-
-
+
+


-
+











-
+

-
-
+


-
-
-
-
+
+
+
+
-
-
-
+
+

-
-
+
+
-
-
-
+
-
-
+
-




-
-
+
+
-
-
-
-
+
+
-
-
-
+
+
-
+




-
-
-
+
+
+
-
-
-
+
+
-
-
+
-
-
-
+




-
-
+
+
-
-


-
+

-
-
-
+
+
+
-
-
-
+
-
-
-
-


-
-
-
-
-
-
-
-
-
-
-
-
+
+
+





-
-
-
-
-
-
-
+
+
+
+
+
+
+
+





-
-
-
-
-
+
+
+
+
+







-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+


-
+
-
-
-
-
+
+
+
-
-
-
+
+


-
-
+
+
-
-
-
+
-
-
-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
+
-
-
-
+
-

-
+
-
-
+
-
-
-
-
+
+

-
+
-
-
-
+
+







'\"
'\" Copyright (c) 2005-2006 Donal K. Fellows
'\" Copyright (c) 2021 Nathan Coulter
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" Copyright (c) 2024 Nathan Coulter
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
.TH chan n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
chan \- Read, write and manipulate channels
chan \- Reads, writes and manipulates channels.
.SH SYNOPSIS
\fBchan \fIoption\fR ?\fIarg arg ...\fR?
\fBchan \fIprocedure\fR ?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
This command provides several operations for reading from, writing to
and otherwise manipulating open channels (such as have been created
\fBchan\fR provides procedures for reading from, writing to, and
otherwise manipulating channels like those created by \fBopen\fR and
with the \fBopen\fR and \fBsocket\fR commands, or the default named
channels \fBstdin\fR, \fBstdout\fR or \fBstderr\fR which correspond to
the process's standard input, output and error streams respectively).
\fIOption\fR indicates what to do with the channel; any unique
abbreviation for \fIoption\fR is acceptable. Valid options are:
\fBsocket\fR, or the default channels \fBstdin\fR, \fBstdout\fR or \fBstderr\fR
which correspond respectively to the standard input, output, and error streams
of the process.
Available procedures are:
.\" METHOD: blocked
.TP
\fBchan blocked \fIchannel\fR
.
This tests whether the last input operation on the channel called
\fIchannel\fR failed because it would have otherwise caused the
process to block, and returns 1 if that was the case. It returns 0
Returns 1 when \fIchannel\fR is non-blocking and the last input operation on
\fIchannel\fR failed because it would have otherwise caused the process to
block, and 0 otherwise.
otherwise. Note that this only ever returns 1 when the channel has
been configured to be non-blocking; all Tcl channels have blocking
turned on by default.
.\" METHOD: close
.TP
\fBchan close \fIchannel\fR ?\fIdirection\fR?
.
Close and destroy the channel called \fIchannel\fR. Note that this
deletes all existing file-events registered on the channel.
Closes \fIchannel\fR, deleting any existing event handlers established for it,
and returns the empty string.  Once both sides of a \fIchannel\fR are closed,
If the \fIdirection\fR argument (which must be \fBread\fR or \fBwrite\fR or
any unique abbreviation of them) is present, the channel will only be
half-closed, so that it can go from being read-write to write-only or
read-only respectively. If a read-only channel is closed for reading, it is
the same as if the channel is fully closed, and respectively similar for
write-only channels. Without the \fIdirection\fR argument, the channel is
closed for both reading and writing (but only if those directions are
currently open). It is an error to close a read-only channel for writing, or a
write-only channel for reading.
\fIchannel\fR no-longer exists in the current \fBinterp\fR.
.RS
.PP
As part of closing the channel, all buffered output is flushed to the
channel's output device (only if the channel is ceasing to be writable), any
If \fIdirection\fR, which may be \fBread\fR or \fBwrite\fR or any unique
abbreviation of those words, is given, closes only that side of \fIchannel\fR.
buffered input is discarded (only if the channel is ceasing to be readable),
the underlying operating system resource is closed and \fIchannel\fR becomes
unavailable for future use (both only if the channel is being completely
closed).
If \fIchannel\fR is read-write and the write side is closed, it becomes
read-only, or if the read side is closed, it becomes write-only.
.PP
.PP
Discards any buffered input before closing the read side of \fIchannel\fR.
If the channel is blocking and the channel is ceasing to be writable, the
Fully flushes any output before closing the write side of \fIchannel\fR unless
command does not return until all output is flushed.  If the channel is
non-blocking and there is unflushed output, the channel remains open and the
command returns immediately; output will be flushed in the background and the
channel will be closed when all the flushing is complete.
it is non-blocking mode, where it makes \fIchannel\fR unavailable, returns
immediately, and flushes any buffered output the background before actually
closing \fIchannel\fR.
.PP
If \fIchannel\fR is a blocking channel for a command pipeline then
\fBchan close\fR waits for the child processes to complete.
Returns an error if \fIchannel\fR is blocking and error occurs while flushing
output.  Produces an error in the same manner as \fBexec\fR if a
process in a command pipeline created by \fBopen\fR returns an error (either by
returning a non-zero exit code or writing to its standard error file
descriptor).
.PP
If the channel is shared between interpreters, then \fBchan close\fR
makes \fIchannel\fR unavailable in the invoking interpreter but has
If \fIchannel\fR is a command pipeline and is in blocking mode, waits
no other effect until all of the sharing interpreters have closed the
channel. When the last interpreter in which the channel is registered
for the connected processes to complete before closing \fIchannel\fR.
invokes \fBchan close\fR (or \fBclose\fR), the cleanup actions
described above occur. With half-closing, the half-close of the channel only
applies to the current interpreter's view of the channel until all channels
have closed it in that direction (or completely).
See the \fBinterp\fR command for a description of channel sharing.
.PP
Channels are automatically fully closed when an interpreter is destroyed and
when the process exits.  Channels are switched to blocking mode, to
Only affects the current interpreter.  If \fIchannel\fR is open in any other
interpreter, its state is unchanged there.  See \fBinterp\fR for a description
of channel sharing.
ensure that all output is correctly flushed before the process exits.
.PP
The command returns an empty string, and may generate an error if
an error occurs while flushing output.  If a command in a command
pipeline created with \fBopen\fR returns an error, \fBchan close\fR
Closing one side of a socket or command pipeline may cause the underlying
generates an error (similar to the \fBexec\fR command.)
system resource to be closed or destroyed, along with whatever side-effects
that entails for the process on the other side of the pipeline.
.PP
Note that half-closes of sockets and command pipelines can have important side
effects because they result in a shutdown() or close() of the underlying
system resource, which can change how other processes or systems respond to
the Tcl program.
When the last interpreter sharing a channel is destroyed, the channel is
switched to blocking mode, fully flushed, and then closed.
.PP
Channels are automatically closed when an interpreter is destroyed and
when the process exits.
also when the process exits.
From 8.6 on (TIP#398), nonblocking channels are no longer switched to
blocking mode when exiting; this guarantees a timely exit even when the
peer or a communication channel is stalled. To ensure proper flushing of
stalled nonblocking channels on exit, one must now either (a) actively
switch them back to blocking or (b) use the environment variable
\fBTCL_FLUSH_NONBLOCKING_ON_EXIT\fR, which when set and not equal to
.QW \fB0\fR
restores the previous behavior.
.RE
.\" METHOD: configure
.TP
\fBchan configure \fIchannel\fR ?\fIoptionName\fR? ?\fIvalue\fR? ?\fIoptionName value\fR?...
\fBchan configure \fIchannel\fR ?\fIoption\fR? ?\fIvalue\fR? ?\fIoption value\fR?...
.
Query or set the configuration options of the channel named
\fIchannel\fR.
Sets or gets the configuration of \fIchannel\fR.
.RS
.PP
If no \fIoptionName\fR or \fIvalue\fR arguments are supplied, the
command returns a list containing alternating option names and values
for the channel.  If \fIoptionName\fR is supplied but no \fIvalue\fR
then the command returns the current value of the given option.  If
If no \fIoption\fR or \fIvalue\fR arguments are given, \fBchan configure\fR
returns a dictionary of option names and values for \fIchannel\fR.  If
\fIoption\fR is supplied without a \fIvalue\fR, \fBchan configure\fR returns
the current value that option.  If one or more values are given, \fBchan
one or more pairs of \fIoptionName\fR and \fIvalue\fR are supplied,
the command sets each of the named options to the corresponding
\fIvalue\fR; in this case the return value is an empty string.
configure\fR sets each of the given options to the corresponding \fIvalue\fR
and returns the empty string.
.PP
The options described below are supported for all channels. In
addition, each channel type may add options that only it supports. See
The following options are supported for all channels. Each type of
channel may provide additional options. Those options are described in the
the manual entry for the command that creates each type of channel
for the options supported by that specific type of channel. For
example, see the manual entry for the \fBsocket\fR command for additional
relevant documentation. For example, additional options are documented for
options for sockets, and the \fBopen\fR command for additional options for
serial devices.
\fBsocket\fR, and also for serial devices at \fBopen\fR.
.RE
.\" OPTION: -blocking
.TP
\fB\-blocking\fI boolean\fR
.
The \fB\-blocking\fR option determines whether I/O operations on the
channel can cause the process to block indefinitely.  The value of the
If \fB\-blocking\fR is set to \fBtrue\fR (default), reading from or writing to
\fIchannel\fR may cause the process to block indefinitely.  Otherwise,
option must be a proper boolean value.  Channels are normally in
blocking mode; if a channel is placed into non-blocking mode it will
affect the operation of the \fBchan gets\fR, \fBchan read\fR, \fBchan
puts\fR, \fBchan flush\fR, and \fBchan close\fR commands; see the
operations such as \fBchan gets\fR, \fBchan read\fR, \fBchan puts\fR, \fBchan
flush\fR, and \fBchan close\fR take care not to block.  For non-blocking mode
documentation for those commands for details.  For non-blocking mode to
work correctly, the application must be using the Tcl event loop
(e.g. by calling \fBTcl_DoOneEvent\fR or invoking the \fBvwait\fR
to work correctly the event loop must be active, e.g. via 
\fBTcl_DoOneEvent\fR or \fBvwait\fR or by using Tk, so that channel events
command).
are processed.
.\" OPTION: -buffering
.TP
\fB\-buffering\fI newValue\fR
.
If \fInewValue\fR is \fBfull\fR then the I/O system will buffer output
until its internal buffer is full or until the \fBchan flush\fR
command is invoked. If \fInewValue\fR is \fBline\fR, then the I/O
If \fInewValue\fR is \fBfull\fR, which is the default, output is buffered
until the internal buffer is full or until \fBchan flush\fR is called. If
\fInewValue\fR is \fBline\fR, output is flushed each time a end-of-line
system will automatically flush output for the channel whenever a
newline character is output. If \fInewValue\fR is \fBnone\fR, the I/O
system will flush automatically after every output operation.  The
character is written. If \fInewValue\fR is \fBnone\fR, output is flushed after
every output operation.  For \fBstdin\fR, \fBstdout\fR, and channels that
default is for \fB\-buffering\fR to be set to \fBfull\fR except for
channels that connect to terminal-like devices; for these channels the
connect to terminal-like devices, the default value is \fBline\fR.  For
initial setting is \fBline\fR.  Additionally, \fBstdin\fR and
\fBstdout\fR are initially set to \fBline\fR, and \fBstderr\fR is set
to \fBnone\fR.
\fBstderr\fR the default value is \fBnone\fR.
.\" OPTION: -buffersize
.TP
\fB\-buffersize\fI newSize\fR
.
\fInewSize\fR must be an integer; its value is used to set the size
of buffers, in bytes, subsequently allocated for this channel to store
\fInewSize\fR, an integer no greater than one million, is the size in bytes of
any input or output buffers subsequently allocated for \fIchannel\fR.
input or output. \fInewSize\fR must be a number of no more than one
million, allowing buffers of up to one million bytes in size.
.\" OPTION: -encoding
.TP
\fB\-encoding\fR \fIname\fR
\fB\-encoding\fR \fIencoding\fR
.
This option is used to specify the encoding of the channel as one of
the named encodings returned by \fBencoding names\fR, so that the
data can be converted to and from
Sets the encoding of \fIchannel\fR to \fIencoding\fR which should be one of the
encodings returned by \fBencoding names\fR.
Input is converted from the encoding into Unicode, and output is converted
Unicode for use in Tcl.  For instance, in order for Tcl to read
characters from a Japanese file in \fBshiftjis\fR and properly process
and display the contents, the encoding would be set to \fBshiftjis\fR.
from Unicode to the encoding.
Thereafter, when reading from the channel, the bytes in the Japanese
file would be converted to Unicode as they are read.  Writing is also
supported \- as Tcl strings are written to the channel they will
automatically be converted to the specified encoding on output.
.RS
.PP
If a file contains pure binary data (for instance, a JPEG image), the
encoding for the channel should be configured to be \fBiso8859-1\fR.  Tcl
will then assign no interpretation to the data in the file and simply
read or write raw bytes.  The Tcl \fBbinary\fR command can be used to
manipulate this byte-oriented data.  It is usually better to set the
\fB\-translation\fR option to \fBbinary\fR when you want to transfer
binary data, as this turns off the other automatic interpretations of
the bytes in the stream as well.
.PP
The default encoding for newly opened channels is the same platform-
and locale-dependent system encoding used for interfacing with the
operating system, as returned by \fBencoding system\fR.
The encoding of a new channel is the value of \fBencoding system\fR,
which returns the platform- and locale-dependent system encoding used to
interface with the operating system,
.RE
.\" OPTION: -eofchar
.TP
\fB\-eofchar\fI char\fR
.
This option supports DOS file systems that use Control-z (\ex1A) as an
end of file marker.  If \fIchar\fR is not an empty string, then this
character signals end-of-file when it is encountered during input.
Otherwise (the default) there is no special end of file character marker.
The acceptable range for \fB\-eofchar\fR values is \ex01 - \ex7f;
attempting to set \fB\-eofchar\fR to a value outside of this range will
generate an error.
\fIchar\fR signals the end of the data when it is encountered in the input.
If \fIchar\fR is the empty string, there is no special character that marks
the end of the data.
.RS
.PP
The default value is the empty string.  The acceptable range is \ex01 -
\ex7f.  A value outside this range results in an error.
.RE
.VS "TCL8.7 TIP656"
.\" OPTION: -profile
.TP
\fB\-profile\fI profile\fR
.
Specifies the encoding profile to be used on the channel. The encoding
transforms in use for the channel's input and output will then be subject to the
rules of that profile. Any failures will result in a channel error. See
\fBPROFILES\fR in the \fBencoding(n)\fR documentation for details about encoding
profiles.
Indicates the encoding profile to be used on \fIchannel\fR. The encoding
transforms in use for the input and output of \fIchannel\fR will then be
subject to the rules of that profile. Any failures will result in a channel
error. See \fBPROFILES\fR in the \fBencoding(n)\fR documentation for details
about encoding profiles.
.VE "TCL8.7 TIP656"
.\" OPTION: -translation
.TP
\fB\-translation\fI translation\fR
.TP
\fB\-translation\fR \fB{\fIinTranslation outTranslation\fB}\fR
.
In Tcl scripts the end of a line is always represented using a single
newline character (\en).  However, in actual files and devices the end
of a line may be represented differently on different platforms, or
even for different devices on the same platform.  For example, under
UNIX newlines are used in files, whereas carriage-return-linefeed
sequences are normally used in network connections.  On input (i.e.,
with \fBchan gets\fR and \fBchan read\fR) the Tcl I/O system
In Tcl a single line\-feed character (\fBlf\fR) represents the end of a
line.  However, the end of a line of a may be represented differently on
different platforms, or even for different devices on the same platform.  For
example, in UNIX \fBlf\fR is normally used in files, and a carriage-return
character followed by a line-feed character (\fBcrlf\fR) is
normally used in network connections.  Therefore, when decoding, e.g. with
\fBchan gets\fR and \fBchan read\fR, each particular end-of-line representation
automatically translates the external end-of-line representation into
newline characters.  Upon output (i.e., with \fBchan puts\fR), the I/O
system translates newlines to the external end-of-line representation.
The default translation mode, \fBauto\fR, handles all the common cases
automatically, but the \fB\-translation\fR option provides explicit
control over the end of line translations.
is translated into \fBlf\fR for Tcl.  Before encoding, e.g. with \fBchan
puts\fR, each \fBlf\fR is translated to the approprate end\-of\-line
representation for the target.  The default translation setting is \fBauto\fR,
which handles all the common cases.  When needed, \fB\-translation\fR provides
explicit control over the end\-of\-line representation.
.RS
.PP
The value associated with \fB\-translation\fR is a single item for
Returns the input translation if \fIchannel\fR is read\-only, the output
read-only and write-only channels.  The value is a two-element list for
read-write channels; the read translation mode is the first element of
the list, and the write translation mode is the second element.  As a
convenience, when setting the translation mode for a read-write channel
translation if \fIchannel\fR is write\-only, and both the input translation and
the output translation if \fIchannel\fR is read\-write.  When two
translations are given, they indicate the input and output translation
you can specify a single value that will apply to both reading and
writing.  When querying the translation mode of a read-write channel, a
two-element list will always be returned.  The following values are
respectively.  When only one translation is given for a read\-write channel, it
is the translation for both input and output.  The following values are
currently supported:
.IP \fBauto\fR
As the input translation mode, \fBauto\fR treats any of newline
(\fBlf\fR), carriage return (\fBcr\fR), or carriage return followed by
The default.  For input each occurrence of \fBlf\fR, carriage-return character
(\fBcr\fR), or \fBcrlf\fR is translated into \fBlf\fR for Tcl.  For output,
a newline (\fBcrlf\fR) as the end of line representation.  The end of
line representation can even change from line-to-line, and all cases
are translated to a newline.  As the output translation mode,
each \fBlf\fR is translated into a the appropriate representation for the
\fBauto\fR chooses a platform specific representation; for sockets on
all platforms Tcl chooses \fBcrlf\fR, for all Unix flavors, it chooses
\fBlf\fR, and for the various flavors of Windows it chooses
\fBcrlf\fR.  The default setting for \fB\-translation\fR is \fBauto\fR
for both input and output.
target:  For all Unix variants it is \fBlf\fR, and for all Windows variants it
is \fBcrlf\fR, except that for sockets on all platforms it is \fBcrlf\fR for
both input and output.
.IP \fBbinary\fR
Like \fBlf\fR, no end-of-line translation is performed, but in addition, sets
\fB\-eofchar\fR to the empty string to disable it, and sets \fB\-encoding\fR
to \fBiso8859-1\fR.  With this one setting, a channel is fully configured
for binary input and output:  Each byte read from the channel
becomes the Unicode character having the same value as that byte, and each
character written to the channel becomes a single byte in the output.  This
makes it possible to work seamlessly with binary data as long as each character
in the data remains in the range of 0 to 255 so that there is no distinction
between binary data and text.  For example, A JPEG image can be read from a
such a channel, manipulated, and then written back to such a channel.
Like \fBlf\fR, prevents end-of-line translation, but also sets \fB\-eofchar\fR
to the empty string to disable it, and sets \fB\-encoding\fR to
\fBiso8859-1\fR.  This one argument fully configures \fIchannel\fR for bytewise
input and output:  Each byte is read from \fIchannel\fR as the Unicode
character having the same value as that byte, and each character written to
\fIchannel\fR is encoded a single byte having the value of the character.  This
makes it possible to treat text as byte values as long as each character in
remains in the range of 0 to 255 so that the correspondance between a character
and a byte is maintained.  For example, A JPEG image can be read from
\fIchannel\fR, manipulated, and then written back to \fIchannel\fR.
.IP \fBcr\fR
The end of a line in the underlying file or device is represented by a
The end of a line is encoded as \fBcr\fR.  For input, each \fBcr\fR is
single carriage return character.  As the input translation mode,
\fBcr\fR mode converts carriage returns to newline characters.  As the
output translation mode, \fBcr\fR mode translates newline characters
translated to \fBlf\fR, and for output each \fBlf\fR is translated to \fBcr\fR.
to carriage returns.
.IP \fBcrlf\fR
The end of a line in the underlying file or device is represented by a
The end of a line is encoded as a \fBcrlf\fR.  For input, each \fBcrlf\fR is
carriage return character followed by a linefeed character.  As the
input translation mode, \fBcrlf\fR mode converts
translated to \fBlf\fR.  For output, each \fBlf\fR is translated to \fBcrlf\fR.
carriage-return-linefeed sequences to newline characters.  As the
output translation mode, \fBcrlf\fR mode translates newline characters
to carriage-return-linefeed sequences.  This mode is typically used on
Windows platforms and for network connections.
This translation is typically used for network connections, and is also used on
Windows systems.
.IP \fBlf\fR
The end of a line in the underlying file or device is represented by a
The end of a line is encoded as \fBlf\fR so no translations occur during either
single newline (linefeed) character.  In this mode no translations
occur during either input or output.  This mode is typically used on
UNIX platforms.
input or output.  This translation is typically used on UNIX platforms,
.RE
.RE
.\" METHOD: copy
.TP
\fBchan copy \fIinputChan outputChan\fR ?\fB\-size \fIsize\fR? ?\fB\-command \fIcallback\fR?
.
Reads characters from \fIinputChan\fR and writes them to \fIoutputChan\fR until
all characters are copied, blocking until the copy is complete and returning
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
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







-
+
-
-
+
-
-
+
-
-
-


-
-
-
+



-
+
-
-
+
-

-
+
-
-
+
-
-
-
-
+
+
-

-
-
-
+
+
-
-
-
+
-
-
-
-
-
-
+
+
+

-
-
+
+
-
-
-
+
+

-
+
-
-
+
-
-
-
-
-
+

-
+
-
-
-
+





-
-
-
+
+




-
-
-
-
+
+
+
+
+
-
-
-
+
+
+
-
-
-
-
+
+


-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+


-
-
-
+
+
+
+

-
-
+
+

-
+










-
-
+
+
-
-
-
+
+

-
-
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
+





-
-
-
-
-
+
-
-
-
+
+
-
-
+
-




-
-
+
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-


-
-
+
-
-
+
+
-
-
-
-
-
-
-
+

-
-
+
-
-
-
+
+
+





-
-
-
+
+
+
-




-
+
-
-
+




-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+




-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+


-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
-
+
+
+
+
+
+
+





-
+
-
-
-
-
+
+
+




-
+
-
-
-
-
+
+
+
+
-
-
+


-
-
+
+
-
+

-
-
-
-
-
+
+
-
+

-
-
-
-
+
+
-

-
-
-
-
-
-
+
+
+





-
+
-
-
-
+
+
-
-
-
+
+
-




-
-
+
+
-
-



-
+
-
-
+
-
-
-

-
-
-
+
+
+
-
-
+

-
+
-
-
+
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+

-
+
-
-
-
+
+
+







-
+
-
-
-
-
-
-
+
+
+
+
+
-


-
+
-
-
-
+
-
-
-
-
-
+
+
+
+

-
-
+
+
-
-

-
+
-
-
-
-
+
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
+
-
-

-
-
+
+
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
+
+
+
-
-
+
+
-
-
+



-
-
-
-
+
+
+
+


-
+
-

-
+
-
-

-
-
-
-
+

-
-
-
+
-
-
+
-
-
+

-
-
-
+
+
+





-
-
-
-
+
+
+
-
-




-
-
-
+
+
-







.QW "channel busy"
error.
.RE
.\" METHOD: create
.TP
\fBchan create \fImode cmdPrefix\fR
.
This subcommand creates a new script level channel using the command
Creates a new channel, called a \fBreflected\fR channel, with \fIcmdPrefix\fR
prefix \fIcmdPrefix\fR as its handler. Any such channel is called a
\fBreflected\fR channel. The specified command prefix, \fBcmdPrefix\fR,
as its handler, and returns the name of the channel.  \fBcmdPrefix\fR is the
must be a non-empty list, and should provide the API described in the
\fBrefchan\fR manual page. The handle of the new channel is
first words of a command that provides the interface for a \fBrefchan\fR.
returned as the result of the \fBchan create\fR command, and the
channel is open. Use either \fBclose\fR or \fBchan close\fR to remove
the channel.
.RS
.PP
The argument \fImode\fR specifies if the new channel is opened for
reading, writing, or both. It has to be a list containing any of the
strings
\fBImode\fR is a list of one or more of the strings
.QW \fBread\fR
or
.QW \fBwrite\fR ,
The list must have at least one
indicating whether the channel is a read channel, a write channel, or both.
element, as a channel you can neither write to nor read from makes no
sense. The handler command for the new channel must support the chosen
It is an error if the handler does not support the chosen mode.
mode, or an error is thrown.
.PP
The command prefix is executed in the global namespace, at the top of
The handler is called as needed from the global namespace at the top level, and
call stack, following the appending of arguments as described in the
\fBrefchan\fR manual page. Command resolution happens at the
command resolution happens there at the time of the call.  If the handler is
time of the call. Renaming the command, or destroying it means that
the next call of a handler method may fail, causing the channel
command invoking the handler to fail as well. Depending on the
subcommand being invoked, the error message may not be able to explain
renamed or deleted any subsequent attempt to call it is an error, which may
not be able to describe the failure.
the reason for that failure.
.PP
Every channel created with this subcommand knows which interpreter it
was created in, and only ever executes its handler command in that
interpreter, even if the channel was shared with and/or was moved into
The handler is always called in the interpreter and thread it was created in,
even if the channel was shared with or moved into a different interpreter in a
a different interpreter. Each reflected channel also knows the thread
it was created in, and executes its handler command only in that
thread, even if the channel was moved into a different thread. To this
different thread.  This is achieved through event dispatch, so if the event
end all invocations of the handler are forwarded to the original
thread by posting special events to it. This means that the original
thread (i.e. the thread that executed the \fBchan create\fR command)
must have an active event loop, i.e. it must be able to process such
events. Otherwise the thread sending them will \fIblock
indefinitely\fR. Deadlock may occur.
loop is not entered, e.g. by calling \fBTcl_DoOneEvent\fR or \fBvwait\fR or
using Tk, the thread performing the channel operation \fIblocks
indefinitely\fR, resulting in deadlock.
.PP
Note that this permits the creation of a channel whose two endpoints
live in two different threads, providing a stream-oriented bridge
One side of a channel may be in one thread while the other side is in a
different thread, providing a stream-oriented bridge between the threads. This
between these threads. In other words, we can provide a way for
regular stream communication between threads instead of having to send
commands.
provides a method for regular stream communication between threads as an
alternative to sending commands.
.PP
When a thread or interpreter is deleted, all channels created with
When the interpreter the handler is in is deleted each channel associated with
this subcommand and using this thread/interpreter as their computing
base are deleted as well, in all interpreters they have been shared
the handler is deleted as well, regardless of which interpreter or thread it
with or moved into, and in whatever thread they have been transferred
to. While this pulls the rug out under the other thread(s) and/or
interpreter(s), this cannot be avoided. Trying to use such a channel
will cause the generation of a regular error about unknown channel
handles.
is currently in or shared with.
.PP
This subcommand is \fBsafe\fR and made accessible to safe
\fBchan create\fR is \fBsafe\fR and is accessible to safe interpreters.  The
interpreters.  While it arranges for the execution of arbitrary Tcl
code the system also makes sure that the code is always executed
within the safe interpreter.
handler is always called in the safe interpreter it was created in.
.RE
.\" METHOD: eof
.TP
\fBchan eof \fIchannel\fR
.
Test whether the last input operation on the channel called
\fIchannel\fR failed because the end of the data stream was reached,
returning 1 if end-of-file was reached, and 0 otherwise.
Returns 1 if the last read on \fIchannel\fR failed because the end of the data
was already reached, and 0 otherwise.
.\" METHOD: event
.TP
\fBchan event \fIchannel event\fR ?\fIscript\fR?
.
Arrange for the Tcl script \fIscript\fR to be installed as a \fIfile
event handler\fR to be called whenever the channel called
\fIchannel\fR enters the state described by \fIevent\fR (which must
be either \fBreadable\fR or \fBwritable\fR); only one such handler may
Arranges for the given script, called a \fBchannel event handler\fR, to be
called whenever the given event, either
.QW \fBreadable\fR
or
.QW \fBwritable\fR
be installed per event per channel at a time.  If \fIscript\fR is the
empty string, the current handler is deleted (this also happens if the
channel is closed or the interpreter deleted).  If \fIscript\fR is
occurs on \fIchannel\fR, replacing any script that was previously set.  If
\fIscript\fR is the empty string the current handler is deleted.  If
\fIscript\fR is omitted, either the existing script or the empty string is
omitted, the currently installed script is returned (or an empty
string if no such handler is installed).  The callback is only
performed if the event loop is being serviced (e.g. via \fBvwait\fR or
\fBupdate\fR).
returned.  For handlers to be processed, the event loop must be entered, e.g.
via \fBvwait\fR or \fBupdate\fR, or by using Tk.
.RS
.PP
A file event handler is a binding between a channel and a script, such
that the script is evaluated whenever the channel becomes readable or
writable.  File event handlers are most commonly used to allow data to
be received from another process on an event-driven basis, so that the
\fIscript\fR is evaluated at the global level in the interpreter it was
established in.  Any resulting error is handled in the background, i.e. via
\fBinterp bgerror\fR.  In order to prevent an endless loop due to a buggy
handler, the handler is deleted if \fIscript\fR returns an error so that it is
not evaluated again.
receiver can continue to interact with the user or with other channels
while waiting for the data to arrive.  If an application invokes
\fBchan gets\fR or \fBchan read\fR on a blocking channel when there is
no input data available, the process will block; until the input data
arrives, it will not be able to service other events, so it will
appear to the user to
.PP
Without an event handler, \fBchan gets\fR or \fBchan read\fR on \fIchannel\fR in
blocking mode may block until data becomes available, during which the
thread is unable to perform other work or respond to events on other channels.
This could cause the application to appear to
.QW "freeze up"
\&.
With \fBchan event\fR, the
process can tell when data is present and only invoke \fBchan gets\fR
or \fBchan read\fR when they will not block.
Channel event handlers allow events on \fIchannel\fR to direct channel handling
so that the reader or writer can continue to perform other processing while
waiting for a channel to become available and then handle channel operations
when the channel is ready for the operation.
.PP
A channel is considered to be readable if there is unread data
available on the underlying device.  A channel is also considered to
\fIchannel\fR is considered to be readable if there is unread data
available on the underlying device.  \fIchannel\fR is also considered to
be readable if there is unread data in an input buffer, except in the
special case where the most recent attempt to read from the channel
special case where the most recent attempt to read from \fIchannel\fR
was a \fBchan gets\fR call that could not find a complete line in the
input buffer.  This feature allows a file to be read a line at a time
in non-blocking mode using events.  A channel is also considered to be
readable if an end of file or error condition is present on the
underlying file or device.  It is important for \fIscript\fR to check
for these conditions and handle them appropriately; for example, if
there is no special check for end of file, an infinite loop may occur
where \fIscript\fR reads no data, returns, and is immediately invoked
again.
.PP
A channel is considered to be writable if at least one byte of data
can be written to the underlying file or device without blocking, or
\fIchannel\fR is considered to be writable if at least one byte of data can be
written to the underlying file or device without blocking, or if an error
if an error condition is present on the underlying file or device.
Note that client sockets opened in asynchronous mode become writable
when they become connected or if the connection fails.
condition is present. Note that client sockets opened in asynchronous mode
become writable when they become connected or if the connection fails.
.PP
Event-driven I/O works best for channels that have been placed into
non-blocking mode with the \fBchan configure\fR command.  In blocking
Event-driven channel handling works best for channels in non-blocking mode.  In
blocking mode \fIchannel\fR blocks when \fBchan puts\fR writes more data than
mode, a \fBchan puts\fR command may block if you give it more data
than the underlying file or device can accept, and a \fBchan gets\fR
or \fBchan read\fR command will block if you attempt to read more data
than is ready; no events will be processed while the commands block.
In non-blocking mode \fBchan puts\fR, \fBchan read\fR, and \fBchan
\fIchannel\fR can accept at the moment, and also when \fBchan gets\fR or
\fBchan read\fR requests more data than is currently available.  When
\fIchannel\fR blocks, the thread can not do any other processing or service any
other events.  When \fIchannel\fR is in non-blocking mode a thread may to carry
gets\fR never block.
.PP
The script for a file event is executed at global level (outside the
context of any Tcl procedure) in the interpreter in which the \fBchan
event\fR command was invoked.  If an error occurs while executing the
script then the command registered with \fBinterp bgerror\fR is used
to report the error.  In addition, the file event handler is deleted
if it ever returns an error; this is done in order to prevent infinite
loops due to buggy handlers.
on with other work and get back to \fIchannel\fR at the right time.
.RE
.\" METHOD: flush
.TP
\fBchan flush \fIchannel\fR
.
Ensures that all pending output for the channel called \fIchannel\fR
is written.
.RS
.PP
If the channel is in blocking mode the command does not return until
If \fIchannel\fR is in blocking mode, flushes all buffered output to the
all the buffered output has been flushed to the channel. If the
channel is in non-blocking mode, the command may return before all
buffered output has been flushed; the remainder will be flushed in the
destination and then returns.  If \fIchannel\fR is non-blocking, returns
immediately while all buffered output is flushed in the background as soon as
background as fast as the underlying file or device is able to absorb
it.
possible.
.RE
.\" METHOD: gets
.TP
\fBchan gets \fIchannel\fR ?\fIvarName\fR?
.
Reads a line from the channel consisting of all characters up to the next
end-of-line sequence or until end of file is seen. The line feed character
Reads and returns the characters up to but not including the next end\-of\-line
representation or the end of the input, whichever comes first. If \fIvarName\fR
corresponding to end-of-line sequence is not included as part of the line.
If the \fIvarName\fR argument is specified, the line is stored in the variable
of that name and the command returns the length of the line. If \fIvarName\fR
is given, stores the result in the variable named \fIvarName\fR and returns the
length of the line.  If the line was terminated by the end of the input rather
is not specified, the command returns the line itself as the result of the command.
.RS
.PP
If a complete line is not available and the channel is not at EOF, the command
will block in the case of a blocking channel. For non-blocking channels, the
command will return the empty string as the result in the case of \fIvarName\fR
not specified and -1 if it is.
.RE
.RS
.PP
If a blocking channel is already at EOF, the command returns an empty string if
\fIvarName\fR is not specified. Note an empty string result can also be returned
when a blank line (no characters before the next end of line sequence). The two
cases can be distinguished by calling the \fBchan eof\fR command to check for
end of file. If \fIvarName\fR is specified, the command returns -1 on end of file.
than an end-of-line representation, a subsequent call to \fBchan eof\fR returns
1.  If more input is needed and \fIchannel\fR is non-blocking, returns the
empty string or if \fIvarName\fR was given returns \-1.
There is no ambiguity in this case because blank lines result in 0 being returned.
.RE
.RS
.PP
If a non-blocking channel is already at EOF, the command returns an empty line
if \fIvarName\fR is not specified. This can be distinguished from an empty line
If necessary use \fIvarName\fR along with a return value of 0 to determine that
being returned by either a blank line being read or a full line not being available
through the use of the \fBchan eof\fR and \fBchan blocked\fR commands. If
a line is actually empty, as opposed to more input being needed to provide a
complete line.  \fBchan eof\fR can then be used to determine whether more input
\fBchan eof\fR returns true, the channel is at EOF. If \fBchan blocked\fR returns
true, a full line was not available. If both commands return false, an empty
line was read. If \fIvarName\fR was specified for a non-bocking channel at EOF,
the command returns -1. This can be distinguished from full line not being
available either by \fBchan eof\fR or \fBchan blocked\fR as above. Note that
when \fIvarName\fR is specified, there is no need to distinguish between eof
and blank lines as the latter will result in the command returning 0.
is forthcoming.
.PP
If the encoding profile \fBstrict\fR is in effect for the channel, the command
will raise an exception with the POSIX error code \fBEILSEQ\fR if any encoding
Returns an error with the POSIX error code \fBEILSEQ\fR if the encoding profile
errors are encountered in the channel input data. The file pointer remains
unchanged and it is possible to introspect, and in some cases recover, by
changing the encoding in use. See \fBENCODING ERROR EXAMPLES\fR later.
for \fIchannel\fR is \fBstrict\fR and a decoding error occurs, in which case
the current position is unchanged and it may be possible to change the encoding
and continue to read the input.  See \fBENCODING ERROR EXAMPLES\fR later.
.RE
.\" METHOD: isbinary
.TP
\fBchan isbinary \fIchannel\fR
.
Test whether the channel called \fIchannel\fR is a binary channel,
returning 1 if it is and, and 0 otherwise. A binary channel is
a channel with iso8859-1 encoding, -eofchar set to {} and
Returns 1 if \fIchannel\fR is configured as described for \fB-translation
binary\fR, and 0 otherwise.

-translation set to lf.
.\" METHOD: names
.TP
\fBchan names\fR ?\fIpattern\fR?
.
Produces a list of all channel names. If \fIpattern\fR is specified,
Returns a list of all channel names, or if \fIpattern\fR is given, only those
only those channel names that match it (according to the rules of
\fBstring match\fR) will be returned.
names that match according to the rules of \fBstring match\fR.
.\" METHOD: pending
.TP
\fBchan pending \fImode channel\fR
.
Depending on whether \fImode\fR is \fBinput\fR or \fBoutput\fR,
returns the number of
bytes of input or output (respectively) currently buffered
internally for \fIchannel\fR (especially useful in a readable event
callback to impose application-specific limits on input line lengths to avoid
a potential denial-of-service attack where a hostile user crafts
an extremely long line that exceeds the available memory to buffer it).
Returns -1 if the channel was not opened for the mode in question.
Returns the number of bytes of input
when \fImode\fR is
.QW\fBinput\fR
, or output when \fImode\fR is
.QW\fBoutput\fR
, that are currently internally buffered for \fIchannel\fR.  Useful in a readable
event callback to impose limits on input line length to avoid a potential
denial-of-service attack where an extremely long line exceeds the available
memory to buffer it.  Returns -1 if \fIchannel\fR was not opened for the mode in
question.
.\" METHOD: pipe
.TP
\fBchan pipe\fR
.
Creates a standalone pipe whose read- and write-side channels are
returned as a 2-element list, the first element being the read side and
Creates a pipe, i.e. a readable channel and a writable channel, and returns the
names of these channels. Data written to the writable channel can be read from
the readable channel.  Because the pipe is a real system-level pipe, it can be
the second the write side. Can be useful e.g. to redirect
separately \fBstderr\fR and \fBstdout\fR from a subprocess. To do
this, spawn with "2>@" or
connected to other processes using redirection.  For example, to redirect
\fBstderr\fR from a subprocess into one channel, and \fBstdout\fR into another,
\fBexec\fR with "2>@" and ">@", each onto the writable side of a pipe, closing
">@" redirection operators onto the write side of a pipe, and then
immediately close it in the parent. This is necessary to get an EOF on
the read side once the child has exited or otherwise closed its output.
the writable side immediately thereafter so that EOF is signaled on the read
side once the subprocess has closed its output, typically on exit.
.RS
.PP
Note that the pipe buffering semantics can vary at the operating system level
substantially; it is not safe to assume that a write performed on the output
side of the pipe will appear instantly to the input side. This is a
Due to buffering, data written to one side of a pipe might not immediately
become available on the other side.  Tcl's own buffers can be configured via
\fBchan configure -buffering\fR, but overall behaviour still depends on
operating system buffers outside of Tcl's control. Once the write side of the
fundamental difference and Tcl cannot conceal it. The overall stream semantics
\fIare\fR compatible, so blocking reads and writes will not see most of the
differences, but the details of what exactly gets written when are not. This
is most likely to show up when using pipelines for testing; care should be
taken to ensure that deadlocks do not occur and that potential short reads are
channel is closed, any data remaining in the buffers is flushed through to the
read side.  It may be useful to arrange for the connected process to flush at
some point after writing to the channel or to have it use some system-provided
mechanism to configure buffering.  When two pipes are connected to the same
process, one to send data to the process, and one to read data from the
process, a deadlock may occur if the channels are in blocking mode:  If
allowed for.
reading, the channel may block waiting for data that can never come because
buffers are only flushed on subsequent writes, and if writing, the channel may
block while waiting for the buffers to become free, which can never happen
because the reader can not read while the writer is blocking.  To avoid this
issue, either put the channels into non-blocking mode and use event handlers,
or place the read channel and the write channel in separate interpreters in
separate threads.
.RE
.\" METHOD: pop
.TP
\fBchan pop \fIchannel\fR
.
Removes the topmost transformation from the channel \fIchannel\fR, if there
Removes the topmost transformation handler from \fIchannel\fR if there is one,
is any. If there are no transformations added to \fIchannel\fR, this is
equivalent to \fBchan close\fR of that channel. The result is normally the
empty string, but can be an error in some situations (i.e. where the
underlying system stream is closed and that results in an error).
and closes \fIchannel\fR otherwise. The result is normally the empty string,
but may be an error in some situations, e.g. when closing the underlying
resource results in an error.
.\" METHOD: postevent
.TP
\fBchan postevent \fIchannel eventSpec\fR
.
This subcommand is used by command handlers specified with \fBchan
For use by handlers established with \fBchan create\fR.  Notifies Tcl that
create\fR. It notifies the channel represented by the handle
\fIchannel\fR that the event(s) listed in the \fIeventSpec\fR have
occurred. The argument has to be a list containing any of the strings
\fBread\fR and \fBwrite\fR. The list must contain at least one
that one or more event(s) listed in \fIeventSpec\fR, each of which is either
.QW\fBread\fR
or
.QW\fBwrite\fR.
element as it does not make sense to invoke the command if there are
no events to post.
, have occurred.
.RS
.PP
Note that this subcommand can only be used with channel handles that
were created/opened by \fBchan create\fR. All other channels will
For use only by handlers for \fIchannel\fR which must have been created by
\fBchan create\fR.  It is an error to post an event for any other kind of
cause this subcommand to report an error.
channel.
.PP
As only the Tcl level of a channel, i.e. its command handler, should
post events to it we also restrict the usage of this command to the
interpreter that created the channel. In other words, posting events
to a reflected channel from an interpreter that does not contain it's
implementation is not allowed. Attempting to post an event from any
Since only the handlers for a reflected channel should post events it is
an error to post an event from any interpreter other than the interpreter that
other interpreter will cause this subcommand to report an error.
created the channel.
.PP
Another restriction is that it is not possible to post events that the
I/O core has not registered an interest in. Trying to do so will cause
the method to throw an error. See the command handler method
\fBwatch\fR described in \fBrefchan\fR, the document specifying
It is an error to post an event that \fIchannel\fR has no interest in.  See
\fBwatch\fR in the \fBrefchan\fR documentation for more information
the API of command handlers for reflected channels.
.PP
This command is \fBsafe\fR and made accessible to safe interpreters.
It can trigger the execution of \fBchan event\fR handlers, whether in the
current interpreter or in other interpreters or other threads, even
where the event is posted from a safe interpreter and listened for by
a trusted interpreter. \fBChan event\fR handlers are \fIalways\fR
executed in the interpreter that set them up.
\fBchan postevent\fR is available in safe interpreters, as any handler for a
reflected channel would have been created, and will be evaluated in that
interpreter as well.
.RE
.\" METHOD: push
.TP
\fBchan push \fIchannel cmdPrefix\fR
.
Adds a new transformation on top of the channel \fIchannel\fR. The
Adds a new transformation handler on top of \fIchannel\fR and returns a handle
\fIcmdPrefix\fR argument describes a list of one or more words which represent
a handler that will be used to implement the transformation. The command
prefix must provide the API described in the \fBtranschan\fR manual page.
for the transformation.  \fIcmdPrefix\fR is the first words of a command that
provides the interface documented for \fBtranschan\fR, and transforms data on
The result of this subcommand is a handle to the transformation. Note that it
is important to make sure that the transformation is capable of supporting the
channel mode that it is used with or this can make the channel neither
\fIchannel\fR, It is an error if handler does not support the mode(s)
\fIchannel\fR is in.
readable nor writable.
.\" METHOD: puts
.TP
\fBchan puts\fR ?\fB\-nonewline\fR? ?\fIchannel\fR? \fIstring\fR
.
Writes \fIstring\fR to the channel named \fIchannel\fR followed by a
newline character. A trailing newline character is written unless the
Writes \fIstring\fR and a line feed to \fIchannel\fR.  If \fB\-nonewline\fR is
given, the trailing line feed is not written. The default channel is
optional flag \fB\-nonewline\fR is given. If \fIchannel\fR is
omitted, the string is written to the standard output channel,
\fBstdout\fR.
.RS
.PP
Newline characters in the output are translated by \fBchan puts\fR to
Each line feed in the output is translated to the appropriate end of line
platform-specific end-of-line sequences according to the currently
configured value of the \fB\-translation\fR option for the channel
sequence as per the \fB\-translation\fR configuration setting of \fIchannel\fR.
(for example, on PCs newlines are normally replaced with
carriage-return-linefeed sequences; see \fBchan configure\fR above for
details).
.PP
Tcl buffers output internally, so characters written with \fBchan
puts\fR may not appear immediately on the output file or device; Tcl
will normally delay output until the buffer is full or the channel is
Because Tcl internally buffers output, characters written to \fIchannel\fR may not
immediately be available at the destination.  Tcl normally delays output until
the buffer is full or \fIchannel\fR is closed. \fBchan flush\fR forces output in
closed.  You can force output to appear immediately with the \fBchan
flush\fR command.
the direction of the destination.
.PP
When the output buffer fills up, the \fBchan puts\fR command will
If \fIchannel\fR is in blocking mode and the write buffer fills up, blocks
normally block until all the buffered data has been accepted for
output by the operating system.  If \fIchannel\fR is in non-blocking
until space in the buffer is available again. If \fIchannel\fR is in 
mode then the \fBchan puts\fR command will not block even if the
operating system cannot accept the data.  Instead, Tcl continues to
buffer the data and writes it in the background as fast as the
underlying file or device can accept it.  The application must use the
Tcl event loop for non-blocking output to work; otherwise Tcl never
non-blocking mode, returns immediately and the data is written in the
background as fast possible, constrained by the speed at which the
destination accepts it. Data written to a channel in non-blocking mode can only
actually be written to the underlying resource when the application enters the
event loop so that channel events can be processed. When a channel is in
finds out that the file or device is ready for more output data.  It
is possible for an arbitrarily large amount of data to be buffered for
a channel in non-blocking mode, which could consume a large amount of
memory.  To avoid wasting memory, non-blocking I/O should normally be
used in an event-driven fashion with the \fBchan event\fR command
(do not invoke \fBchan puts\fR unless you have recently been notified
via a file event that the channel is ready for more output data).
non-blocking mode, Tcl's internal buffers can hold an arbitrary amount of data,
possibly consuming a large amount of memory. To avoid wasting memory, channels
in non-blocking mode should normally be handled using \fBchan event\fR, where
the application only invokes \fBchan puts\fR after being notified through a
file event handler that the channel is ready for more output data.
.PP
The command will raise an error exception with POSIX error code \fBEILSEQ\fR if
Returns an error with POSIX error code \fBEILSEQ\fR if the encoding profile of
the encoding profile \fBstrict\fR is in effect for the channel and the output
data cannot be encoded in the encoding configured for the channel. Data
may be partially written to the channel in this case.
\fIchannel\fR is \fBstrict\fR and the data cannot be encoded in the encoding
for the channel. The data that were successfully encoded up to the point of
error may be written to the channel.
.RE
.\" METHOD: read
.TP
\fBchan read \fIchannel\fR ?\fInumChars\fR?
.TP
\fBchan read \fR?\fB\-nonewline\fR? \fIchannel\fR
.
In the first form, the result will be the next \fInumChars\fR
Reads and returns the next \fInumChars\fR characters from \fIchannel\fR. If
characters read from the channel named \fIchannel\fR; if
\fInumChars\fR is omitted, all characters up to the point when the
channel would signal a failure (whether an end-of-file, blocked or
other error condition) are read. In the second form (i.e. when
\fInumChars\fR has been omitted) the flag \fB\-nonewline\fR may be
given to indicate that any trailing newline in the string that has
\fInumChars\fR is omitted, all available characters up to the end of the file
are read, or if \fIchannel\fR is in non-blocking mode, all currently-available
characters are read.  If there is an error on \fIchannel\fR, reading ceases and
an error is returned.  If \fInumChars\fR is not given, \fB\-nonewline\fR
may be given, causing any trailing line feed to be trimmed.
been read should be trimmed.
.RS
.PP
If \fIchannel\fR is in non-blocking mode, \fBchan read\fR may not
If \fIchannel\fR is in non-blocking mode, fewer characters than requested may be
read as many characters as requested: once all available input has
been read, the command will return the data that is available rather
than blocking for more input.  If the channel is configured to use a
returned.  If \fIchannel\fR is configured to use a multi-byte encoding, bytes
multi-byte encoding, then there may actually be some bytes remaining
in the internal buffers that do not form a complete character.  These
bytes will not be returned until a complete character is available or
end-of-file is reached.  The \fB\-nonewline\fR switch is ignored if
the command returns before reaching the end of the file.
that do not form a complete character are retained in the buffers until enough
bytes to complete the character accumulate, or the end of the data is reached.
\fB\-nonewline\fR is ignored if characters are returned before reaching the end
of the file.
.PP
\fBChan read\fR translates end-of-line sequences in the input into
newline characters according to the \fB\-translation\fR option for the
Each end-of-line sequence according to the value of \fB\-translation\fR is
translated into a line feed.
channel (see \fBchan configure\fR above for a discussion on the ways
in which \fBchan configure\fR will alter input).
.PP
When reading from a serial port, most applications should configure
When reading from a serial port, most applications should configure the channel
the serial port channel to be non-blocking, like this:
.PP
.CS
\fBchan configure \fIchannel \fB\-blocking \fI0\fR.
to be in non-blocking mode, but not necessarily use an event handler since most
.CE
.PP
Then \fBchan read\fR behaves much like described above.  Note that
most serial ports are comparatively slow; it is entirely possible to
get a \fBreadable\fR event for each character read from them. Care
must be taken when using \fBchan read\fR on blocking serial ports:
serial ports are comparatively slow.  It is entirely possible to get a
\fBreadable\fR event for each individual character.  In blocking mode, \fBchan
read\fR blocks forever when reading to the end of the data if there is no
.TP
\fBchan read \fIchannel numChars\fR
.
In this form \fBchan read\fR blocks until \fInumChars\fR have been
received from the serial port.
.TP
\fBchan read \fIchannel\fR
.
In this form \fBchan read\fR blocks until the reception of the
end-of-file character, see \fBchan configure -eofchar\fR. If there no
\fBchan configure -eofchar\fR configured for the channel.
end-of-file character has been configured for the channel, then
\fBchan read\fR will block forever.
.PP
If the encoding profile \fBstrict\fR is in effect for the channel, the command
will raise an exception with the POSIX error code \fBEILSEQ\fR if any encoding
If the encoding profile for \fIchannel\fR is \fBstrict\fR, raises an exception
with the POSIX error code \fBEILSEQ\fR if a decoding error is encountered when
errors are encountered in the channel input data. If the channel is in blocking
mode, the error is thrown after advancing the file pointer to the beginning of
the invalid data. The successfully decoded leading portion of the data prior to
the error location is returned as the value of the \fB\-data\fR key of the error
option dictionary. If the channel is in non-blocking mode, the successfully
reading. If \fIchannel\fR is blocking , advances the file pointer to the
beginning of the invalid input and returns the error. The input that was
successfully-decoded up to the first byte that resulted in an error is
available in as the \fB\-result read\fR entry in the error option dictionary.
If \fIchannel\fR is in non-blocking mode, returns the successfully-decoded
decoded portion of data is returned by the command without an error
exception being raised. A subsequent read will start at the invalid data
and immediately raise a \fBEILSEQ\fR POSIX error exception. Unlike the
blocking channel case, the \fB\-data\fR key is not present in the
error option dictionary. In the case of exception thrown due to encoding
input.  A subsequent read starts at the position of the invalid data
and raises a \fBEILSEQ\fR POSIX error exception. Unlike the blocking channel
case, the \fB\-result read\fR key is not present in the error option
dictionary. It may be possible to change the encoding for \fIchannel\fR in
errors, it is possible to introspect, and in some cases recover, by
changing the encoding in use. See \fBENCODING ERROR EXAMPLES\fR later.
order to read the input that previously resulted in the decoding error. See
\fBENCODING ERROR EXAMPLES\fR later.
.RE
.\" METHOD: seek
.RE .\" METHOD: seek
.TP
\fBchan seek \fIchannel offset\fR ?\fIorigin\fR?
.
Sets the current access position within the underlying data stream for
the channel named \fIchannel\fR to be \fIoffset\fR bytes relative to
\fIorigin\fR. \fIOffset\fR must be an integer (which may be negative)
and \fIorigin\fR must be one of the following:
Sets the current position in \fIchannel\fR to integer \fIoffset\fR
bytes relative to \fIorigin\fR.  A negative offset moves the current position
backwards from the origin.  \fIorigin\fR is one of the
following:
.RS
.IP \fBstart\fR
The new access position will be \fIoffset\fR bytes from the start
The origin is the start of the data.  This is the default.
of the underlying file or device.
.IP \fBcurrent\fR
The new access position will be \fIoffset\fR bytes from the current
The origin is the current position.
access position; a negative \fIoffset\fR moves the access position
backwards in the underlying file or device.
.IP \fBend\fR
The new access position will be \fIoffset\fR bytes from the end of the
file or device.  A negative \fIoffset\fR places the access position
before the end of file, and a positive \fIoffset\fR places the access
position after the end of file.
The origin is the end of the data.
.PP
The \fIorigin\fR argument defaults to \fBstart\fR.
.PP
\fBChan seek\fR flushes all buffered output for the channel before the
\fBChan seek\fR flushes all buffered output even if \fIchannel\fR is in
command returns, even if the channel is in non-blocking mode.  It also
discards any buffered and unread input.  This command returns an empty
non-blocking mode, discards any buffered and unread input, and returns the
string.  An error occurs if this command is applied to channels whose
underlying file or device does not support seeking.
empty string or an error if \fIchannel\fR does not support seeking.
.PP
Note that \fIoffset\fR values are byte offsets, not character offsets.
Both \fBchan seek\fR and \fBchan tell\fR operate in terms of bytes,
not characters, unlike \fBchan read\fR.
\fIoffset\fR values are byte offsets, not character offsets.  Unlike \fBchan
read\fR, both \fBchan seek\fR and \fBchan tell\fR operate in terms of bytes,
not characters,
.RE
.\" METHOD: tell
.TP
\fBchan tell \fIchannel\fR
.
Returns a number giving the current access position within the
underlying data stream for the channel named \fIchannel\fR. This
value returned is a byte offset that can be passed to \fBchan seek\fR
in order to set the channel to a particular position.  Note that this
Returns the offset in bytes of the current position in the underlying data, or
-1 if \fIchannel\fR does not support seeking. The value can be passed to \fBchan
seek\fR to set current position to that offset.
value is in terms of bytes, not characters like \fBchan read\fR.  The
value returned is -1 for channels that do not support seeking.
.\" METHOD: truncate
.TP
\fBchan truncate \fIchannel\fR ?\fIlength\fR?
.
Sets the byte length of the underlying data stream for the channel
named \fIchannel\fR to be \fIlength\fR (or to the current byte
offset within the underlying data stream if \fIlength\fR is
Flushes \fIchannel\fR and truncates the data in \fIchannel\fR to \fIlength\fR
bytes, or to the current position in bytes if \fIlength\fR is omitted.
omitted). The channel is flushed before truncation.
.
.SH EXAMPLES
.SS "SIMPLE CHANNEL OPERATION EXAMPLES"
.PP
Instruct Tcl to always send output to \fBstdout\fR immediately,
whether or not it is to a terminal:
.PP
868
869
870
871
872
873
874
875
876



877
878
879
880
881
882

883
884
885
886
887
888
889
689
690
691
692
693
694
695


696
697
698
699
700
701
702
703

704
705
706
707
708
709
710
711







-
-
+
+
+





-
+







    chan puts "[incr lineNumber]: $line"
}
chan close $chan
.CE
.PP
In this example illustrating event driven reads,
\fBGetData\fR will be called with the channel as an
argument whenever $chan becomes readable. The \fBread\fR call will
read whatever binary data is currently available without blocking.
argument whenever $chan becomes readable. The \fBread\fR call
reads whatever characters are currently available without blocking. Each
individual byte is interpreted as the corresponding Unicode character.
Here the channel has the fileevent removed when an end of file
occurs to avoid being continually called (see above). Alternatively
the channel may be closed on this condition.
.PP
.CS
proc GetData {chan} {
proc GetData chan {
    set data [chan read $chan]
    chan puts "[string length $data] $data"
    if {[chan eof $chan]} {
        chan event $chan readable {}
    }
}

909
910
911
912
913
914
915
916

917
918
919
920
921
922
923
731
732
733
734
735
736
737

738
739
740
741
742
743
744
745







-
+







.CE
.PP
A network server that echoes its input line-by-line without
preventing servicing of other connections at the same time:
.PP
.CS
# This is a very simple logger...
proc log {message} {
proc log message {
    \fBchan puts\fR stdout $message
}

# This is called whenever a new client connects to the server
proc connect {chan host port} {
    set clientName [format <%s:%d> $host $port]
    log "connection from $clientName"
967
968
969
970
971
972
973
974
975


976
977
978
979
980
981
982
789
790
791
792
793
794
795


796
797
798
799
800
801
802
803
804







-
-
+
+







    lappend words {*}[join [scan $line %d%d%d]]
}

# Those words supply the size of the image and its
# overall depth per channel. Assign to variables.
lassign $words xSize ySize depth

# Now switch to binary mode to pull in the data,
# one byte per channel (red,green,blue) per pixel.
# Now switch to binary mode to read each byte as a character, where each
# character corresponds to one pixel (red,green, or blue).
\fBchan configure\fR $f -translation binary
set numDataBytes [expr {3 * $xSize * $ySize}]
set data [chan read $f $numDataBytes]

close $f
.CE
.SS "FILE SEEK EXAMPLES"
992
993
994
995
996
997
998
999
1000



1001
1002
1003
1004
1005
1006
1007
814
815
816
817
818
819
820


821
822
823
824
825
826
827
828
829
830







-
-
+
+
+







# $data1 eq $data2 if the file wasn't updated
.CE
.PP
Read the last 10 bytes from a file:
.PP
.CS
set f [open file.data]
# This is guaranteed to work with binary data but
# may fail with other encodings...
# -translation binary guarantees no decoding errors since each possible value
# of a byte corresponds to a character.  Most other encodings could report a
# decoding error.
chan configure $f -translation binary
\fBchan seek\fR $f -10 end
set data [chan read $f 10]
chan close $f
.CE
.PP
Read a line from a file channel only if it starts with \fBfoobar\fR:
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
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







-
-
-
-
-
+
+
+
+
+




-
+









-
+






-
+






-
+



-
+





-
+










-
+







during channel input. First, creation of a test file containing
the invalid UTF-8 sequence (\fBA \\xC3 B\fR):
.PP
.CS
% set f [open test_A_195_B.txt wb]; chan puts -nonewline $f A\\xC3B; chan close $f
.CE
.PP
An attempt to read the file will result in an encoding error which is
then introspected by switching the channel to binary mode. Note in the
example that when the error is reported the file position remains
unchanged so that the \fBchan gets\fR during recovery returns the
full line.
An attempt to read the file results in an encoding error which is
then introspected by switching the channel to binary mode. In the
example, when the error is reported the file position remains
unchanged so that the \fBchan gets\fR would later return the
full line if called.
.PP
.CS
% set f [open test_A_195_B.txt r]
file384b6a8
% chan configure $f -encoding utf-8
% chan configure $f -encoding utf-8 -profile strict
% catch {chan gets $f} e d
1
% set d
-code 1 -level 0
-errorstack {INNER {invokeStk1 gets file384b6a8}}
-errorcode {POSIX EILSEQ {invalid or incomplete multibyte or wide character}}
-errorinfo {...} -errorline 1
% chan tell $f
0
% chan configure $f -translation binary
% chan configure $f -translation binary -profile strict
% chan gets $f
AÃB
.CE
.PP
The following example is similar to the above but demonstrates recovery after a
blocking read. The successfully decoded data "A" is returned in the error options
dictionary key \fB\-data\fR. The file position is advanced on the encoding error
dictionary key \fB\-result read\fR. The file position is advanced on the encoding error
position 1. The data at the error position is thus recovered by the next
\fBchan read\fR command.
.PP
.CS
% set f [open test_A_195_B.txt r]
file35a65a0
% chan configure $f -encoding utf-8 -blocking 1
% chan configure $f -encoding utf-8 -profile strict -blocking 1
% catch {chan read $f} e d
1
% set d
-data A -code 1 -level 0
-result {read A} -code 1 -level 0
-errorstack {INNER {invokeStk1 read file35a65a0}}
-errorcode {POSIX EILSEQ {invalid or incomplete multibyte or wide character}}
-errorinfo {...} -errorline 1
% chan tell $f
1
% chan configure $f -translation binary
% chan configure $f -translation binary -profile strict
% chan read $f
ÃB
% chan close $f
.CE
.PP
Finally the same example, but this time with a non-blocking channel.
.PP
.CS
% set f [open test_A_195_B.txt r]
file35a65a0
% chan configure $f -encoding utf-8 -blocking 0
% chan configure $f -encoding utf-8 -profile strict -blocking 0
% chan read $f
A
% chan tell $f
1
% catch {chan read $f} e d
1
% set d
Changes to doc/class.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2007 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH class n 0.1 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::class \- class of all classes
Changes to doc/classvariable.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 2011-2015 Andreas Kupries
'\" Copyright (c) 2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH classvariable n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
classvariable \- create link from local variable to variable in class
Changes to doc/clock.n.
1
2
3

4
5
6
7
8
9
10
11
12
13
14

15
16
17
18
19
20
21
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23



+











+







'\"
'\" Generated from file './doc/clock.dt' by tcllib/doctools with format 'nroff'
'\" Copyright (c) 2004 Kevin B. Kenny <kennykb@acm.org>. All rights reserved.
'\" Copyright (c) 2024 Nathan Coulter.
'\"
.TH "clock" n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.SH NAME
clock \- Obtain and manipulate dates and times
.SH "SYNOPSIS"
.nf
package require \fBTcl 8.5-\fR

\fBclock add\fI timeVal\fR ?\fIcount unit...\fR? ?\fI\-option value\fR?
\fBclock classic\fR \fI...\fR
\fBclock clicks\fR ?\fI\-option\fR?
\fBclock format\fI timeVal\fR ?\fI\-option value\fR...?
\fBclock microseconds\fR
\fBclock milliseconds\fR
\fBclock scan\fI inputString\fR ?\fI\-option value\fR...?
\fBclock seconds\fR
.fi
29
30
31
32
33
34
35




36
37
38
39
40
41
42
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48







+
+
+
+







.TP
\fBclock add\fI timeVal\fR ?\fIcount unit...\fR? ?\fI\-option value\fR?
.
Adds a (possibly negative) offset to a time that is expressed as an
integer number of seconds.  See \fBCLOCK ARITHMETIC\fR for a full description.
.\" METHOD: clicks
.TP
\fBclock classic\fR \fI...\fR
.
See the documentation for clock in Tcl version 8.6.
.TP
\fBclock clicks\fR ?\fI\-option\fR?
.
If no \fI\-option\fR argument is supplied, returns a high-resolution
time value as a system-dependent integer value.  The unit of the value
is system-dependent but should be the highest resolution clock available
on the system such as a CPU cycle counter.
See \fBHIGH RESOLUTION TIMERS\fR for a full description.
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
103
104
105
106
107
108
109









110
111
112
113
114
115
116







-
-
-
-
-
-
-
-
-







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
\fInow\fR
Instead of \fItimeVal\fR a non-integer value \fBnow\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"
128
129
130
131
132
133
134
135

136
137
138
139
140
141
142
125
126
127
128
129
130
131

132
133
134
135
136
137
138
139







-
+







.TP
\fB\-format\fR format
.
Specifies the desired output format for \fBclock format\fR or the
expected input format for \fBclock scan\fR.  The \fIformat\fR string consists
of any number of characters other than the per-cent sign
.PQ \fB%\fR
interspersed with any number of \fIformat groups\fR, which are two- or three-character
interspersed with any number of \fIformat groups\fR, which are two-character
sequences beginning with the per-cent sign.  The permissible format groups,
and their interpretation, are described under \fBFORMAT GROUPS\fR.
.RS
.PP
On \fBclock format\fR, the default format is
.PP
.CS
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
187
188
189
190
191
192
193









194
195
196
197
198
199
200







-
-
-
-
-
-
-
-
-







.IP [1]
the environment variable \fBTCL_TZ\fR.
.IP [2]
the environment variable \fBTZ\fR.
.IP [3]
on Windows systems, the time zone settings from the Control Panel.
.RE
.\" OPTION: -validate
.TP
\fB\-validate\fR boolean
.
If \fIboolean\fR is true (default), \fBclock scan\fR will raise an error
if the input contains invalid values, e.g. day of month greater than
number of days in the month. If specified as false, the command makes
an adjustment to bring values within acceptable range. See
\fBSCANNING TIMES\fR for details.
.PP
If none of these is present, the C \fBlocaltime\fR and \fBmktime\fR
functions are used to attempt to convert times between local and
Greenwich.  On 32-bit systems, this approach is likely to have bugs,
particularly for times that lie outside the window (approximately the
years 1902 to 2037) that can be represented in a 32-bit integer.
.SH "CLOCK ARITHMETIC"
427
428
429
430
431
432
433
434

435
436

437
438
439
440
441
442
443
444
445
446
415
416
417
418
419
420
421

422


423



424
425
426
427
428
429
430







-
+
-
-
+
-
-
-







.PP
The date is determined according to the fields that are present in the
preprocessed format string.  In order of preference:
.IP [1]
If the string contains a \fB%s\fR format group, representing
seconds from the epoch, that group is used to determine the date.
.IP [2]
If the string contains a \fB%J\fR, \fB%EJ\fR or \fB%Ej\fR format groups,
If the string contains a \fB%J\fR format group, representing
representing the Calendar or Astronomical Julian Day Number, that groups
are used to determine the date.
the Julian Day Number, that group is used to determine the date.
Note, that in case of \fB%EJ\fR or \fB%Ej\fR format groups, representing
the Julian Date with time fraction, this groups may be used to determine
the date and time.
.IP [3]
If the string contains a complete set of format groups specifying
century, year, month, and day of month; century, year, and day of year;
or ISO8601 fiscal year, week of year, and day of week; those groups are
combined and used to determine the date.  If more than one complete
set is present, the one at the rightmost position in the string is
used.
497
498
499
500
501
502
503
504
505
506

507
508
509
510
511
512
513
481
482
483
484
485
486
487



488
489
490
491
492
493
494
495







-
-
-
+







in the same day, once without and once with Daylight Saving Time.
If this situation occurs, the first occurrence of the time is chosen.
(For this reason, it is wise to have the input string contain the
time zone when converting local times.  This caveat does not apply to
UTC times.)
.PP
If the interpretation of the groups yields an impossible time because
a field is out of range, an exception is raised if the \fB-validate\fR
option is not present or passed as true. If passed as false,
enough of that field's unit will be added to
a field is out of range, enough of that field's unit will be added to
or subtracted from the time to bring it in range. Thus, if attempting to
scan or format day 0 of the month, one day will be subtracted from day
1 of the month, yielding the last day of the previous month.
.PP
If the interpretation of the groups yields an impossible time because
a Daylight Saving Time change skips over that time, or an ambiguous
time because a Daylight Saving Time change skips back so that the clock
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
554
555
556
557
558
559
560



























561
562
563
564
565
566
567







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







On output, produces the string \fBB.C.E.\fR or \fBC.E.\fR, or a
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.
.IP \fB%Ej\fR
On output, produces a string of digits giving the Astronomical Julian Date or
Astronomical Julian Day Number (JDN/JD). In opposite to calendar julian day
\fB%J\fR, it starts the day at noon.
On input, accepts a string of digits (or floating point with the time fraction)
and interprets it as an Astronomical Julian Day Number (JDN/JD).
The Astronomical Julian Date is a count of the number of calendar days
that have elapsed since 1 January, 4713 BCE of the proleptic
Julian calendar, which contains also the time fraktion (after floating point).
The epoch time of 1 January 1970 corresponds to Astronomical JDN 2440587.5.
This value corresponds the julian day used in sqlite-database, and is the same
as result of \fBselect julianday(:seconds, 'unixepoch')\fR.
.IP \fB%EJ\fR
On output, produces a string of digits giving the Calendar Julian Date.
In opposite to julian day \fB%J\fR format group, it produces float number.
In opposite to astronomical julian day \fB%Ej\fR group, it starts at midnight.
On input, accepts a string of digits (or floating point with the time fraction)
and interprets it as a Calendar Julian Day Number.
The Calendar Julian Date is a count of the number of calendar days
that have elapsed since 1 January, 4713 BCE of the proleptic
Julian calendar, which contains also the time fraktion (after floating point).
The epoch time of 1 January 1970 corresponds to Astronomical JDN 2440588.
.IP \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.
.IP \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.
.IP \fB%EX\fR
On output, produces a locale-dependent representation of the
638
639
640
641
642
643
644
645

646
647
648
649
650
651
652
593
594
595
596
597
598
599

600
601
602
603
604
605
606
607







-
+







.IP \fB%I\fR
On output, produces a two-digit number giving the hour of the day
(12-11) on a 12-hour clock.  On input, accepts such a number.
.IP \fB%j\fR
On output, produces a three-digit number giving the day of the year
(001-366).  On input, accepts such a number.
.IP \fB%J\fR
On output, produces a string of digits giving the calendar Julian Day Number.
On output, produces a string of digits giving the Julian Day Number.
On input, accepts a string of digits and interprets it as a Julian Day Number.
The Julian Day Number is a count of the number of calendar days
that have elapsed since 1 January, 4713 BCE of the proleptic
Julian calendar.  The epoch time of 1 January 1970 corresponds
to Julian Day Number 2440588.
.IP \fB%k\fR
On output, produces a one- or two-digit number giving the hour of the day
759
760
761
762
763
764
765
766

767
768
769
770
771
772
773

774
775
776
777
778
779
780
714
715
716
717
718
719
720

721

722
723
724
725


726
727
728
729
730
731
732
733







-
+
-




-
-
+







accepts four digits and may be used to determine calendar date. Note
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.
.IP \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,
determine the time zone.
so the value is not mandatory and can be missing in input).
.IP \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
time zone. 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.
.IP \fB%%\fR
On output, produces a literal
.QW \fB%\fR
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
924
925
926
927
928
929
930


















931
932
933
934
935
936
937
938
939







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









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 \(co 2004 Kevin B. Kenny <kennykb@acm.org>. All rights reserved.
'\" Local Variables:
'\" mode: nroff
'\" End:
Changes to doc/close.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH close n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
close \- Close an open channel
Changes to doc/concat.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH concat n 8.3 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
concat \- Join lists together
Changes to doc/configurable.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2019 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH configurable n 0.4 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::configurable, configure, property \- class that makes configurable classes and objects, and supports making configurable properties
Changes to doc/continue.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH continue n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
continue \- Skip to the next iteration of a loop
Changes to doc/cookiejar.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2014-2018 Donal K. Fellows.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH "cookiejar" n 0.1 http "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
cookiejar \- Implementation of the Tcl http package cookie jar protocol
Changes to doc/copy.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2007 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH copy n 0.1 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::copy \- create copies of objects and classes
Changes to doc/coroutine.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 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.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH coroutine n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
coroutine, yield, yieldto, coroinject, coroprobe \- Create and produce values from coroutines
Changes to doc/dde.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1997 Sun Microsystems, Inc.
'\" Copyright (c) 2001 ActiveState Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH dde n 1.4 dde "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
dde \- Execute a Dynamic Data Exchange command
Changes to doc/define.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2007-2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH define n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::define, oo::objdefine, oo::Slot \- define and configure classes and objects
Changes to doc/dict.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2003 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH dict n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
dict \- Manipulate dictionaries
Changes to doc/encoding.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
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
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


+



+
+
+
+
+
+





-
+

-
+



-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
-
-
+
+
+
-
-
+
+
+
+
+
+
+


-
+
-



-

-
+
-

-
-
-
+
+
-

-
-
+
+
-
-
+
-
-
-
+
-
-
-
-
+
+
+





-
+

-
+
-
-
-
+
-

-
-
+
+





-
-
-
-
-
-
+
+
+
+
-
-
-
+




-
+
-









-
+
+





-
-
-
+
+
+




-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+
-
-
+


-
+
-
-
+
+
-
-
+


-
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+


-
-
-
-
-
+
-
-
-
-
+
+
+
-
-
-
-
-
+
+
+
+
+



-
-
+
+







-
+


-
+



-
+







'\"
'\" Copyright (c) 1998 Scriptics Corporation.
'\" Copyright (c) 2023 Nathan Coulter
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH encoding n "8.1" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.SH NAME
encoding \- Manipulate encodings
encoding \- Work with encodings
.SH SYNOPSIS
\fBencoding \fIoption\fR ?\fIarg arg ...\fR?
\fBencoding \fIoperation\fR ?\fIarg arg ...\fR?
.BE
.SH INTRODUCTION
.PP
Strings in Tcl are logically a sequence of Unicode characters.
These strings are represented in memory as a sequence of bytes that
may be in one of several encodings: modified UTF\-8 (which uses 1 to 4
bytes per character), or a custom encoding start as 8 bit binary data.
In Tcl every string is composed of Unicode values.  Text may be encoded into an
encoding such as cp1252, iso8859-1, Shitf\-JIS, utf-8, utf-16, etc. Not every
Unicode value is encodable in every encoding, and some encodings can encode
values that are not available in Unicode.
.PP
Even though Unicode is for encoding the written texts of human languages, any
sequence of bytes can be encoded as the first 255 Unicode values. In particular,
iso8859-1 is an encoding (a superset of classic ASCII) for a subset of Unicode
in which each byte is a Unicode value of 255
or less; any sequence of bytes can be considered to be a Unicode string
encoded in iso8859-1.  To work with binary data in Tcl, decode it from
iso8859-1 when reading it in, and encode it into iso8859-1 when writing it out,
ensuring that each character in the string has a value of 255 or less.
Decoding such a string does nothing, and encoding encoding such a string also
does nothing.
.PP
For example, the following is true:
.CS
Different operating system interfaces or applications may generate
strings in other encodings such as Shift\-JIS.  The \fBencoding\fR

set text {In Tcl binary data is treated as Unicode text and it just works.}
set encoded [\fBencoding convertto\fR iso8859-1 $text]
command helps to bridge the gap between Unicode and these other
formats.
expr {$text eq $encoded}; #-> 1
.CE
The following is also true:
.CS
set decoded [\fBencoding convertfrom\fR iso8859-1 $text]
expr {$text eq $decoded}; #-> 1
.CE
.SH DESCRIPTION
.PP
Performs one of several encoding related operations, depending on
Performs one of the following encoding \fIoperations\fR:
\fIoption\fR.  The legal \fIoption\fRs are:
.\" METHOD: convertfrom
.TP
\fBencoding convertfrom\fR ?\fIencoding\fR? \fIdata\fR
.VS "TCL8.7 TIP607, TIP656"
.TP
\fBencoding convertfrom\fR ?\fB-profile \fIprofile\fR? ?\fB-failindex var\fR? \fIencoding data\fR
\fBencoding convertfrom\fR ?\fB\-profile \fIprofile\fR? ?\fB\-failindex var\fR? \fIencoding data\fR
.VE "TCL8.7 TIP607, TIP656"
.
Converts \fIdata\fR, which should be in binary string encoded as per
\fIencoding\fR, to a Tcl string. If \fIencoding\fR is not specified, the current
system encoding is used.
Decodes \fIdata\fR encoded in \fIencoding\fR. If \fIencoding\fR is not
specified the current system encoding is used.
.PP
.VS "TCL8.7 TIP607, TIP656"
The \fB-profile\fR option determines the command behavior in the presence
of conversion errors. See the \fBPROFILES\fR section below for details. Any premature
\fB\-profile\fR determines how invalid data for the encoding are handled.  See
the \fBPROFILES\fR section below for details.  Returns an error if decoding
termination of processing due to errors is reported through an exception if
the \fB-failindex\fR option is not specified.
fails.  However, if \fB\-failindex\fR given, returns the result of the
.PP
If the \fB-failindex\fR is specified, instead of an exception being raised
on premature termination, the result of the conversion up to the point of the
conversion up to the point of termination, and stores in \fBvar\fR the index of
error is returned as the result of the command. In addition, the index
of the source byte triggering the error is stored in \fBvar\fR. If no
errors are encountered, the entire result of the conversion is returned and
the value \fB-1\fR is stored in \fBvar\fR.
the character that could not be converted. If no errors are encountered the
entire result of the conversion is returned and the value \fB-1\fR is stored in
\fBvar\fR.
.VE "TCL8.7 TIP607, TIP656"
.\" METHOD: convertto
.TP
\fBencoding convertto\fR ?\fIencoding\fR? \fIdata\fR
.TP
\fBencoding convertto\fR ?\fB-profile \fIprofile\fR? ?\fB-failindex var\fR? \fIencoding data\fR
\fBencoding convertto\fR ?\fB\-profile \fIprofile\fR? ?\fB\-failindex var\fR? \fIencoding data\fR
.
Convert \fIstring\fR to the specified \fIencoding\fR. The result is a Tcl binary
Converts \fIstring\fR to \fIencoding\fR.  If \fIencoding\fR is not given, the
string that contains the sequence of bytes representing the converted string in
the specified encoding. If \fIencoding\fR is not specified, the current system
encoding is used.
current system encoding is used.
.PP
.VS "TCL8.7 TIP607, TIP656"
The \fB-profile\fR and \fB-failindex\fR options have the same effect as
described for the \fBencoding convertfrom\fR command.
See \fBencoding convertfrom\fR for the meaning of \fB\-profile\fR and
\fB\-failindex\fR.
.VE "TCL8.7 TIP607, TIP656"
.\" METHOD: dirs
.TP
\fBencoding dirs\fR ?\fIdirectoryList\fR?
.
Tcl can load encoding data files from the file system that describe
additional encodings for it to work with. This command sets the search
path for \fB*.enc\fR encoding data files to the list of directories
\fIdirectoryList\fR. If \fIdirectoryList\fR is omitted then the
command returns the current list of directories that make up the
search path. It is an error for \fIdirectoryList\fR to not be a valid
Sets the search path for \fB*.enc\fR encoding data files to the list of
directories given by \fIdirectoryList\fR.  If \fIdirectoryList\fR is not given,
returns the current list of directories that make up the search path.  It is
not an error for an item in \fIdirectoryList\fR to not refer to a readable,
list. If, when a search for an encoding data file is happening, an
element in \fIdirectoryList\fR does not refer to a readable,
searchable directory, that element is ignored.
searchable directory.
.\" METHOD: names
.TP
\fBencoding names\fR
.
Returns a list containing the names of all of the encodings that are
Returns a list of the names of available encodings.
currently available.
The encodings
.QW utf-8
and
.QW iso8859-1
are guaranteed to be present in the list.
.\" METHOD: profiles
.TP
\fBencoding profiles\fR
.VS "TCL8.7 TIP656"
Returns a list of the names of encoding profiles. See \fBPROFILES\fR below.
Returns a list of names of available encoding profiles. See \fBPROFILES\fR
below.
.VE "TCL8.7 TIP656"
.\" METHOD: system
.TP
\fBencoding system\fR ?\fIencoding\fR?
.
Set the system encoding to \fIencoding\fR. If \fIencoding\fR is
omitted then the command returns the current system encoding.  The
system encoding is used whenever Tcl passes strings to system calls.
Sets the system encoding to \fIencoding\fR. If \fIencoding\fR is not given,
returns the current system encoding.  The system encoding is used to pass
strings to system calls.
.\" Do not put .VS on whole section as that messes up the bullet list alignment
.SH PROFILES
.PP
.VS "TCL8.7 TIP656"
Operations involving encoding transforms may encounter several types of
errors such as invalid sequences in the source data, characters that
cannot be encoded in the target encoding and so on.
A \fIprofile\fR prescribes the strategy for dealing with such errors
in one of two ways:
Each \fIprofile\fR is a distinct strategy for dealing with invalid data for an
encoding.
.VE "TCL8.7 TIP656"
.
.IP \(bu
.VS "TCL8.7 TIP656"
Terminating further processing of the source data. The profile does not
determine how this premature termination is conveyed to the caller. By default,
this is signalled by raising an exception. If the \fB-failindex\fR option
is specified, errors are reported through that mechanism.
.VE "TCL8.7 TIP656"
.IP \(bu
.VS "TCL8.7 TIP656"
Continue further processing of the source data using a fallback strategy such
as replacing or discarding the offending bytes in a profile-defined manner.
.VE "TCL8.7 TIP656"
.PP
The following profiles are currently implemented with \fBstrict\fR being
The following profiles are currently implemented.
the default if the \fB-profile\fR is not specified.
.VS "TCL8.7 TIP656"
.VE "TCL8.7 TIP656"
.TP
\fBstrict\fR
.
.VS "TCL8.7 TIP656"
The \fBstrict\fR profile always stops processing when an conversion error is
encountered. The error is signalled via an exception or the \fB-failindex\fR
The default profile.  The operation fails when invalid data for the encoding
are encountered.
option mechanism. The \fBstrict\fR profile implements a Unicode standard
conformant behavior.
.VE "TCL8.7 TIP656"
.TP
\fBtcl8\fR
.
.VS "TCL8.7 TIP656"
The \fBtcl8\fR profile always follows the first strategy above and corresponds
to the behavior of encoding transforms in Tcl 8.6. When converting from an
external encoding \fBother than utf-8\fR to Tcl strings with the \fBencoding
Provides for behaviour identical to that of Tcl 8.6: When
decoding, for encodings \fBother than utf-8\fR, each invalid byte is interpreted
convertfrom\fR command, invalid bytes are mapped to their numerically equivalent
code points. For example, the byte 0x80 which is invalid in ASCII would be
mapped to code point U+0080. When converting from \fButf-8\fR, invalid bytes
that are defined in CP1252 are mapped to their Unicode equivalents while those
that are not fall back to the numerical equivalents. For example, byte 0x80 is
defined by CP1252 and is therefore mapped to its Unicode equivalent U+20AC while
byte 0x81 which is not defined by CP1252 is mapped to U+0081. As an additional
special case, the sequence 0xC0 0x80 is mapped to U+0000.

as the Unicode value given by that one byte. For example, the byte 0x80, which
is invalid in the ASCII encoding would be mapped to the Unicode value U+0080.
For \fButf-8\fR, each invalid byte that is a valid CP1252 character is
interpreted as the Unicode value for that character, while each byte that is
not is treated as the Unicode value given by that one byte. For example, byte
0x80 is defined by CP1252 and is therefore mapped to its Unicode equivalent
U+20AC while byte 0x81 which is not defined by CP1252 is mapped to U+0081. As
an additional special case, the sequence 0xC0 0x80 is mapped to U+0000.
.RS
When converting from Tcl strings to an external encoding format using
\fBencoding convertto\fR, characters that cannot be represented in the
target encoding are replaced by an encoding-dependent character, usually
the question mark \fB?\fR.
.PP
When encoding, each character that cannot be represented in the encoding is
replaced by an encoding-dependent character, usually the question mark \fB?\fR.
.RE
.VE "TCL8.7 TIP656"
.TP
\fBreplace\fR
.
Like the \fBtcl8\fR profile, the \fBreplace\fR profile always continues
processing on conversion errors but follows a Unicode standard conformant
method for substitution of invalid source data.

.VS "TCL8.7 TIP 656"
When converting an encoded byte sequence to a Tcl string using
\fBencoding convertfrom\fR, invalid bytes
are replaced by the U+FFFD REPLACEMENT CHARACTER code point.

When decoding, invalid bytes are replaced by U+FFFD, the Unicode REPLACEMENT
CHARACTER.
.RS
When encoding a Tcl string with \fBencoding convertto\fR,
code points that cannot be represented in the
target encoding are transformed to an encoding-specific fallback character,
U+FFFD REPLACEMENT CHARACTER for UTF targets and generally `?` for other
encodings.
.PP
When encoding, Unicode values that cannot be represented in the target encoding
are transformed to an encoding-specific fallback character, U+FFFD REPLACEMENT
CHARACTER for UTF targets, and generally `?` for other encodings.
.RE
.VE "TCL8.7 TIP656"
.SH EXAMPLES
.PP
These examples use the utility proc below that prints the Unicode code points
comprising a Tcl string.
These examples use the utility proc below that prints the Unicode value for
each character in a string.
.PP
.CS
proc codepoints s {join [lmap c [split $s {}] {
    string cat U+ [format %.6X [scan $c %c]]}]
}
.CE
.PP
Example 1: convert a byte sequence in Japanese euc-jp encoding to a TCL string:
Example 1: Convert from euc-jp:
.PP
.CS
% codepoints [\fBencoding convertfrom\fR euc-jp "\exA4\exCF"]
% codepoints [\fBencoding convertfrom\fR euc-jp \exA4\exCF]
U+00306F
.CE
.PP
The result is the unicode codepoint
The result is the Unicode value
.QW "\eu306F" ,
which is the Hiragana letter HA.
.VS "TCL8.7 TIP607, TIP656"
.PP
Example 2: Error handling based on profiles:
.PP
The letter \fBA\fR is Unicode character U+0041 and the byte "\ex80" is invalid
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
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







-
+












-
+













% codepoints [\fBencoding convertfrom\fR -profile strict ascii A\ex80]
unexpected byte sequence starting at index 1: '\ex80'
.CE
.PP
Example 3: Get partial data and the error location:
.PP
.CS
% codepoints [\fBencoding convertfrom\fR -profile strict -failindex idx ascii AB\ex80]
% codepoints [\fBencoding convertfrom\fR -failindex idx ascii AB\ex80]
U+000041 U+000042
% set idx
2
.CE
.PP
Example 4: Encode a character that is not representable in ISO8859-1:
.PP
.CS
% \fBencoding convertto\fR iso8859-1 A\eu0141
A?
% \fBencoding convertto\fR -profile strict iso8859-1 A\eu0141
unexpected character at index 1: 'U+000141'
% \fBencoding convertto\fR -profile strict -failindex idx iso8859-1 A\eu0141
% \fBencoding convertto\fR -failindex idx iso8859-1 A\eu0141
A
% set idx
1
.CE
.VE "TCL8.7 TIP607, TIP656"
.PP
.SH "SEE ALSO"
Tcl_GetEncoding(3), fconfigure(n)
.SH KEYWORDS
encoding, unicode
.\" Local Variables:
.\" mode: nroff
.\" End:
Changes to doc/eof.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH eof n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
eof \- Check for end of file condition on channel
Changes to doc/error.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH error n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
error \- Generate an error
Changes to doc/eval.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH eval n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
eval \- Evaluate a Tcl script
Changes to doc/exec.n.
1
2
3
4
5
6
7






8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20







+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2006 Donal K. Fellows.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH exec n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
exec \- Invoke subprocesses
Changes to doc/exit.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH exit n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
exit \- End the application
Changes to doc/expr.n.
1
2
3
4
5
6
7






8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20







+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-2000 Sun Microsystems, Inc.
'\" Copyright (c) 2005 Kevin B. Kenny <kennykb@acm.org>. All rights reserved
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH expr n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
expr \- Evaluate an expression
Changes to doc/fblocked.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH fblocked n 7.5 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
fblocked \- Test whether the last input operation exhausted all available input
.SH SYNOPSIS
Changes to doc/fconfigure.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH fconfigure n 8.3 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
fconfigure \- Set and get options on a channel
Changes to doc/fcopy.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH fcopy n 8.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
fcopy \- Copy data from one channel to another
Changes to doc/file.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH file n 8.3 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
file \- Manipulate file names and attributes
Changes to doc/fileevent.n.
1
2
3
4
5
6
7






8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20







+
+
+
+
+
+







'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2008 Pat Thoyts
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH fileevent n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
fileevent \- Execute a script when a channel becomes readable or writable
Changes to doc/filename.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH filename n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
filename \- File name conventions supported by Tcl commands
Changes to doc/flush.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH flush n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
flush \- Flush buffered output for a channel
Changes to doc/for.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH for n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
for \- 'For' loop
Changes to doc/foreach.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH foreach n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
foreach \- Iterate over all elements in one or more lists
Changes to doc/format.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH format n 8.1 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
format \- Format a string in the style of sprintf
Changes to doc/fpclassify.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 2018 Kevin B. Kenny <kennykb@acm.org>. All rights reserved
'\" Copyright (c) 2019 Donal Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH fpclassify n 8.7 Tcl "Tcl Float Classifier"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
fpclassify \- Floating point number classification of Tcl values
Changes to doc/gets.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH gets n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
gets \- Read a line from a channel
Changes to doc/glob.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
.TH glob n 8.3 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
glob \- Return names of files that match patterns
.SH SYNOPSIS
Changes to doc/global.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH global n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
global \- Access global variables
Changes to doc/history.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH history n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
history \- Manipulate the history list
Changes to doc/http.n.
1
2
3
4
5
6
7






8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20







+
+
+
+
+
+







'\"
'\" Copyright (c) 1995-1997 Sun Microsystems, Inc.
'\" Copyright (c) 1998-2000 Ajuba Solutions.
'\" Copyright (c) 2004 ActiveState Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH "http" n 2.10 http "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
http \- Client-side implementation of the HTTP/1.1 protocol
Changes to doc/idna.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2014-2018 Donal K. Fellows.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH "idna" n 0.1 http "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tcl::idna \- Support for normalization of Internationalized Domain Names
Changes to doc/if.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH if n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
if \- Execute scripts conditionally
Changes to doc/incr.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH incr n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
incr \- Increment the value of a variable
Changes to doc/info.n.
1
2
3
4
5
6
7
8
9






10
11
12
13
14
15
16
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22









+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\" Copyright (c) 1993-1997 Bell Labs Innovations for Lucent Technologies
'\" Copyright (c) 1998-2000 Ajuba Solutions
'\" Copyright (c) 2007-2012 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH info n 8.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
info \- Information about the state of the Tcl interpreter
Changes to doc/interp.n.
1
2
3
4
5
6
7






8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20







+
+
+
+
+
+







'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2004 Donal K. Fellows
'\" Copyright (c) 2006-2008 Joe Mistachkin.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH interp n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
interp \- Create and manipulate Tcl interpreters
Changes to doc/join.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH join n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
join \- Create a string by joining together list elements
Changes to doc/lappend.n.
1
2
3
4
5
6
7






8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20







+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH lappend n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lappend \- Append list elements onto a variable
Changes to doc/lassign.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1992-1999 Karl Lehenbauer & Mark Diekhans
'\" Copyright (c) 2004 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH lassign n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lassign \- Assign list elements to variables
Changes to doc/ledit.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2022 Ashok P. Nadkarni <apnmbx-public@yahoo.com>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH ledit n 8.7 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
ledit \- Replace elements of a list stored in variable
Changes to doc/library.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1991-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH library n "8.0" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.SH NAME
auto_execok, auto_import, auto_load, auto_mkindex, auto_qualify, auto_reset, foreachLine, parray, readFile, tcl_findLibrary, tcl_endOfWord, tcl_startOfNextWord, tcl_startOfPreviousWord, tcl_wordBreakAfter, tcl_wordBreakBefore, writeFile \- standard library of Tcl procedures
.SH SYNOPSIS
Changes to doc/lindex.n.
1
2
3
4
5
6
7






8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20







+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH lindex n 8.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lindex \- Retrieve an element from a list
Changes to doc/link.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 2011-2015 Andreas Kupries
'\" Copyright (c) 2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH link n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
link \- create link from command to method of object
Changes to doc/linsert.n.
1
2
3
4
5
6
7






8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20







+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH linsert n 8.2 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
linsert \- Insert elements into a list
Changes to doc/list.n.
1
2
3
4
5
6
7






8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20







+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH list n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
list \- Create a list
Changes to doc/llength.n.
1
2
3
4
5
6
7






8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20







+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH llength n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
llength \- Count the number of elements in a list
Changes to doc/lmap.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2012 Trevor Davel
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH lmap n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lmap \- Iterate over all elements in one or more lists and collect results
Changes to doc/load.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH load n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
load \- Load machine code and initialize new commands
Changes to doc/lpop.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2018 Peter Spjuth.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH lpop n 8.7 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lpop \- Get and remove an element in a list
Changes to doc/lrange.n.
1
2
3
4
5
6
7






8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20







+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH lrange n 7.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lrange \- Return one or more adjacent elements from a list
Changes to doc/lremove.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2019 Donal K. Fellows.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH lremove n 8.7 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lremove \- Remove elements from a list by index
Changes to doc/lrepeat.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2003 Simon Geard.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH lrepeat n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lrepeat \- Build a list by repeating elements
Changes to doc/lreplace.n.
1
2
3
4
5
6
7






8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20







+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH lreplace n 7.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lreplace \- Replace elements in a list with new elements
Changes to doc/lreverse.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2006 Donal K. Fellows.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH lreverse n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lreverse \- Reverse the order of a list
Changes to doc/lsearch.n.
1
2
3
4
5
6
7
8






9
10
11
12
13
14
15
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21








+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\" Copyright (c) 2003-2004 Donal K. Fellows.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH lsearch n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lsearch \- See if a list contains a particular element
Changes to doc/lseq.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2022 Eric Taylor.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH lseq n 8.7 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lseq \- Build a numeric sequence returned as a list
Changes to doc/lset.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH lset n 8.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lset \- Change an element in a list
Changes to doc/lsort.n.
1
2
3
4
5
6
7
8






9
10
11
12
13
14
15
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21








+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 1999 Scriptics Corporation
'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH lsort n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lsort \- Sort the elements of a list
Changes to doc/mathfunc.n.
1
2
3
4
5
6
7






8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20







+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-2000 Sun Microsystems, Inc.
'\" Copyright (c) 2005 Kevin B. Kenny <kennykb@acm.org>. All rights reserved
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH mathfunc n 8.5 Tcl "Tcl Mathematical Functions"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
mathfunc \- Mathematical functions for Tcl expressions
Changes to doc/msgcat.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 1998 Mark Harrison.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH "msgcat" n 1.5 msgcat "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
msgcat \- Tcl message catalog
Changes to doc/my.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2007 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH my n 0.1 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
my, myclass \- invoke any method of current object or its class
Changes to doc/namespace.n.
1
2
3
4
5
6
7
8






9
10
11
12
13
14
15
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21








+
+
+
+
+
+







'\"
'\" Copyright (c) 1993-1997 Bell Labs Innovations for Lucent Technologies
'\" Copyright (c) 1997 Sun Microsystems, Inc.
'\" Copyright (c) 2000 Scriptics Corporation.
'\" Copyright (c) 2004-2005 Donal K. Fellows.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH namespace n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
namespace \- create and manipulate contexts for commands and variables
Changes to doc/next.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2007 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH next n 0.1 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
next, nextto \- invoke superclass method implementations
Changes to doc/object.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2007-2008 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH object n 0.1 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::object \- root class of the class hierarchy
Changes to doc/open.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH open n 8.3 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
open \- Open a file-based or command pipeline channel
Changes to doc/package.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH package n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
package \- Facilities for package loading and version control
Changes to doc/pid.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH pid n 7.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
pid \- Retrieve process identifiers
Changes to doc/pkgMkIndex.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH pkg_mkIndex n 8.3 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
pkg_mkIndex \- Build an index for automatic loading of packages
Changes to doc/platform.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2006 ActiveState Software Inc
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH "platform" n 1.0.4 platform "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
platform \- System identification support code and utilities
Changes to doc/platform_shell.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2006-2008 ActiveState Software Inc
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH "platform::shell" n 1.1.4 platform::shell "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
platform::shell \- System identification support code and utilities
Changes to doc/prefix.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2008 Peter Spjuth <pspjuth@users.sourceforge.net>
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH prefix n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tcl::prefix \- facilities for prefix matching
Changes to doc/proc.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH proc n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
proc \- Create a Tcl procedure
Changes to doc/process.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2017 Frederic Bonnet.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH process n 8.7 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tcl::process \- Subprocess management
Changes to doc/puts.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH puts n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
puts \- Write to a channel
Changes to doc/pwd.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH pwd n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
pwd \- Return the absolute path of the current working directory
Changes to doc/re_syntax.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1998 Sun Microsystems, Inc.
'\" Copyright (c) 1999 Scriptics Corporation
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.so man.macros
.TH re_syntax n "8.1" Tcl "Tcl Built-In Commands"
.BS
.SH NAME
re_syntax \- Syntax of Tcl regular expressions
.BE
Changes to doc/read.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH read n 8.1 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
read \- Read from a channel
Changes to doc/refchan.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net>
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH refchan n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
refchan \- command handler API of reflected channels
Changes to doc/regexp.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 1998 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH regexp n 8.3 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
regexp \- Match a regular expression against a string
Changes to doc/registry.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1997 Sun Microsystems, Inc.
'\" Copyright (c) 2002 ActiveState Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH registry n 1.1 registry "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
registry \- Manipulate the Windows registry
Changes to doc/regsub.n.
1
2
3
4
5
6
7






8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20







+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2000 Scriptics Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH regsub n 8.3 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
regsub \- Perform substitutions based on regular expression pattern matching
Changes to doc/rename.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH rename n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
rename \- Rename or delete a command
Changes to doc/return.n.
1
2
3
4
5
6
7






8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20







+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Contributions from Don Porter, NIST, 2003.  (not subject to US copyright)
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH return n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
return \- Return from a procedure, or set return code of a script
Changes to doc/safe.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH "Safe Tcl" n 8.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
safe \- Creating and manipulating safe interpreters
Changes to doc/scan.n.
1
2
3
4
5
6
7






8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20







+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2000 Scriptics Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH scan n 8.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
scan \- Parse string using conversion specifiers in the style of sscanf
Changes to doc/seek.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH seek n 8.1 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
seek \- Change the access position for an open channel
Changes to doc/self.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2007 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH self n 0.1 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
self \- method call internal introspection
Changes to doc/set.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH set n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
set \- Read and write variables
Changes to doc/singleton.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH singleton n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::singleton \- a class that does only allows one instance of itself
Changes to doc/socket.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\" Copyright (c) 1998-1999 Scriptics Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH socket n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
socket \- Open a TCP network connection
Changes to doc/source.n.
1
2
3
4
5
6
7






8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20







+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2000 Scriptics Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH source n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
source \- Evaluate a file or resource as a Tcl script
Changes to doc/split.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH split n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
split \- Split a string into a proper Tcl list
Changes to doc/subst.n.
1
2
3
4
5
6
7






8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20







+
+
+
+
+
+







'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2001 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH subst n 7.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
subst \- Perform backslash, command, and variable substitutions
Changes to doc/switch.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH switch n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
switch \- Evaluate one of several scripts, depending on a given value
Changes to doc/tailcall.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH tailcall n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tailcall \- Replace the current procedure with another command
Changes to doc/tcltest.n.
1
2
3
4
5
6
7
8
9






10
11
12
13
14
15
16
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22









+
+
+
+
+
+







'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\" Copyright (c) 1998-1999 Scriptics Corporation
'\" Copyright (c) 2000 Ajuba Solutions
'\" Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH "tcltest" n 2.5 tcltest "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tcltest \- Test harness support code and utilities
Changes to doc/tclvars.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH tclvars n 8.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
argc, argv, argv0, auto_path, env, errorCode, errorInfo, tcl_interactive, tcl_library, tcl_nonwordchars, tcl_patchLevel, tcl_pkgPath, tcl_platform, tcl_rcFileName, tcl_traceCompile, tcl_traceExec, tcl_wordchars, tcl_version \- Variables used by Tcl
Changes to doc/tell.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH tell n 8.1 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tell \- Return current access position for an open channel
Changes to doc/throw.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2008 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH throw n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
throw \- Generate a machine-readable error
Changes to doc/time.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH time n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
time \- Time the execution of a script
Changes to doc/timerate.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" 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.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.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 \- Calibrated performance measurements of script execution time
Changes to doc/tm.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2004-2010 Andreas Kupries <andreas_kupries@users.sourceforge.net>
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH tm n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tm \- Facilities for locating and loading of Tcl Modules
Changes to doc/trace.n.
1
2
3
4
5
6
7






8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20







+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2000 Ajuba Solutions.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH trace n "8.4" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
trace \- Monitor variable accesses, command usages and command executions
Changes to doc/transchan.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2008 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH transchan n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
transchan \- command handler API of channel transforms
Changes to doc/try.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2008 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH try n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
try \- Trap and process errors and exceptions
Changes to doc/unknown.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH unknown n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
unknown \- Handle attempts to use non-existent commands
Changes to doc/unload.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2003 George Petasis <petasis@iit.demokritos.gr>.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH unload n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
unload \- Unload machine code
Changes to doc/unset.n.
1
2
3
4
5
6
7






8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20







+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2000 Ajuba Solutions.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH unset n 8.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
unset \- Delete variables
Changes to doc/update.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1990-1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH update n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
update \- Process pending events and idle callbacks
Changes to doc/uplevel.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH uplevel n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
uplevel \- Execute a script in a different stack frame
Changes to doc/upvar.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH upvar n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
upvar \- Create link to variable in a different stack frame
Changes to doc/variable.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993-1997 Bell Labs Innovations for Lucent Technologies
'\" Copyright (c) 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.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH variable n 8.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
variable \- create and initialize a namespace variable
Changes to doc/vwait.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH vwait n 8.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
vwait \- Process events until a variable is written
Changes to doc/while.n.
1
2
3
4
5
6






7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19






+
+
+
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH while n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
while \- Execute script repeatedly as long as a condition is met
Changes to doc/zipfs.n.
1
2
3
4
5
6
7






8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20







+
+
+
+
+
+







'\"
'\" Copyright (c) 2015 Jan Nijtmans <jan.nijtmans@gmail.com>
'\" Copyright (c) 2015 Christian Werner <chw@ch-werner.de>
'\" Copyright (c) 2015 Sean Woods <yoda@etoyoc.com>
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH zipfs n 1.0 Zipfs "zipfs Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
zipfs \- Mount and work with ZIP files within Tcl
Changes to doc/zlib.n.
1
2
3
4
5






6
7
8
9
10
11
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18





+
+
+
+
+
+







'\"
'\" Copyright (c) 2008-2012 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" You may distribute and/or modify this program under the terms of the GNU
'\" Affero General Public License as published by the Free Software Foundation,
'\" either version 3 of the License, or (at your option) any later version.
'\"
'\" See the file "COPYING" for information on usage and redistribution.
'\"
.TH zlib n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
zlib \- compression and decompression operations
Changes to generic/regc_color.c.
1
2
3
4
5
6
7
8
9
10
11
1



2
3
4
5
6
7
8

-
-
-







/*
 * colorings of characters
 * This file is #included by regcomp.c.
 *
 * Copyright © 1998, 1999 Henry Spencer. All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results. The author
 * thanks all of them.
 *
28
29
30
31
32
33
34















35
36
37
38
39
40
41
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 * Note that there are some incestuous relationships between this code and NFA
 * arc maintenance, which perhaps ought to be cleaned up sometime.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * colorings of characters
 * This file is #included by regcomp.c.
 *
 */

#define	CISERR()	VISERR(cm->v)
#define	CERR(e)		VERR(cm->v, (e))

/*
 - initcm - set up new colormap
 ^ static void initcm(struct vars *, struct colormap *);
 */
Changes to generic/regc_cvec.c.
1
2
3
4
5
6
7
8
9
10
11
1



2
3
4
5
6
7
8

-
-
-







/*
 * Utility functions for handling cvecs
 * This file is #included by regcomp.c.
 *
 * Copyright © 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results. The author
 * thanks all of them.
 *
24
25
26
27
28
29
30















31
32
33
34
35
36
37
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * Utility functions for handling cvecs
 * This file is #included by regcomp.c.
 *
*/

/*
 * Notes:
 * Only (selected) functions in _this_ file should treat chr* as non-constant.
 */

/*
Changes to generic/regc_lex.c.
1
2
3
4
5
6
7
8
9
10
11
1



2
3
4
5
6
7
8

-
-
-







/*
 * lexical analyzer
 * This file is #included by regcomp.c.
 *
 * Copyright © 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results.  The author
 * thanks all of them.
 *
24
25
26
27
28
29
30















31
32
33
34
35
36
37
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * lexical analyzer
 * This file is #included by regcomp.c.
 *
*/

/* scanning macros (know about v) */
#define	ATEOS()		(v->now >= v->stop)
#define	HAVE(n)		(v->stop - v->now >= (n))
#define	NEXT1(c)	(!ATEOS() && *v->now == CHR(c))
#define	NEXT2(a,b)	(HAVE(2) && *v->now == CHR(a) && *(v->now+1) == CHR(b))
#define	NEXT3(a,b,c) \
Changes to generic/regc_locale.c.
1
2
3
4
5
6
7
8
9
10
11









12
13
14
15
16
17
18
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











+
+
+
+
+
+
+
+
+







/*
 * regc_locale.c --
 *
 *	This file contains the Unicode locale specific regexp routines.
 *	This file is #included by regcomp.c.
 *
 * Copyright © 1998 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/* ASCII character-name table */

static const struct cname {
    const char *name;
    const char code;
} cnames[] = {
Changes to generic/regc_nfa.c.
27
28
29
30
31
32
33









34
35
36
37
38
39
40
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49







+
+
+
+
+
+
+
+
+







 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 * One or two things that technically ought to be in here are actually in
 * color.c, thanks to some incestuous relationships in the color chains.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

#define	NISERR()	VISERR(nfa->v)
#define	NERR(e)		VERR(nfa->v, (e))
#define STACK_TOO_DEEP(x) (0)
#define CANCEL_REQUESTED(x) (0)
#define REG_CANCEL 777

Changes to generic/regcomp.c.
25
26
27
28
29
30
31









32
33
34
35
36
37
38
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47







+
+
+
+
+
+
+
+
+







 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

#include "regguts.h"

/*
 * forward declarations, up here so forward datatypes etc. are defined early
 */
/* =====^!^===== begin forwards =====^!^===== */
Changes to generic/regcustom.h.
21
22
23
24
25
26
27









28
29
30
31
32
33
34
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43







+
+
+
+
+
+
+
+
+







 * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * Headers if any.
 */

#include "regex.h"

Changes to generic/rege_dfa.c.
25
26
27
28
29
30
31









32
33
34
35
36
37
38
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47







+
+
+
+
+
+
+
+
+







 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 - longest - longest-preferred matching engine
 ^ static chr *longest(struct vars *, struct dfa *, chr *, chr *, int *);
 */
static chr *			/* endpoint, or NULL */
longest(
Changes to generic/regerror.c.
24
25
26
27
28
29
30









31
32
33
34
35
36
37
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46







+
+
+
+
+
+
+
+
+







 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

#include "regguts.h"

/*
 * Unknown-error explanation.
 */

Changes to generic/regex.h.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
1
2
3
4
5
6


7
8
9
10
11
12
13






-
-







#ifndef _REGEX_H_
#define	_REGEX_H_	/* never again */

#include "tclInt.h"

/*
 * regular expressions
 *
 * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results. The author
 * thanks all of them.
 *
27
28
29
30
31
32
33












34
35
36
37
38
39
40
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







+
+
+
+
+
+
+
+
+
+
+
+







 * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
 * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 *
 * regular expressions
 *
 *
 * Prototypes etc. marked with "^" within comments get gathered up (and
 * possibly edited) by the regfwd program and inserted near the bottom of this
 * file.
 *
 * We offer the option of declaring one wide-character version of the RE
Changes to generic/regexec.c.
23
24
25
26
27
28
29









30
31
32
33
34
35
36
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45







+
+
+
+
+
+
+
+
+







 * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

#include "regguts.h"

/*
 * Lazy-DFA representation.
 */

Changes to generic/regfree.c.
1
2
3
4
5
6
7
8
9
10
1


2
3
4
5
6
7
8

-
-







/*
 * regfree - free an RE
 *
 * Copyright © 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results.  The author
 * thanks all of them.
 *
29
30
31
32
33
34
35














36
37
38
39
40
41
42
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *
 * You might think that this could be incorporated into regcomp.c, and that
 * would be a reasonable idea... except that this is a generic function (with
 * a generic name), applicable to all compiled REs regardless of the size of
 * their characters, whereas the stuff in regcomp.c gets compiled once per
 * character size.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * regfree - free an RE
 *
*/

#include "regguts.h"

/*
 - regfree - free an RE (generic function, punts to RE-specific function)
 *
 * Ignoring invocation with NULL is a convenience.
Changes to generic/regfronts.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
1





2
3
4
5
6
7
8

-
-
-
-
-







/*
 * regcomp and regexec - front ends to re_ routines
 *
 * Mostly for implementation of backward-compatibility kludges. Note that
 * these routines exist ONLY in char versions.
 *
 * Copyright © 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results.  The author
 * thanks all of them.
 *
26
27
28
29
30
31
32

















33
34
35
36
37
38
39
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * regcomp and regexec - front ends to re_ routines
 *
 * Mostly for implementation of backward-compatibility kludges. Note that
 * these routines exist ONLY in char versions.
 *
*/

#include "regguts.h"

/*
 - regcomp - compile regular expression
 */
int
Changes to generic/regguts.h.
1
2
3
4
5
6
7
8
9
10
1


2
3
4
5
6
7
8

-
-







/*
 * Internal interface definitions, etc., for the reg package
 *
 * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results.  The author
 * thanks all of them.
 *
23
24
25
26
27
28
29














30
31
32
33
34
35
36
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+







 * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * Internal interface definitions, etc., for the reg package
 *
*/

/*
 * Environmental customization. It should not (I hope) be necessary to alter
 * the file you are now reading -- regcustom.h should handle it all, given
 * care here and elsewhere.
 */
#include "regcustom.h"
Changes to generic/tcl.decls.
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
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







+
+
+
+
+
+
+











-
+
-
-
+
+







# Copyright © 1998-1999 Scriptics Corporation.
# Copyright © 2001, 2002 Kevin B. Kenny.  All rights reserved.
# Copyright © 2007 Daniel A. Steffen <das@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

library tcl

# Define the tcl interface with several sub interfaces:
#     tclPlat	 - platform specific public
#     tclInt	 - generic private
#     tclPlatInt - platform specific private

interface tcl
hooks {tclPlat tclInt tclIntPlat}
scspec EXTERN

# Declare each of the functions in the public Tcl interface.  Note that
# Declare each of the functions in the public Tcl interface. In order to
# the an index should never be reused for a different function in order
# to preserve backwards compatibility.
# preserve backwards compatibility, an index should never be reused for a
# different function.

declare 0 {
    int Tcl_PkgProvideEx(Tcl_Interp *interp, const char *name,
	    const char *version, const void *clientData)
}
declare 1 {
    const char *Tcl_PkgRequireEx(Tcl_Interp *interp,
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
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







+
+
+
+












+
+
+
+







}
declare 20 {
    void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file, int line)
}
declare 21 {
    int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line)
}
# Removed in 9.0 (changed to macro):
#declare 22 {
#    Tcl_Obj *Tcl_DbNewBooleanObj(int intValue, const char *file, int line)
#}
declare 23 {
    Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes,
	    Tcl_Size numBytes, const char *file, int line)
}
declare 24 {
    Tcl_Obj *Tcl_DbNewDoubleObj(double doubleValue, const char *file,
	    int line)
}
declare 25 {
    Tcl_Obj *Tcl_DbNewListObj(Tcl_Size objc, Tcl_Obj *const *objv,
	    const char *file, int line)
}
# Removed in 9.0 (changed to macro):
#declare 26 {
#    Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line)
#}
declare 27 {
    Tcl_Obj *Tcl_DbNewObj(const char *file, int line)
}
declare 28 {
    Tcl_Obj *Tcl_DbNewStringObj(const char *bytes, Tcl_Size length,
	    const char *file, int line)
}
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
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







+
+
+
+
+












-
-
+
+
-
+











+
-
-
-
+
+
+
-
+




+
-
-
-
+
+
+
-
+




+
+
+
+






+
+
+
+



+
+
+
+






+
+
+
+










+
+
+
+



+
+
+
+






+
+
+
+
+
+
+
+
+







declare 34 {
    int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr)
}
declare 35 {
    int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    double *doublePtr)
}
# Removed in 9.0, replaced by macro.
#declare 36 {
#    int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
#	    const char *const *tablePtr, const char *msg, int flags, int *indexPtr)
#}
declare 37 {
    int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr)
}
declare 38 {
    int Tcl_GetIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr)
}
declare 39 {
    int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr)
}
declare 40 {
    const Tcl_ObjType *Tcl_GetObjType(const char *typeName)
}
declare 41 {
    char *TclGetStringFromObj(Tcl_Obj *objPtr, void *lengthPtr)
#declare 41 {
#    char *TclGetStringFromObj(Tcl_Obj *objPtr, void *lengthPtr)
}
#}
declare 42 {
    void Tcl_InvalidateStringRep(Tcl_Obj *objPtr)
}
declare 43 {
    int Tcl_ListObjAppendList(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    Tcl_Obj *elemListPtr)
}
declare 44 {
    int Tcl_ListObjAppendElement(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    Tcl_Obj *objPtr)
}
#obsolete in 9.0
declare 45 {
    int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    void *objcPtr, Tcl_Obj ***objvPtr)
#declare 45 {
#    int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr,
#	    void *objcPtr, Tcl_Obj ***objvPtr)
}
#}
declare 46 {
    int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size index,
	    Tcl_Obj **objPtrPtr)
}
#obsolete in 9.0
declare 47 {
    int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    void *lengthPtr)
#declare 47 {
#    int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr,
#	    void *lengthPtr)
}
#}
declare 48 {
    int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size first,
	    Tcl_Size count, Tcl_Size objc, Tcl_Obj *const objv[])
}
# Removed in 9.0 (changed to macro):
#declare 49 {
#    Tcl_Obj *Tcl_NewBooleanObj(int intValue)
#}
declare 50 {
    Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, Tcl_Size numBytes)
}
declare 51 {
    Tcl_Obj *Tcl_NewDoubleObj(double doubleValue)
}
# Removed in 9.0 (changed to macro):
#declare 52 {
#    Tcl_Obj *Tcl_NewIntObj(int intValue)
#}
declare 53 {
    Tcl_Obj *Tcl_NewListObj(Tcl_Size objc, Tcl_Obj *const objv[])
}
# Removed in 9.0 (changed to macro):
#declare 54 {
#    Tcl_Obj *Tcl_NewLongObj(long longValue)
#}
declare 55 {
    Tcl_Obj *Tcl_NewObj(void)
}
declare 56 {
    Tcl_Obj *Tcl_NewStringObj(const char *bytes, Tcl_Size length)
}
# Removed in 9.0 (changed to macro):
#declare 57 {
#    void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int intValue)
#}
declare 58 {
    unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, Tcl_Size numBytes)
}
declare 59 {
    void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, const unsigned char *bytes,
	    Tcl_Size numBytes)
}
declare 60 {
    void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue)
}
# Removed in 9.0 (changed to macro):
#declare 61 {
#    void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)
#}
declare 62 {
    void Tcl_SetListObj(Tcl_Obj *objPtr, Tcl_Size objc, Tcl_Obj *const objv[])
}
# Removed in 9.0 (changed to macro):
#declare 63 {
#    void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue)
#}
declare 64 {
    void Tcl_SetObjLength(Tcl_Obj *objPtr, Tcl_Size length)
}
declare 65 {
    void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, Tcl_Size length)
}
# Removed in 9.0, replaced by macro.
#declare 66 {
#    void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message)
#}
# Removed in 9.0, replaced by macro.
#declare 67 {
#    void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message,
#	    Tcl_Size length)
#}
declare 68 {
    void Tcl_AllowExceptions(Tcl_Interp *interp)
}
declare 69 {
    void Tcl_AppendElement(Tcl_Interp *interp, const char *element)
}
declare 70 {
244
245
246
247
248
249
250








251
252
253
254
255
256
257
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320







+
+
+
+
+
+
+
+







}
declare 74 {
    void Tcl_AsyncMark(Tcl_AsyncHandler async)
}
declare 75 {
    int Tcl_AsyncReady(void)
}
# Removed in 9.0
#declare 76 {
#    void Tcl_BackgroundError(Tcl_Interp *interp)
#}
# Removed in 9.0:
#declare 77 {
#    char Tcl_Backslash(const char *src, int *readPtr)
#}
declare 78 {
    int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName,
	    const char *optionList)
}
declare 79 {
    void Tcl_CallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc,
	    void *clientData)
309
310
311
312
313
314
315






316
317
318
319
320
321
322
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391







+
+
+
+
+
+







}
declare 93 {
    void Tcl_CreateExitHandler(Tcl_ExitProc *proc, void *clientData)
}
declare 94 {
    Tcl_Interp *Tcl_CreateInterp(void)
}
# Removed in 9.0:
#declare 95 {
#    void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name,
#	    int numArgs, Tcl_ValueType *argTypes,
#	    Tcl_MathProc *proc, void *clientData)
#}
declare 96 {
    Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp,
	    const char *cmdName,
	    Tcl_ObjCmdProc *proc, void *clientData,
	    Tcl_CmdDeleteProc *deleteProc)
}
declare 97 {
418
419
420
421
422
423
424




425
426
427




428
429
430
431
432
433
434
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







+
+
+
+



+
+
+
+







}
declare 127 {
    const char *Tcl_ErrnoId(void)
}
declare 128 {
    const char *Tcl_ErrnoMsg(int err)
}
# Removed in 9.0, replaced by macro.
#declare 129 {
#    int Tcl_Eval(Tcl_Interp *interp, const char *script)
#}
declare 130 {
    int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName)
}
# Removed in 9.0, replaced by macro.
#declare 131 {
#    int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
#}
declare 132 {
    void Tcl_EventuallyFree(void *clientData, Tcl_FreeProc *freeProc)
}
declare 133 {
    TCL_NORETURN void Tcl_Exit(int status)
}
declare 134 {
459
460
461
462
463
464
465




466
467
468
469
470
471
472

473
474
475
476
477
478
479
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







+
+
+
+







+







}
declare 142 {
    int Tcl_ExprString(Tcl_Interp *interp, const char *expr)
}
declare 143 {
    void Tcl_Finalize(void)
}
# Removed in 9.0 (stub entry only)
#declare 144 {
#    const char *Tcl_FindExecutable(const char *argv0)
#}
declare 145 {
    Tcl_HashEntry *Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
	    Tcl_HashSearch *searchPtr)
}
declare 146 {
    int Tcl_Flush(Tcl_Channel chan)
}

declare 149 {
    int TclGetAliasObj(Tcl_Interp *interp, const char *childCmd,
	    Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
	    int *objcPtr, Tcl_Obj ***objvPtr)
}
declare 150 {
    void *Tcl_GetAssocData(Tcl_Interp *interp, const char *name,
556
557
558
559
560
561
562









563
564
565
566








567
568
569
570
571
572
573
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







+
+
+
+
+
+
+
+
+




+
+
+
+
+
+
+
+







}
declare 172 {
    Tcl_Interp *Tcl_GetChild(Tcl_Interp *interp, const char *name)
}
declare 173 {
    Tcl_Channel Tcl_GetStdChannel(int type)
}
# Removed in 9.0, replaced by macro.
#declare 174 {
#    const char *Tcl_GetStringResult(Tcl_Interp *interp)
#}
# Removed in 9.0, replaced by macro.
#declare 175 {
#    const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName,
#	    int flags)
#}
declare 176 {
    const char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
	    const char *part2, int flags)
}
# Removed in 9.0, replaced by macro.
#declare 177 {
#    int Tcl_GlobalEval(Tcl_Interp *interp, const char *command)
#}
# Removed in 9.0, replaced by macro.
#declare 178 {
#    int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
#}
declare 179 {
    int Tcl_HideCommand(Tcl_Interp *interp, const char *cmdName,
	    const char *hiddenCmdToken)
}
declare 180 {
    int Tcl_Init(Tcl_Interp *interp)
}
600
601
602
603
604
605
606




607
608
609
610
611
612
613
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716







+
+
+
+







#  declare 188 {
#	Tcl_MainLoop
#  }

declare 189 {
    Tcl_Channel Tcl_MakeFileChannel(void *handle, int mode)
}
# Removed in 9.0
#declare 190 {
#    int Tcl_MakeSafe(Tcl_Interp *interp)
#}
declare 191 {
    Tcl_Channel Tcl_MakeTcpClientChannel(void *tcpSocket)
}
declare 192 {
    char *Tcl_Merge(Tcl_Size argc, const char *const *argv)
}
declare 193 {
698
699
700
701
702
703
704




705
706
707
708
709
710
711
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818







+
+
+
+







}
declare 218 {
    Tcl_Size Tcl_ScanElement(const char *src, int *flagPtr)
}
declare 219 {
    Tcl_Size Tcl_ScanCountedElement(const char *src, Tcl_Size length, int *flagPtr)
}
# Removed in 9.0:
#declare 220 {
#    int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode)
#}
declare 221 {
    int Tcl_ServiceAll(void)
}
declare 222 {
    int Tcl_ServiceEvent(int flags)
}
declare 223 {
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
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







+
+
+
+



+
+
+
+
+












+
+
+
+
+







}
declare 228 {
    void Tcl_SetErrorCode(Tcl_Interp *interp, ...)
}
declare 229 {
    void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr)
}
# Removed in 9.0 (stub entry only)
#declare 230 {
#    const char *Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc)
#}
declare 231 {
    Tcl_Size Tcl_SetRecursionLimit(Tcl_Interp *interp, Tcl_Size depth)
}
# Removed in 9.0, replaced by macro.
#declare 232 {
#    void Tcl_SetResult(Tcl_Interp *interp, char *result,
#	    Tcl_FreeProc *freeProc)
#}
declare 233 {
    int Tcl_SetServiceMode(int mode)
}
declare 234 {
    void Tcl_SetObjErrorCode(Tcl_Interp *interp, Tcl_Obj *errorObjPtr)
}
declare 235 {
    void Tcl_SetObjResult(Tcl_Interp *interp, Tcl_Obj *resultObjPtr)
}
declare 236 {
    void Tcl_SetStdChannel(Tcl_Channel channel, int type)
}
# Removed in 9.0, replaced by macro.
#declare 237 {
#    const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName,
#	    const char *newValue, int flags)
#}
declare 238 {
    const char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
	    const char *part2, const char *newValue, int flags)
}
declare 239 {
    const char *Tcl_SignalId(int sig)
}
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
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

















+
+
+
+




+
+
+
+
+








+
+
+
+
+







+
+
+
+
+


















+
+
+
+
+
+
+
+







+
+
+
+
+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



+
+
+
+







    int TclSplitList(Tcl_Interp *interp, const char *listStr, void *argcPtr,
	    const char ***argvPtr)
}
# Obsolete, use Tcl_FSSplitPath
declare 243 {
    void TclSplitPath(const char *path, void *argcPtr, const char ***argvPtr)
}
# Removed in 9.0 (stub entry only)
#declare 244  {
#    void Tcl_StaticLibrary(Tcl_Interp *interp, const char *prefix,
#	    Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc)
#}
# Removed in 9.0 (stub entry only)
#declare 245 {
#    int Tcl_StringMatch(const char *str, const char *pattern)
#}
# Removed in 9.0:
#declare 246 {
#    int Tcl_TellOld(Tcl_Channel chan)
#}
# Removed in 9.0, replaced by macro.
#declare 247 {
#    int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags,
#	    Tcl_VarTraceProc *proc, void *clientData)
#}
declare 248 {
    int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2,
	    int flags, Tcl_VarTraceProc *proc, void *clientData)
}
declare 249 {
    char *Tcl_TranslateFileName(Tcl_Interp *interp, const char *name,
	    Tcl_DString *bufferPtr)
}
declare 250 {
    Tcl_Size Tcl_Ungets(Tcl_Channel chan, const char *str, Tcl_Size len, int atHead)
}
declare 251 {
    void Tcl_UnlinkVar(Tcl_Interp *interp, const char *varName)
}
declare 252 {
    int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan)
}
# Removed in 9.0, replaced by macro.
#declare 253 {
#    int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags)
#}
declare 254 {
    int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, const char *part2,
	    int flags)
}
# Removed in 9.0, replaced by macro.
#declare 255 {
#    void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags,
#	    Tcl_VarTraceProc *proc, void *clientData)
#}
declare 256 {
    void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1,
	    const char *part2, int flags, Tcl_VarTraceProc *proc,
	    void *clientData)
}
declare 257 {
    void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName)
}
# Removed in 9.0, replaced by macro.
#declare 258 {
#    int Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
#	    const char *varName, const char *localName, int flags)
#}
declare 259 {
    int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName, const char *part1,
	    const char *part2, const char *localName, int flags)
}
declare 260 {
    int Tcl_VarEval(Tcl_Interp *interp, ...)
}
# Removed in 9.0, replaced by macro.
#declare 261 {
#    void *Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName,
#	    int flags, Tcl_VarTraceProc *procPtr, void *prevClientData)
#}
declare 262 {
    void *Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1,
	    const char *part2, int flags, Tcl_VarTraceProc *procPtr,
	    void *prevClientData)
}
declare 263 {
    Tcl_Size Tcl_Write(Tcl_Channel chan, const char *s, Tcl_Size slen)
}
declare 264 {
    void Tcl_WrongNumArgs(Tcl_Interp *interp, Tcl_Size objc,
	    Tcl_Obj *const objv[], const char *message)
}
declare 265 {
    int Tcl_DumpActiveMemory(const char *fileName)
}
declare 266 {
    void Tcl_ValidateAllMemory(const char *file, int line)
}
# Removed in 9.0:
#declare 267 {
#    void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList)
#}
# Removed in 9.0:
#declare 268 {
#    void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList)
#}
declare 269 {
    char *Tcl_HashStats(Tcl_HashTable *tablePtr)
}
declare 270 {
    const char *Tcl_ParseVar(Tcl_Interp *interp, const char *start,
	    const char **termPtr)
}
# Removed in 9.0, replaced by macro.
#declare 271 {
#    const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
#	    const char *version, int exact)
#}
declare 272 {
    const char *Tcl_PkgPresentEx(Tcl_Interp *interp,
	    const char *name, const char *version, int exact,
	    void *clientDataPtr)
}
# Removed in 9.0, replaced by macro.
#declare 273 {
#    int Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
#	    const char *version)
#}
# TIP #268: The internally used new Require function is in slot 573.
# Removed in 9.0, replaced by macro.
#declare 274 {
#    const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
#	    const char *version, int exact)
#}
# Removed in 9.0:
#declare 275 {
#    void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList)
#}
# Removed in 9.0:
#declare 276 {
#    int  Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList)
#}
declare 277 {
    Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options)
}
# Removed in 9.0:
#declare 278 {
#    TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList)
#}
declare 279 {
    void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type)
}
declare 280 {
    void Tcl_InitMemory(Tcl_Interp *interp)
}

891
892
893
894
895
896
897




898
899
900
901
902
903
904
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102







+
+
+
+







}
declare 288 {
    void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, void *clientData)
}
declare 289 {
    void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, void *clientData)
}
# Removed in 9.0
#declare 290 {
#    void Tcl_DiscardResult(Tcl_SavedResult *statePtr)
#}
declare 291 {
    int Tcl_EvalEx(Tcl_Interp *interp, const char *script, Tcl_Size numBytes,
	    int flags)
}
declare 292 {
    int Tcl_EvalObjv(Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[],
	    int flags)
971
972
973
974
975
976
977








978
979
980
981
982
983
984
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190







+
+
+
+
+
+
+
+







declare 312 {
    Tcl_Size TclNumUtfChars(const char *src, Tcl_Size length)
}
declare 313 {
    Tcl_Size Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr,
	    Tcl_Size charsToRead, int appendFlag)
}
# Removed in 9.0
#declare 314 {
#    void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr)
#}
# Removed in 9.0
#declare 315 {
#    void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr)
#}
declare 316 {
    int Tcl_SetSystemEncoding(Tcl_Interp *interp, const char *name)
}
declare 317 {
    Tcl_Obj *Tcl_SetVar2Ex(Tcl_Interp *interp, const char *part1,
	    const char *part2, Tcl_Obj *newValuePtr, int flags)
}
1052
1053
1054
1055
1056
1057
1058








1059
1060
1061
1062
1063
1064
1065
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279







+
+
+
+
+
+
+
+







}
declare 339 {
    Tcl_Size Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr)
}
declare 340 {
    char *Tcl_GetString(Tcl_Obj *objPtr)
}
# Removed in 9.0:
#declare 341 {
#    const char *Tcl_GetDefaultEncodingDir(void)
#}
# Removed in 9.0:
#declare 342 {
#    void Tcl_SetDefaultEncodingDir(const char *path)
#}
declare 343 {
    void Tcl_AlertNotifier(void *clientData)
}
declare 344 {
    void Tcl_ServiceModeHook(int mode)
}
declare 345 {
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
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







+
+
+
+
+












+
+
+
+
+







}
declare 351 {
    int Tcl_UniCharIsWordChar(int ch)
}
declare 352 {
    Tcl_Size Tcl_Char16Len(const unsigned short *uniStr)
}
# Removed in 9.0:
#declare 353 {
#    int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct,
#	    unsigned long numChars)
#}
declare 354 {
    char *Tcl_Char16ToUtfDString(const unsigned short *uniStr,
	    Tcl_Size uniLength, Tcl_DString *dsPtr)
}
declare 355 {
    unsigned short *Tcl_UtfToChar16DString(const char *src,
	    Tcl_Size length, Tcl_DString *dsPtr)
}
declare 356 {
    Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj,
	    int flags)
}
# Removed in 9.0:
#declare 357 {
#    Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
#	    Tcl_Size count)
#}
declare 358 {
    void Tcl_FreeParse(Tcl_Parse *parsePtr)
}
declare 359 {
    void Tcl_LogCommandInfo(Tcl_Interp *interp, const char *script,
	    const char *command, Tcl_Size length)
}
1178
1179
1180
1181
1182
1183
1184




1185
1186
1187
1188
1189
1190
1191
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419







+
+
+
+







}
declare 380 {
    Tcl_Size TclGetCharLength(Tcl_Obj *objPtr)
}
declare 381 {
    int TclGetUniChar(Tcl_Obj *objPtr, Tcl_Size index)
}
# Removed in 9.0, replaced by macro.
#declare 382 {
#    Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr)
#}
declare 383 {
    Tcl_Obj *TclGetRange(Tcl_Obj *objPtr, Tcl_Size first, Tcl_Size last)
}
declare 384 {
    void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode,
	    Tcl_Size length)
}
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
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







+
+
+
+
+












+
+
+
+
+







    Tcl_ChannelTypeVersion Tcl_ChannelVersion(
	    const Tcl_ChannelType *chanTypePtr)
}
declare 400 {
    Tcl_DriverBlockModeProc *Tcl_ChannelBlockModeProc(
	    const Tcl_ChannelType *chanTypePtr)
}
# Removed in 9.0
#declare 401 {
#    Tcl_DriverCloseProc *Tcl_ChannelCloseProc(
#	    const Tcl_ChannelType *chanTypePtr)
#}
declare 402 {
    Tcl_DriverClose2Proc *Tcl_ChannelClose2Proc(
	    const Tcl_ChannelType *chanTypePtr)
}
declare 403 {
    Tcl_DriverInputProc *Tcl_ChannelInputProc(
	    const Tcl_ChannelType *chanTypePtr)
}
declare 404 {
    Tcl_DriverOutputProc *Tcl_ChannelOutputProc(
	    const Tcl_ChannelType *chanTypePtr)
}
# Removed in 9.0
#declare 405 {
#    Tcl_DriverSeekProc *Tcl_ChannelSeekProc(
#	    const Tcl_ChannelType *chanTypePtr)
#}
declare 406 {
    Tcl_DriverSetOptionProc *Tcl_ChannelSetOptionProc(
	    const Tcl_ChannelType *chanTypePtr)
}
declare 407 {
    Tcl_DriverGetOptionProc *Tcl_ChannelGetOptionProc(
	    const Tcl_ChannelType *chanTypePtr)
1299
1300
1301
1302
1303
1304
1305



















1306
1307
1308
1309
1310
1311
1312
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







}
declare 417 {
    void Tcl_ClearChannelHandlers(Tcl_Channel channel)
}
declare 418 {
    int Tcl_IsChannelExisting(const char *channelName)
}
# Removed in 9.0:
#declare 419 {
#    int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct,
#	    unsigned long numChars)
#}
# Removed in 9.0:
#declare 420 {
#    int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
#	    const Tcl_UniChar *uniPattern, int nocase)
#}
# Removed in 9.0, as it is actually a macro:
#declare 421 {
#    Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key)
#}
# Removed in 9.0, as it is actually a macro:
#declare 422 {
#    Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
#	    const void *key, int *newPtr)
#}
declare 423 {
    void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType,
	    const Tcl_HashKeyType *typePtr)
}
declare 424 {
    void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr)
}
1345
1346
1347
1348
1349
1350
1351












1352
1353
1354
1355
1356
1357
1358
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







+
+
+
+
+
+
+
+
+
+
+
+







    Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel)
}

# introduced in 8.4a3
declare 434 {
    Tcl_UniChar *TclGetUnicodeFromObj(Tcl_Obj *objPtr, void *lengthPtr)
}

# TIP#15 (math function introspection) dkf
# Removed in 9.0:
#declare 435 {
#    int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name,
#	    int *numArgsPtr, Tcl_ValueType **argTypesPtr,
#	    Tcl_MathProc **procPtr, void **clientDataPtr)
#}
# Removed in 9.0:
#declare 436 {
#    Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern)
#}

# TIP#36 (better access to 'subst') dkf
declare 437 {
    Tcl_Obj *Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
}

# TIP#17 (virtual filesystem layer) vdarley
1658
1659
1660
1661
1662
1663
1664





1665
1666
1667
1668
1669
1670
1671
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945







+
+
+
+
+







}

# TIP#137 (encoding-aware source command) dgp for Anton Kovalenko
declare 518 {
    int Tcl_FSEvalFileEx(Tcl_Interp *interp, Tcl_Obj *fileName,
	    const char *encodingName)
}

# Removed in 9.0 (stub entry only)
#declare 519 {nostub {Don't use this function in a stub-enabled extension}} {
#    Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc)
#}

# TIP#143 (resource limits) dkf
declare 520 {
    void Tcl_LimitAddHandler(Tcl_Interp *interp, int type,
	    Tcl_LimitHandlerProc *handlerProc, void *clientData,
	    Tcl_LimitHandlerDeleteProc *deleteProc)
}
2224
2225
2226
2227
2228
2229
2230





2231
2232
2233
2234
2235
2236
2237
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516







+
+
+
+
+







}
declare 655 {
    const char *Tcl_UtfNext(const char *src)
}
declare 656 {
    const char *Tcl_UtfPrev(const char *src, const char *start)
}
# Removed by TIP #652
#
#declare 657 {
#    int Tcl_UniCharIsUnicode(int ch)
#}

# TIP 656
declare 658 {
    int Tcl_ExternalToUtfDStringEx(Tcl_Interp *interp, Tcl_Encoding encoding,
	    const char *src, Tcl_Size srcLen, int flags, Tcl_DString *dsPtr,
	    Tcl_Size *errorLocationPtr)
}
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
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


















-
+







}

# ----- BASELINE -- FOR -- 8.7.0 / 9.0.0 ----- #

declare 690 {
    void TclUnusedStubEntry(void)
}


declare 691 {
    Tcl_ObjInterface *Tcl_NewObjInterface(void)
}

declare 692 {
    Tcl_ObjType *Tcl_NewObjType(void)
}

declare 693 {
    int Tcl_ObjInterfaceSetVersion(Tcl_ObjInterface *oiPtr ,int version)
}

declare 694 {
    int Tcl_ObjTypeSetFreeInternalRepProc(Tcl_ObjType *otPtr
	    , Tcl_FreeInternalRepProc *freeIntRepProc)
}

declare 695 {
    int Tcl_ObjTypeSetDupInternalRepProc(Tcl_ObjType *otPtr
	,Tcl_DupInternalRepProc *dupIntRepProc)
}

declare 696 {
    int Tcl_ObjTypeSetUpdateStringProc(Tcl_ObjType *otPtr
	,Tcl_UpdateStringProc *updateStringProc)
}

declare 697 {
    int Tcl_ObjTypeSetSetFromAnyProc(Tcl_ObjType *otPtr
	,Tcl_SetFromAnyProc *setFromAnyProc)
}

declare 698 {
    int Tcl_ObjTypeSetVersion(Tcl_ObjType *otPtr ,int version)
}

declare 699 {
    int Tcl_ObjInterfaceSetFnListAll(Tcl_ObjInterface *oiPtr
	, Tcl_ObjInterfaceListAllProc *fnPtr)
}

declare 700 {
    int Tcl_ObjInterfaceSetFnListAppend(Tcl_ObjInterface *oiPtr
	, Tcl_ObjInterfaceListAppendProc *fnPtr)
}

declare 701 {
    int Tcl_ObjInterfaceSetFnListAppendList(Tcl_ObjInterface *oiPtr
	, Tcl_ObjInterfaceListAppendlistProc fnPtr)
}


declare 702 {
    int Tcl_ObjInterfaceSetFnListIndex(Tcl_ObjInterface *oiPtr
	,Tcl_ObjInterfaceListIndexProc fnPtr)
}


declare 703 {
    int Tcl_ObjInterfaceSetFnListIndexEnd(Tcl_ObjInterface *oiPtr
	, Tcl_ObjInterfaceListIndexEndProc fnPtr)
}

declare 704 {
    int Tcl_ObjInterfaceSetFnListIsSorted(Tcl_ObjInterface *oiPtr
	, Tcl_ObjInterfaceListIsSortedProc fnPtr)
}

declare 705 {
    int Tcl_ObjInterfaceSetFnListLength(Tcl_ObjInterface *oiPtr
	,Tcl_ObjInterfaceListLengthProc fnPtr)
}

declare 706 {
    int Tcl_ObjInterfaceSetFnListRange(Tcl_ObjInterface *oiPtr
	,Tcl_ObjInterfaceListRangeProc fnPtr)
}

declare 707 {
    int Tcl_ObjInterfaceSetFnListRangeEnd(Tcl_ObjInterface *oiPtr
	,Tcl_ObjInterfaceListRangeEndProc fnPtr)
}

declare 708 {
    int Tcl_ObjInterfaceSetFnListReplace(Tcl_ObjInterface *oiPtr
	,Tcl_ObjInterfaceListReplaceProc fnPtr)
}


declare 709 {
    int Tcl_ObjInterfaceSetFnListReplaceList(Tcl_ObjInterface *oiPtr
	,Tcl_ObjInterfaceListReplaceListProc fnPtr)
}

declare 710 {
    int Tcl_ObjInterfaceSetFnListReverse(Tcl_ObjInterface *objInterfacePtr
	,Tcl_ObjInterfaceListReverseProc fnPtr)
}

declare 711 {
    int Tcl_ObjInterfaceSetFnListSet(Tcl_ObjInterface *oiPtr
	,Tcl_ObjInterfaceListSetProc fnPtr)
}

declare 712 {
    int Tcl_ObjInterfaceSetFnListSetDeep(Tcl_ObjInterface *oiPtr
	,Tcl_ObjInterfaceListSetDeepProc fnPtr)
}

declare 713 {
    int Tcl_ObjInterfaceSetFnStringIndex(Tcl_ObjInterface *oiPtr
	,Tcl_ObjInterfaceStringIndexProc fnPtr)
}

declare 714 {
    int Tcl_ObjInterfaceSetFnStringIndexEnd(Tcl_ObjInterface *oiPtr
	,Tcl_ObjInterfaceStringIndexEndProc fnPtr)
}

declare 715 {
    int Tcl_ObjInterfaceSetFnStringLength(Tcl_ObjInterface *oiPtr
	,Tcl_ObjInterfaceStringLengthProc fnPtr)
}

declare 716 {
    int Tcl_ObjInterfaceSetFnStringRange(Tcl_ObjInterface *oiPtr
	,Tcl_ObjInterfaceStringRangeProc fnPtr)
}

declare 717 {
    int Tcl_ObjInterfaceSetFnStringRangeEnd(Tcl_ObjInterface *oiPtr
	,Tcl_ObjInterfaceStringRangeEndProc fnPtr)
}

declare 718 {
    int Tcl_ObjTypeSetInterface(Tcl_ObjType *objTypePtr
	,Tcl_ObjInterface *objInterfacePtr)
}


declare 719 {
    int Tcl_ObjTypeSetName(Tcl_ObjType *objTypePtr ,char *name)
}


declare 720 {
    int Tcl_ObjInterfaceSetFnStringIsEmpty(Tcl_ObjInterface *oiPtr
	,Tcl_ObjInterfaceStringIsEmptyProc fnPtr)
}


declare 721 {
    int Tcl_ObjInterfaceSetFnListContains(Tcl_ObjInterface *oiPtr
	,Tcl_ObjInterfaceListContainsProc fnPtr)
}




##############################################################################

# Define the platform specific public Tcl interface. These functions are only
# available on the designated platform.

interface tclPlat

################################
# Unix specific functions
#   (none)

################################
# Mac OS X specific functions

declare 1 {
    int Tcl_MacOSXOpenVersionedBundleResources(Tcl_Interp *interp,
	    const char *bundleName, const char *bundleVersion,
	    int hasResourceFile, Tcl_Size maxPathLen, char *libraryPath)
	    Tcl_Size hasResourceFile, Tcl_Size maxPathLen, char *libraryPath)
}
declare 2 {
    void Tcl_MacOSXNotifierAddRunLoopMode(const void *runLoopMode)
}

################################
# Windows specific functions
Changes to generic/tcl.h.
1
2
3
4
5
6
7
8
9
10
11

12
13
14
15



















16
17
18
19
20
21
22
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

-
-
-
-
-





+




+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tcl.h --
 *
 *	This header file describes the externally-visible facilities of the
 *	Tcl interpreter.
 *
 * Copyright (c) 1987-1994 The Regents of the University of California.
 * Copyright (c) 1993-1996 Lucent Technologies.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 by Scriptics Corporation.
 * Copyright (c) 2002 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2021 by Nathan Coulter.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * Copyright © 2024 Nathan Coulter
 *
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tcl.h --
 *
 *	This header file describes the externally-visible facilities of the
 *	Tcl interpreter.
 *
*/

#ifndef _TCL
#define _TCL

/*
 * For C++ compilers, use extern "C"
 */
101
102
103
104
105
106
107






108
109
110
111
112
113
114
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135







+
+
+
+
+
+







 * providing it for them rather than #include-ing it themselves as they
 * should, so also for their sake, we keep the #include to be consistent with
 * prior Tcl releases.
 */

#include <stdio.h>
#include <stddef.h>

/* Needed for PTRDIFF_MAX */
#include <stdint.h>


#define TCL_COMMENT(x)

#if defined(__GNUC__) && (__GNUC__ > 2)
#   if defined(_WIN32) && defined(__USE_MINGW_ANSI_STDIO) && __USE_MINGW_ANSI_STDIO
#	define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__MINGW_PRINTF_FORMAT, a, b)))
#   else
#	define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b)))
#   endif
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
226
227
228
229
230
231
232




233
234
235
236
237
238
239







-
-
-
-







#   ifdef USE_TCL_STUBS
#      define TCL_STORAGE_CLASS
#   else
#      define TCL_STORAGE_CLASS DLLIMPORT
#   endif
#endif

#if !defined(CONST86) && !defined(TCL_NO_DEPRECATED)
#      define CONST86 const
#endif

/*
 * Make sure EXTERN isn't defined elsewhere.
 */

#ifdef EXTERN
#   undef EXTERN
#endif /* EXTERN */
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
335
336
337
338
339
340
341








342
343
344

345
346


347





348
349
350
351
352
353
354







-
-
-
-
-
-
-
-
+
+
+
-


-
-
+
-
-
-
-
-







#endif /* !TCL_T_MODIFIER */

#define Tcl_WideAsLong(val)	((long)((Tcl_WideInt)(val)))
#define Tcl_LongAsWide(val)	((Tcl_WideInt)((long)(val)))
#define Tcl_WideAsDouble(val)	((double)((Tcl_WideInt)(val)))
#define Tcl_DoubleAsWide(val)	((Tcl_WideInt)((double)(val)))

#if TCL_MAJOR_VERSION < 9
    typedef int Tcl_Size;
#   define TCL_SIZE_MAX ((int)(((unsigned int)-1)>>1))
#   define TCL_SIZE_MODIFIER ""
#else
    typedef ptrdiff_t Tcl_Size;
#   define TCL_SIZE_MAX ((Tcl_Size)(((size_t)-1)>>1))
#   define TCL_SIZE_MODIFIER TCL_T_MODIFIER
typedef ptrdiff_t Tcl_Size;
#define TCL_SIZE_MAX PTRDIFF_MAX
#define TCL_SIZE_MODIFIER TCL_T_MODIFIER
#endif /* TCL_MAJOR_VERSION */

#ifdef _WIN32
#   if TCL_MAJOR_VERSION > 8 || defined(_WIN64) || defined(_USE_64BIT_TIME_T)
	typedef struct __stat64 Tcl_StatBuf;
typedef struct __stat64 Tcl_StatBuf;
#   elif defined(_USE_32BIT_TIME_T)
	typedef struct _stati64	Tcl_StatBuf;
#   else
	typedef struct _stat32i64 Tcl_StatBuf;
#   endif
#elif defined(__CYGWIN__)
    typedef struct {
	unsigned st_dev;
	unsigned short st_ino;
	unsigned short st_mode;
	short st_nlink;
	short st_uid;
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
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







-




-
-
-
-






-


-
-
-
-







/*
 * Structures filled in by Tcl_RegExpInfo. Note that all offset values are
 * relative to the start of the match string, not the beginning of the entire
 * string.
 */

typedef struct Tcl_RegExpIndices {
#if TCL_MAJOR_VERSION > 8
    Tcl_Size start;		/* Character offset of first character in
				 * match. */
    Tcl_Size end;		/* Character offset of first character after
				 * the match. */
#else
    long start;
    long end;
#endif
} Tcl_RegExpIndices;

typedef struct Tcl_RegExpInfo {
    Tcl_Size nsubs;		/* Number of subexpressions in the compiled
				 * expression. */
    Tcl_RegExpIndices *matches;	/* Array of nsubs match offset pairs. */
#if TCL_MAJOR_VERSION > 8
    Tcl_Size extendStart;	/* The offset at which a subsequent match
				 * might begin. */
#else
    long extendStart;
    long reserved;		/* Reserved for later use. */
#endif
} Tcl_RegExpInfo;

/*
 * Picky compilers complain if this typdef doesn't appear before the struct's
 * reference in tclDecls.h.
 */

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
575
576
577
578
579
580
581

582
583
584
585
586
587
588
589

590





591
592
593
594
595
596
597







-








-

-
-
-
-
-







typedef void (Tcl_FreeInternalRepProc) (struct Tcl_Obj *objPtr);
typedef void (Tcl_IdleProc) (void *clientData);
typedef void (Tcl_InterpDeleteProc) (void *clientData,
	Tcl_Interp *interp);
typedef void (Tcl_NamespaceDeleteProc) (void *clientData);
typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp,
	int objc, struct Tcl_Obj *const *objv);
#if TCL_MAJOR_VERSION > 8
typedef int (Tcl_ObjCmdProc2) (void *clientData, Tcl_Interp *interp,
	Tcl_Size objc, struct Tcl_Obj *const *objv);
typedef int (Tcl_CmdObjTraceProc2) (void *clientData, Tcl_Interp *interp,
	Tcl_Size level, const char *command, Tcl_Command commandInfo, Tcl_Size objc,
	struct Tcl_Obj *const *objv);
typedef void (Tcl_FreeProc) (void *blockPtr);
#define Tcl_ExitProc Tcl_FreeProc
#define Tcl_FileFreeProc Tcl_FreeProc
#define Tcl_FileFreeProc Tcl_FreeProc
#define Tcl_EncodingFreeProc Tcl_FreeProc
#else
#define Tcl_ObjCmdProc2 Tcl_ObjCmdProc
#define Tcl_CmdObjTraceProc2 Tcl_CmdObjTraceProc
typedef void (Tcl_FreeProc) (char *blockPtr);
#endif
typedef int (Tcl_LibraryInitProc) (Tcl_Interp *interp);
typedef int (Tcl_LibraryUnloadProc) (Tcl_Interp *interp, int flags);
typedef void (Tcl_PanicProc) (const char *format, ...);
typedef void (Tcl_TcpAcceptProc) (void *callbackData, Tcl_Channel chan,
	char *address, int port);
typedef void (Tcl_TimerProc) (void *clientData);
typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr);
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







+
+
+
+
















-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
-
-
-
-
-
-
-
-
-







typedef void (Tcl_DeleteFileHandlerProc) (int fd);
typedef void (Tcl_AlertNotifierProc) (void *clientData);
typedef void (Tcl_ServiceModeHookProc) (int mode);
typedef void *(Tcl_InitNotifierProc) (void);
typedef void (Tcl_FinalizeNotifierProc) (void *clientData);
typedef void (Tcl_MainLoopProc) (void);

/* Abstract List functions */
typedef Tcl_Size (Tcl_ObjTypeLengthProc) (struct Tcl_Obj *listPtr);
typedef int (Tcl_ObjTypeIndexProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
	Tcl_Size index, struct Tcl_Obj** elemObj);
typedef int (Tcl_ObjTypeSliceProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
	Tcl_Size fromIdx, Tcl_Size toIdx, struct Tcl_Obj **newObjPtr);
typedef int (Tcl_ObjTypeReverseProc) (Tcl_Interp *interp,
	struct Tcl_Obj *listPtr, struct Tcl_Obj **newObjPtr);
typedef int (Tcl_ObjTypeGetElements) (Tcl_Interp *interp,
	struct Tcl_Obj *listPtr, Tcl_Size *objcptr, struct Tcl_Obj ***objvptr);
typedef	struct Tcl_Obj *(Tcl_ObjTypeSetElement) (Tcl_Interp *interp,
	struct Tcl_Obj *listPtr, Tcl_Size indexCount,
	struct Tcl_Obj *const indexArray[], struct Tcl_Obj *valueObj);
typedef int (Tcl_ObjTypeReplaceProc) (Tcl_Interp *interp,
	struct Tcl_Obj *listObj, Tcl_Size first, Tcl_Size numToDelete,
	Tcl_Size numToInsert, struct Tcl_Obj *const insertObjs[]);
typedef int (Tcl_ObjTypeInOperatorProc) (Tcl_Interp *interp,
	struct Tcl_Obj *valueObj, struct Tcl_Obj *listObj, int *boolResult);

#ifndef TCL_NO_DEPRECATED
#   define Tcl_PackageInitProc Tcl_LibraryInitProc
#   define Tcl_PackageUnloadProc Tcl_LibraryUnloadProc
#endif

/*
 *----------------------------------------------------------------------------
 * The following structure represents a type of object, which is a particular
 * internal representation for an object plus a set of functions that provide
 * standard operations on objects of that type.
 */

/* forward declaration */
typedef struct Tcl_Obj Tcl_Obj;
typedef struct Tcl_ObjInterface Tcl_ObjInterface;

typedef struct Tcl_ObjType {
    const char *name;		/* Name of the type, e.g. "int". */
    Tcl_FreeInternalRepProc *freeIntRepProc;
				/* Called to free any storage for the type's
				 * internal rep. NULL if the internal rep does
				 * not need freeing. */
    Tcl_DupInternalRepProc *dupIntRepProc;
				/* Called to create a new object as a copy of
				 * an existing object. */
    Tcl_UpdateStringProc *updateStringProc;
				/* Called to update the string rep from the
				 * type's internal representation. */
    Tcl_SetFromAnyProc *setFromAnyProc;
				/* Called to convert the object's internal rep
				 * to this type. Frees the internal rep of the
				 * old type. Returns TCL_ERROR on failure. */
#if TCL_MAJOR_VERSION > 8
    size_t version;		/* Version field for future-proofing. */

    /* List emulation functions - ObjType Version 1 */
    Tcl_ObjTypeLengthProc *lengthProc;
				/* Return the [llength] of the AbstractList */
    Tcl_ObjTypeIndexProc *indexProc;
				/* Return a value (Tcl_Obj) at a given index */
    Tcl_ObjTypeSliceProc *sliceProc;
				/* Return an AbstractList for
				 * [lrange $al $start $end] */
    Tcl_ObjTypeReverseProc *reverseProc;
				/* Return an AbstractList for [lreverse $al] */
    Tcl_ObjTypeGetElements *getElementsProc;
				/* Return an objv[] of all elements in the list */
    Tcl_ObjTypeSetElement *setElementProc;
				/* Replace the element at the indicies with the
				 * given valueObj. */
    Tcl_ObjTypeReplaceProc *replaceProc;
				/* Replace sublist with another sublist */
    Tcl_ObjTypeInOperatorProc *inOperProc;
				/* "in" and "ni" expr list operation.
				 * Determine if the given string value matches
				 * an element in the list. */
#endif
} Tcl_ObjType;

#if TCL_MAJOR_VERSION > 8
#   define TCL_OBJTYPE_V0 0, \
	   0,0,0,0,0,0,0,0	/* Pre-Tcl 9 */
#   define TCL_OBJTYPE_V1(a) offsetof(Tcl_ObjType, indexProc), \
	   a,0,0,0,0,0,0,0	/* Tcl 9 Version 1 */
#   define TCL_OBJTYPE_V2(a,b,c,d,e,f,g,h) sizeof(Tcl_ObjType),  \
	   a,b,c,d,e,f,g,h	/* Tcl 9 - AbstractLists */
#else
#   define TCL_OBJTYPE_V0 /* just empty */
#   define TCL_OBJTYPE_V1(a) /* just empty */
#   define TCL_OBJTYPE_V2(a,b,c,d,e,f,g,h) /* just empty */
#endif

/*
 * The following structure stores an internal representation (internalrep) for
 * a Tcl value. An internalrep is associated with an Tcl_ObjType when both
 * are stored in the same Tcl_Obj.  The routines of the Tcl_ObjType govern
 * the handling of the internalrep.
 */
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
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







-
+




















-
+








/*
 * One of the following structures exists for each object in the Tcl system.
 * An object stores a value as either a string, some internal representation,
 * or both.
 */

typedef struct Tcl_Obj {
struct Tcl_Obj {
    Tcl_Size refCount;		/* When 0 the object will be freed. */
    char *bytes;		/* This points to the first byte of the
				 * object's string representation. The array
				 * must be followed by a null byte (i.e., at
				 * offset length) but may also contain
				 * embedded null characters. The array's
				 * storage is allocated by Tcl_Alloc. NULL means
				 * the string rep is invalid and must be
				 * regenerated from the internal rep.  Clients
				 * should use Tcl_GetStringFromObj or
				 * Tcl_GetString to get a pointer to the byte
				 * array as a readonly value. */
    Tcl_Size length;		/* The number of bytes at *bytes, not
				 * including the terminating null. */
    const Tcl_ObjType *typePtr;	/* Denotes the object's type. Always
				 * corresponds to the type of the object's
				 * internal rep. NULL indicates the object has
				 * no internal rep (has no type). */
    Tcl_ObjInternalRep internalRep;
				/* The internal representation: */
} Tcl_Obj;
};

/*
 *----------------------------------------------------------------------------
 * The following definitions support Tcl's namespace facility. Note: the first
 * five fields must match exactly the fields in a Namespace structure (see
 * tclInt.h).
 */
944
945
946
947
948
949
950
951
952

953
954
955
956
957
958
959
960
961
962
876
877
878
879
880
881
882


883



884
885
886
887
888
889
890







-
-
+
-
-
-







#define TCL_INDEX_TEMP_TABLE	64

/*
 * Flags that may be passed to Tcl_UniCharToUtf.
 * TCL_COMBINE Combine surrogates
 */

#if TCL_MAJOR_VERSION > 8
#    define TCL_COMBINE		0x1000000
#define TCL_COMBINE		0x1000000
#else
#    define TCL_COMBINE		0
#endif
/*
 *----------------------------------------------------------------------------
 * Flag values passed to Tcl_RecordAndEval, Tcl_EvalObj, Tcl_EvalObjv.
 * WARNING: these bit choices must not conflict with the bit choices for
 * evalFlag bits in tclInt.h!
 *
 * Meanings:
1053
1054
1055
1056
1057
1058
1059
1060
1061

1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
981
982
983
984
985
986
987


988



989
990
991
992
993
994
995







-
-
+
-
-
-








/*
 *----------------------------------------------------------------------------
 * Forward declarations of Tcl_HashTable and related types.
 */

#ifndef TCL_HASH_TYPE
#if TCL_MAJOR_VERSION > 8
#  define TCL_HASH_TYPE size_t
#define TCL_HASH_TYPE size_t
#else
#  define TCL_HASH_TYPE unsigned
#endif
#endif

typedef struct Tcl_HashKeyType Tcl_HashKeyType;
typedef struct Tcl_HashTable Tcl_HashTable;
typedef struct Tcl_HashEntry Tcl_HashEntry;

typedef TCL_HASH_TYPE (Tcl_HashKeyProc) (Tcl_HashTable *tablePtr, void *keyPtr);
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1106
1107
1108
1109
1110
1111
1112

1113

1114
1115
1116



1117
1118
1119
1120
1121
1122
1123







-

-



-
-
-







				 * avoid mallocs and frees). */
    Tcl_Size numBuckets;	/* Total number of buckets allocated at
				 * **bucketPtr. */
    Tcl_Size numEntries;	/* Total number of entries present in
				 * table. */
    Tcl_Size rebuildSize;	/* Enlarge table when numEntries gets to be
				 * this large. */
#if TCL_MAJOR_VERSION > 8
    size_t mask;		/* Mask value used in hashing function. */
#endif
    int downShift;		/* Shift count used in hashing function.
				 * Designed to use high-order bits of
				 * randomized keys. */
#if TCL_MAJOR_VERSION < 9
    int mask;			/* Mask value used in hashing function. */
#endif
    int keyType;		/* Type of keys used in this table. It's
				 * either TCL_CUSTOM_KEYS, TCL_STRING_KEYS,
				 * TCL_ONE_WORD_KEYS, or an integer giving the
				 * number of ints that is the size of the
				 * key. */
    Tcl_HashEntry *(*findProc) (Tcl_HashTable *tablePtr, const char *key);
    Tcl_HashEntry *(*createProc) (Tcl_HashTable *tablePtr, const char *key,
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321


1322
1323
1324
1325
1326
1327
1328
1227
1228
1229
1230
1231
1232
1233

1234





1235
1236
1237
1238
1239
1240
1241
1242
1243







-

-
-
-
-
-
+
+







/*
 * The following structure keeps is used to hold a time value, either as an
 * absolute time (the number of seconds from the epoch) or as an elapsed time.
 * On Unix systems the epoch is Midnight Jan 1, 1970 GMT.
 */

typedef struct Tcl_Time {
#if TCL_MAJOR_VERSION > 8
    long long sec;		/* Seconds. */
#else
    long sec;			/* Seconds. */
#endif
#if defined(_CYGWIN_) && TCL_MAJOR_VERSION > 8
    int usec;			/* Microseconds. */
#if defined(_WIN32) && defined(_WIN64)
    int usec;		/* Microseconds. */
#else
    long usec;			/* Microseconds. */
#endif
} Tcl_Time;

typedef void (Tcl_SetTimerProc) (const Tcl_Time *timePtr);
typedef int (Tcl_WaitForEventProc) (const Tcl_Time *timePtr);
1364
1365
1366
1367
1368
1369
1370
1371
1372

1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1279
1280
1281
1282
1283
1284
1285


1286



1287
1288
1289
1290
1291
1292
1293







-
-
+
-
-
-







#define TCL_CLOSE_WRITE		(1<<2)

/*
 * Value to use as the closeProc for a channel that supports the close2Proc
 * interface.
 */

#if TCL_MAJOR_VERSION > 8
#   define TCL_CLOSE2PROC		NULL
#define TCL_CLOSE2PROC		NULL
#else
#   define TCL_CLOSE2PROC		((void *) 1)
#endif

/*
 * Channel version tag. This was introduced in 8.3.2/8.4.
 */

#define TCL_CHANNEL_VERSION_5	((Tcl_ChannelTypeVersion) 0x5)

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
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







-




-


















-
-
-







				 * malloc-ed space if command exceeds space in
				 * staticTokens. */
    Tcl_Size numTokens;		/* Total number of tokens in command. */
    Tcl_Size tokensAvailable;	/* Total number of tokens available at
				 * *tokenPtr. */
    int errorType;		/* One of the parsing error types defined
				 * above. */
#if TCL_MAJOR_VERSION > 8
    int incomplete;		/* This field is set to 1 by Tcl_ParseCommand
				 * if the command appears to be incomplete.
				 * This information is used by
				 * Tcl_CommandComplete. */
#endif

    /*
     * The fields below are intended only for the private use of the parser.
     * They should not be used by functions that invoke Tcl_ParseCommand.
     */

    const char *string;		/* The original command string passed to
				 * Tcl_ParseCommand. */
    const char *end;		/* Points to the character just after the last
				 * one in the command string. */
    Tcl_Interp *interp;		/* Interpreter to use for error reporting, or
				 * NULL. */
    const char *term;		/* Points to character in string that
				 * terminated most recent token. Filled in by
				 * ParseTokens. If an error occurs, points to
				 * beginning of region where the error
				 * occurred (e.g. the open brace if the close
				 * brace is missing). */
#if TCL_MAJOR_VERSION < 9
    int incomplete;
#endif
    Tcl_Token staticTokens[NUM_STATIC_TOKENS];
				/* Initial space for tokens for command. This
				 * space should be large enough to accommodate
				 * most commands; dynamic space is allocated
				 * for very large commands that don't fit
				 * here. */
} Tcl_Parse;
1998
1999
2000
2001
2002
2003
2004
2005

2006
2007
2008
2009
2010
2011
2012
1904
1905
1906
1907
1908
1909
1910

1911
1912
1913
1914
1915
1916
1917
1918







-
+







 *				block in a (potentially multi-block) input
 *				stream. Tells the conversion routine to
 *				perform any finalization that needs to occur
 *				after the last byte is converted and then to
 *				reset to an initial state. If the source
 *				buffer contains the entire input stream to be
 *				converted, this flag should be set.
 * TCL_ENCODING_STOPONERROR -	Not used any more.
 * TCL_ENCODING_STOPONERROR -	Obsolete.
 * TCL_ENCODING_NO_TERMINATE -	If set, Tcl_ExternalToUtf does not append a
 *				terminating NUL byte.  Since it does not need
 *				an extra byte for a terminating NUL, it fills
 *				all dstLen bytes with encoded UTF-8 content if
 *				needed.  If clear, a byte is reserved in the
 *				dst space for NUL termination, and a
 *				terminating NUL is appended.
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
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







-
-
+
-
-
-









-
+







 * NOTE: THESE BIT DEFINITIONS SHOULD NOT OVERLAP WITH INTERNAL USE BITS
 * DEFINED IN tclEncoding.c (ENCODING_INPUT et al). Be cognizant of this
 * when adding bits.
 */

#define TCL_ENCODING_START		0x01
#define TCL_ENCODING_END		0x02
#if TCL_MAJOR_VERSION > 8
#   define TCL_ENCODING_STOPONERROR	0x0 /* Not used any more */
#define TCL_ENCODING_STOPONERROR	0x0 /* Not used any more */
#else
#   define TCL_ENCODING_STOPONERROR	0x04
#endif
#define TCL_ENCODING_NO_TERMINATE	0x08
#define TCL_ENCODING_CHAR_LIMIT		0x10
/* Internal use bits, do not define bits in this space. See above comment */
#define TCL_ENCODING_INTERNAL_USE_MASK  0xFF00
/*
 * Reserve top byte for profile values (disjoint, not a mask). In case of
 * changes, ensure ENCODING_PROFILE_* macros in tclInt.h are modified if
 * necessary.
 */
#define TCL_ENCODING_PROFILE_STRICT   TCL_ENCODING_STOPONERROR
#define TCL_ENCODING_PROFILE_STRICT   0x00000000
#define TCL_ENCODING_PROFILE_TCL8     0x01000000
#define TCL_ENCODING_PROFILE_REPLACE  0x02000000

/*
 * The following definitions are the error codes returned by the conversion
 * routines:
 *
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
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







-

-
-
-







-
-
-
-
-
-
+
+
+
+
+

-
-
-
-
-







 * Unicode character in UTF-8. The valid values are 3 and 4. If > 3,
 * then Tcl_UniChar must be 4-bytes in size (UCS-4) (the default). If == 3,
 * then Tcl_UniChar must be 2-bytes in size (UTF-16). Since Tcl 9.0, UCS-4
 * mode is the default and recommended mode.
 */

#ifndef TCL_UTF_MAX
#   if TCL_MAJOR_VERSION > 8
#	define TCL_UTF_MAX		4
#   else
#	define TCL_UTF_MAX		3
#   endif
#endif

/*
 * This represents a Unicode character. Any changes to this should also be
 * reflected in regcustom.h.
 */

#if TCL_UTF_MAX == 4
    /*
     * int isn't 100% accurate as it should be a strict 4-byte value
     * (perhaps int32_t). ILP64/SILP64 systems may have troubles. The
     * size of this value must be reflected correctly in regcustom.h.
     */
/*
 * int isn't 100% accurate as it should be a strict 4-byte value
 * (perhaps int32_t). ILP64/SILP64 systems may have troubles. The
 * size of this value must be reflected correctly in regcustom.h.
 */
typedef int Tcl_UniChar;
#elif TCL_UTF_MAX == 3 && !defined(BUILD_tcl)
typedef unsigned short Tcl_UniChar;
#else
#   error "This TCL_UTF_MAX value is not supported"
#endif

/*
 *----------------------------------------------------------------------------
 * TIP #59: The following structure is used in calls 'Tcl_RegisterConfig' to
 * provide the system with the embedded configuration data.
 */

2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2025
2026
2027
2028
2029
2030
2031

2032



2033
2034
2035
2036
2037
2038
2039







-

-
-
-








/*
 * Structure containing information about a limit handler to be called when a
 * command- or time-limit is exceeded by an interpreter.
 */

typedef void (Tcl_LimitHandlerProc) (void *clientData, Tcl_Interp *interp);
#if TCL_MAJOR_VERSION > 8
#define Tcl_LimitHandlerDeleteProc Tcl_FreeProc
#else
typedef void (Tcl_LimitHandlerDeleteProc) (void *clientData);
#endif

#if 0
/*
 *----------------------------------------------------------------------------
 * We would like to provide an anonymous structure "mp_int" here, which is
 * compatible with libtommath's "mp_int", but without duplicating anything
 * from <tommath.h> or including <tommath.h> here. But the libtommath project
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
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







+















-
-
+
-
-
-







/*
 * Constants for special Tcl_Size-typed values, see TIP #494
 */

#define TCL_IO_FAILURE	((Tcl_Size)-1)
#define TCL_AUTO_LENGTH	((Tcl_Size)-1)
#define TCL_INDEX_NONE  ((Tcl_Size)-1)
#define TCL_LENGTH_NONE  ((Tcl_Size)-1)

/*
 *----------------------------------------------------------------------------
 * Single public declaration for NRE.
 */

typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp,
				int result);

/*
 *----------------------------------------------------------------------------
 * The following constant is used to test for older versions of Tcl in the
 * stubs tables.
 */

#if TCL_MAJOR_VERSION > 8
#   define TCL_STUB_MAGIC	((int) 0xFCA3BACB + (int) sizeof(void *))
#define TCL_STUB_MAGIC		((int) 0xFCA3BACB + (int) sizeof(void *))
#else
#   define TCL_STUB_MAGIC	((int) 0xFCA3BACF)
#endif

/*
 * The following function is required to be defined in all stubs aware
 * extensions. The function is actually implemented in the stub library, not
 * the main Tcl library, although there is a trivial implementation in the
 * main library in case an extension is statically linked into an application.
 */
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
+











-
-
-
-
-
+







#if defined(_WIN32)
    TCL_NORETURN void	Tcl_ConsolePanic(const char *format, ...);
#else
#   define Tcl_ConsolePanic ((Tcl_PanicProc *)NULL)
#endif

#ifdef USE_TCL_STUBS
#if TCL_MAJOR_VERSION < 9
# if TCL_UTF_MAX < 4
#   define Tcl_InitStubs(interp, version, exact) \
	(Tcl_InitStubs)(interp, version, \
	    (exact)|(TCL_MAJOR_VERSION<<8)|(0xFF<<16), \
	    TCL_STUB_MAGIC)
# else
#   define Tcl_InitStubs(interp, version, exact) \
	(Tcl_InitStubs)(interp, "8.7b1", \
	    (exact)|(TCL_MAJOR_VERSION<<8)|(0xFF<<16), \
	    TCL_STUB_MAGIC)
# endif
#elif TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
#   define Tcl_InitStubs(interp, version, exact) \
	(Tcl_InitStubs)(interp, version, \
	    (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
	    TCL_STUB_MAGIC)
#else
#   define Tcl_InitStubs(interp, version, exact) \
	(Tcl_InitStubs)(interp, (((exact)&1) ? (version) : "9.0b3"), \
	    (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
	    TCL_STUB_MAGIC)
#endif
#else
#if TCL_MAJOR_VERSION < 9
#   define Tcl_InitStubs(interp, version, exact) \
	Tcl_Panic(((void)interp, (void)version, \
		(void)exact, "Please define -DUSE_TCL_STUBS"))
#elif TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
#   define Tcl_InitStubs(interp, version, exact) \
	Tcl_PkgInitStubsCheck(interp, version, \
		(exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16))
#else
#   define Tcl_InitStubs(interp, version, exact) \
	Tcl_PkgInitStubsCheck(interp, TCL_PATCH_LEVEL, \
		1|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16))
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
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







-
-
-














-
+







EXTERN const char *	Tcl_SetPreInitScript(const char *string);
EXTERN const char *	Tcl_SetPanicProc(
			    Tcl_PanicProc *panicProc);
EXTERN void		Tcl_StaticLibrary(Tcl_Interp *interp,
			    const char *prefix,
			    Tcl_LibraryInitProc *initProc,
			    Tcl_LibraryInitProc *safeInitProc);
#ifndef TCL_NO_DEPRECATED
#   define Tcl_StaticPackage Tcl_StaticLibrary
#endif
EXTERN Tcl_ExitProc *	Tcl_SetExitProc(Tcl_ExitProc *proc);
#ifdef _WIN32
EXTERN const char *	TclZipfs_AppHook(int *argc, wchar_t ***argv);
#else
EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv);
#endif
#if defined(_WIN32) && defined(UNICODE)
#ifndef USE_TCL_STUBS
#   define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg)))
#endif
#   define Tcl_MainEx Tcl_MainExW
    EXTERN TCL_NORETURN void Tcl_MainExW(Tcl_Size argc, wchar_t **argv,
	    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
#endif
#if defined(USE_TCL_STUBS) && (TCL_MAJOR_VERSION > 8)
#if defined(USE_TCL_STUBS)
#define Tcl_SetPanicProc(panicProc) \
    TclInitStubTable(((const char *(*)(Tcl_PanicProc *))TclStubCall((void *)panicProc))(panicProc))
#define Tcl_InitSubsystems() \
    TclInitStubTable(((const char *(*)(void))TclStubCall((void *)1))())
#define Tcl_FindExecutable(argv0) \
    TclInitStubTable(((const char *(*)(const char *))TclStubCall((void *)2))(argv0))
#define TclZipfs_AppHook(argcp, argvp) \
2426
2427
2428
2429
2430
2431
2432

















































































































































































2433
2434
2435
2436
2437
2438
2439
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	((Tcl_ExitProc *(*)(Tcl_ExitProc *))TclStubCall((void *)7))(proc)
#define Tcl_GetMemoryInfo(dsPtr) \
	(void)((const char *(*)(Tcl_DString *))TclStubCall((void *)8))(dsPtr)
#define Tcl_SetPreInitScript(string) \
	((const char *(*)(const char *))TclStubCall((void *)9))(string)
#endif




/*
 *----------------------------------------------------------------
 * Object interface data structures and macros
 *----------------------------------------------------------------
 */


#define tclObjTypeInterfaceArgsListAll \
    Tcl_Interp *interp,	/* Used to report errors if not NULL. */ \
    Tcl_Obj *listPtr,	/* List object for which an element array \
			 *  is to be returned. */ \
    Tcl_Size *objcPtr,	/* Where to store the count of objects \
			 * referenced by objv. */ \
    Tcl_Obj ***objvPtr	/* Where to store the pointer to an \
			 * array of */

#define tclObjTypeInterfaceArgsListAppend \
    Tcl_Interp *interp,	/* Used to report errors if not NULL. */ \
    Tcl_Obj *listPtr,	/* List object to append objPtr to. */ \
    Tcl_Obj *objPtr	/* Object to append to listPtr's list. */

#define tclObjTypeInterfaceArgsListAppendList \
    Tcl_Interp *interp,	    /* Used to report errors if not NULL. */ \
    Tcl_Obj *listPtr,	    /* List object to append elements to. */ \
    Tcl_Obj *elemListPtr    /* List obj with elements to append. */

#define tclObjTypeInterfaceArgsListContains \
    Tcl_Interp *interp,	    /* Used to report errors if not NULL. */ \
    Tcl_Obj *listPtr,	    /* List object to append elements to. */ \
    Tcl_Obj *givenPtr,	    /* Value to search for. */ \
    int *resPtr				/* Location to store the result in. */ \

#define tclObjTypeInterfaceArgsListIndex \
    Tcl_Interp *interp,	/* Used to report errors if not NULL. */ \
    Tcl_Obj *listPtr,	/* List object to index into. */ \
    Tcl_Size index,	/* Index of element to return. */ \
    Tcl_Obj **resPtrPtr	/* The resulting Tcl_Obj* is stored here. */

#define tclObjTypeInterfaceArgsListIndexEnd \
    Tcl_Interp *interp,	/* Used to report errors if not NULL. */ \
    Tcl_Obj *listPtr,	/* List object to index into. */ \
    Tcl_Size index,	/* Index of element to return. */ \
    Tcl_Obj **resPtrPtr	/* The resulting Tcl_Obj* is stored here. */

#define tclObjTypeInterfaceArgsListIsSorted \
    Tcl_Interp * interp, /* Used to report errors */ \
    Tcl_Obj *listPtr,	/* The list in question */ \
    size_t flags	/* flags */

#define tclObjTypeInterfaceArgsListLength \
    Tcl_Interp *interp,	/* Used to report errors if not NULL. */ \
    Tcl_Obj *listPtr,	/* List object whose #elements to return. */ \
    Tcl_Size *lenPtr	/* The resulting length is stored here. */

#define tclObjTypeInterfaceArgsListRange \
    Tcl_Interp *interp,    /* Used to report errors */ \
    Tcl_Obj *listPtr,	    /* List object to take a range from. */ \
    Tcl_Size fromIdx,		/* Index of first element to */ \
							/* include. */ \
    Tcl_Size toIdx,			/* Index of last element to include. */ \
    Tcl_Obj **resPtrPtr		/* The resulting Tcl_Obj* is stored here. */

#define tclObjTypeInterfaceArgsListRangeEnd \
    Tcl_Interp * interp, /* Used to report errors */ \
    Tcl_Obj *listPtr,	/* List object to take a range from. */ \
    Tcl_Size fromAnchor,/* 0 for start and 1 for end */ \
    Tcl_Size fromIdx,	/* Index of first element to include. */ \
    Tcl_Size toAnchor,	/* 0 for start and 1 for end */  \
    Tcl_Size toIdx,	/* Index of last element to include. */ \
    Tcl_Obj **resPtrPtr	/* The resulting Tcl_Obj* is stored here. */

#define tclObjTypeInterfaceArgsListReplace \
    Tcl_Interp *interp, /* Used for error reporting if not NULL. */ \
    Tcl_Obj *listObj,   /* List object whose elements to replace. */ \
    Tcl_Size first,     /* Index of first element to replace. */ \
    Tcl_Size numToDelete,	/* Number of elements to replace. */ \
    Tcl_Size numToInsert,	/* Number of objects to insert. */ \
			/* An array of objc pointers to Tcl \
			 * objects to insert. */ \
    Tcl_Obj *const insertObjs[]

#define tclObjTypeInterfaceArgsListReplaceList \
   Tcl_Interp *interp, /* Used for error reporting if not NULL. */ \
    Tcl_Obj *listPtr,   /* List object whose elements to replace. */ \
    Tcl_Size first,     /* Index of first element to replace. */ \
    Tcl_Size count,	/* Number of elements to replace. */ \
    Tcl_Obj *newItemsPtr /* a list of new items to insert */

#define tclObjTypeInterfaceArgsListReverse \
    Tcl_Interp *interp, /* Used for error reporting if not NULL. */ \
    Tcl_Obj *listPtr   /* List object whose elements to replace. */ \


#define tclObjTypeInterfaceArgsListSet \
    Tcl_Interp *interp,		/* Tcl interpreter; used for error reporting \
				 * if not NULL. */ \
    Tcl_Obj *listObj,		/* List object in which element should be \
				 * stored. */ \
    Tcl_Size index,		/* Index of element to store. */ \
    Tcl_Obj *valueObj		/* Tcl object to store in the designated list \
				 * element. */


#define tclObjTypeInterfaceArgsListSetDeep \
    Tcl_Interp *interp,	    /* Tcl interpreter. */ \
    Tcl_Obj *listObj,	    /* Pointer to the list being modified. */ \
    Tcl_Size indexCount,    /* Number of index args. */ \
    Tcl_Obj *const indexArray[],    /* Index args. */ \
    Tcl_Obj *valueObj,	    /* Value arg to 'lset' or NULL to 'lpop'. */ \
	Tcl_Obj **resPtrPtr		/* An address at which to store the resulting list */


#define tclObjTypeInterfaceArgsStringIndex \
    Tcl_Interp *interp,	    \
    Tcl_Obj *objPtr,	    \
    Tcl_Size index,	\
    Tcl_Obj **resPtrPtr	/* The resulting Tcl_Obj* is stored here. */


#define tclObjTypeInterfaceArgsStringIndexEnd \
    Tcl_Interp *interp,	    \
    Tcl_Obj *objPtr,	    \
    Tcl_Size index,	\
    Tcl_Obj **resPtrPtr	/* The resulting Tcl_Obj* is stored here. */


#define tclObjTypeInterfaceArgsStringLength \
    Tcl_Obj *listPtr, \
    Tcl_Size *lengthPtr	/* An address at which to store the length. */


#define tclObjTypeInterfaceArgsStringIsEmpty \
	Tcl_Interp *interp,	\
    Tcl_Obj *listPtr,	\
	int *res


#define tclObjTypeInterfaceArgsStringRange \
    Tcl_Obj *objPtr,	/* The Tcl object to find the range of. */ \
    Tcl_Size first,	/* First index of the range. */ \
    Tcl_Size last,	/* Last index of the range. */ \
    Tcl_Obj **resPtrPtr	/* The resulting Tcl_Obj* is stored here. */


#define tclObjTypeInterfaceArgsStringRangeEnd \
    Tcl_Obj *objPtr,	/* The Tcl object to find the range of. */ \
    Tcl_Size first,	/* First index of the range. */ \
    Tcl_Size last,	/* Last index of the range. */ \
    Tcl_Obj **resPtrPtr	/* The resulting Tcl_Obj* is stored here. */

typedef int (Tcl_ObjInterfaceListAllProc)(tclObjTypeInterfaceArgsListAll);
typedef int (Tcl_ObjInterfaceListAppendProc)(tclObjTypeInterfaceArgsListAppend);
typedef int (Tcl_ObjInterfaceListAppendlistProc)(tclObjTypeInterfaceArgsListAppendList);
typedef int (Tcl_ObjInterfaceListContainsProc)(tclObjTypeInterfaceArgsListContains);
typedef int (Tcl_ObjInterfaceListIndexProc)(tclObjTypeInterfaceArgsListIndex);
typedef int (Tcl_ObjInterfaceListIndexEndProc)(tclObjTypeInterfaceArgsListIndexEnd);
typedef int (Tcl_ObjInterfaceListIsSortedProc)(tclObjTypeInterfaceArgsListIsSorted);
typedef int (Tcl_ObjInterfaceListLengthProc)(tclObjTypeInterfaceArgsListLength);
typedef int (Tcl_ObjInterfaceListRangeProc)(tclObjTypeInterfaceArgsListRange);
typedef int (Tcl_ObjInterfaceListRangeEndProc)(tclObjTypeInterfaceArgsListRangeEnd);
typedef int (Tcl_ObjInterfaceListReplaceProc)(tclObjTypeInterfaceArgsListReplace);
typedef int (Tcl_ObjInterfaceListReplaceListProc)(tclObjTypeInterfaceArgsListReplaceList);
typedef int (Tcl_ObjInterfaceListReverseProc)(tclObjTypeInterfaceArgsListReverse);
typedef int (Tcl_ObjInterfaceListSetProc)(tclObjTypeInterfaceArgsListSet);
typedef int (Tcl_ObjInterfaceListSetDeepProc)(tclObjTypeInterfaceArgsListSetDeep);

typedef int (Tcl_ObjInterfaceStringIndexProc)(tclObjTypeInterfaceArgsStringIndex);
typedef int (Tcl_ObjInterfaceStringIndexEndProc)(tclObjTypeInterfaceArgsStringIndexEnd);
typedef int (Tcl_ObjInterfaceStringIsEmptyProc)(tclObjTypeInterfaceArgsStringIsEmpty);
typedef int (Tcl_ObjInterfaceStringLengthProc)(tclObjTypeInterfaceArgsStringLength);
typedef int (Tcl_ObjInterfaceStringRangeProc)(tclObjTypeInterfaceArgsStringRange);
typedef int (Tcl_ObjInterfaceStringRangeEndProc)(tclObjTypeInterfaceArgsStringRangeEnd);


/*
 *----------------------------------------------------------------------------
 * Include the public function declarations that are accessible via the stubs
 * table.
 */

#include "tclDecls.h"
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
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







-
-
-
+
+
+




















-
+







 */

#ifndef BUILD_tcl
#   define ckalloc Tcl_Alloc
#   define attemptckalloc Tcl_AttemptAlloc
#   ifdef _MSC_VER
	/* Silence invalid C4090 warnings */
#	define ckfree(a) Tcl_Free((void *)(a))
#	define ckrealloc(a,b) Tcl_Realloc((void *)(a),(b))
#	define attemptckrealloc(a,b) Tcl_AttemptRealloc((void *)(a),(b))
#	define ckfree(a)		Tcl_Free((void *)(a))
#	define ckrealloc(a, b)		Tcl_Realloc((void *)(a), (b))
#	define attemptckrealloc(a, b)	Tcl_AttemptRealloc((void *)(a), (b))
#   else
#	define ckfree Tcl_Free
#	define ckrealloc Tcl_Realloc
#	define attemptckrealloc Tcl_AttemptRealloc
#   endif
#endif

#ifndef TCL_MEM_DEBUG

/*
 * If we are not using the debugging allocator, we should call the Tcl_Alloc,
 * et al. routines in order to guarantee that every module is using the same
 * memory allocator both inside and outside of the Tcl library.
 */

#   undef  Tcl_InitMemory
#   define Tcl_InitMemory(x)
#   undef  Tcl_DumpActiveMemory
#   define Tcl_DumpActiveMemory(x)
#   undef  Tcl_ValidateAllMemory
#   define Tcl_ValidateAllMemory(x,y)
#   define Tcl_ValidateAllMemory(x, y)

#endif /* !TCL_MEM_DEBUG */

#ifdef TCL_MEM_DEBUG
#   undef Tcl_IncrRefCount
#   define Tcl_IncrRefCount(objPtr) \
	Tcl_DbIncrRefCount(objPtr, __FILE__, __LINE__)
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
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







+








+
+










#define Tcl_FindHashEntry(tablePtr, key) \
	(*((tablePtr)->findProc))(tablePtr, (const char *)(key))
#undef  Tcl_CreateHashEntry
#define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
	(*((tablePtr)->createProc))(tablePtr, (const char *)(key), newPtr)

#endif /* RC_INVOKED */


/*
 * end block for C++
 */

#ifdef __cplusplus
}
#endif



#endif /* _TCL */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclAlloc.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
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

-
-
-
-
-
-
-









+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclAlloc.c --
 *
 *	This is a very fast storage allocator. It allocates blocks of a small
 *	number of different sizes, and keeps free lists of each size. Blocks
 *	that don't exactly fit are passed up to the next larger size. Blocks
 *	over a certain size are directly allocated from the system.
 *
 * Copyright © 1983 Regents of the University of California.
 * Copyright © 1996-1997 Sun Microsystems, Inc.
 * Copyright © 1998-1999 Scriptics Corporation.
 *
 * Portions contributed by Chris Kingsley, Jack Jansen and Ray Johnson.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclAlloc.c --
 *
 *	This is a very fast storage allocator. It allocates blocks of a small
 *	number of different sizes, and keeps free lists of each size. Blocks
 *	that don't exactly fit are passed up to the next larger size. Blocks
 *	over a certain size are directly allocated from the system.
 *
*/

/*
 * Windows and Unix use an alternative allocator when building with threads
 * that has significantly reduced lock contention.
 */

#include "tclInt.h"
301
302
303
304
305
306
307
308

309
310
311
312
313
314
315
313
314
315
316
317
318
319

320
321
322
323
324
325
326
327







-
+








	overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
	overPtr->rangeCheckMagic = RMAGIC;
	BLOCK_END(overPtr) = RMAGIC;
#endif

	Tcl_MutexUnlock(allocMutexPtr);
	return (void *)(overPtr+1);
	return (void *)(overPtr + 1);
    }

    /*
     * Convert amount of memory requested into closest block size stored in
     * hash buckets which satisfies request. Account for space used per block
     * for accounting.
     */
577
578
579
580
581
582
583
584

585
586
587
588
589
590
591
589
590
591
592
593
594
595

596
597
598
599
600
601
602
603







-
+







	 */

	overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
	BLOCK_END(overPtr) = RMAGIC;
#endif

	Tcl_MutexUnlock(allocMutexPtr);
	return (void *)(overPtr+1);
	return (void *)(overPtr + 1);
    }
    maxSize = (size_t)1 << (i+3);
    expensive = 0;
    if (numBytes+OVERHEAD > maxSize) {
	expensive = 1;
    } else if (i>0 && numBytes+OVERHEAD < maxSize/2) {
	expensive = 1;
691
692
693
694
695
696
697
698

699
700
701
702
703
704
705
703
704
705
706
707
708
709

710
711
712
713
714
715
716
717







-
+







 *
 *----------------------------------------------------------------------
 */

#undef TclpAlloc
void *
TclpAlloc(
    size_t numBytes)	/* Number of bytes to allocate. */
    size_t numBytes)		/* Number of bytes to allocate. */
{
    return malloc(numBytes);
}

/*
 *----------------------------------------------------------------------
 *
Changes to generic/tclArithSeries.c.
1
2
3
4
5
6
7
8
9
10
11
12












13
14
15
16
17
18
19
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












+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclArithSeries.c --
 *
 *     This file contains the ArithSeries concrete abstract list
 *     implementation. It implements the inner workings of the lseq command.
 *
 * Copyright © 2022 Brian S. Griffin.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * Copyright © 2024 Nathan Coulter
 *
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

#include "tcl.h"
#include "tclInt.h"
#include <assert.h>
#include <math.h>

/*
 * The structure below defines the arithmetic series Tcl object type by
 * means of procedures that can be invoked by generic object code.
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
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







-
-
+
+
-
-
-
+
+
-
-
-
+
-
-
-
-
+
+
+






-
-
-
-
-



+
+
+
+
-
-
-
-
-
+
+
+
+
+

+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-












-
+







    double end;
    double step;
    unsigned precision;		/* Number of decimal places to render. */
} ArithSeriesDbl;

/* Forward declarations. */

static int		TclArithSeriesObjIndex(TCL_UNUSED(Tcl_Interp *),
			    Tcl_Obj *arithSeriesObj, Tcl_Size index,
static Tcl_ObjInterfaceListContainsProc	ArithSeriesInOperation;
static Tcl_ObjInterfaceListIndexProc	ArithSeriesObjIndex;
			    Tcl_Obj **elemObj);
static Tcl_Size		ArithSeriesObjLength(Tcl_Obj *arithSeriesObj);
static int		TclArithSeriesObjRange(Tcl_Interp *interp,
static Tcl_ObjInterfaceListLengthProc	ArithSeriesObjLength;
static Tcl_ObjInterfaceListRangeProc	ArithSeriesObjRange;
			    Tcl_Obj *arithSeriesObj, Tcl_Size fromIdx,
			    Tcl_Size toIdx, Tcl_Obj **newObjPtr);
static int		TclArithSeriesObjReverse(Tcl_Interp *interp,
static Tcl_ObjInterfaceListReverseProc	ArithSeriesObjReverse;
			    Tcl_Obj *arithSeriesObj, Tcl_Obj **newObjPtr);
static int		TclArithSeriesGetElements(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Tcl_Size *objcPtr,
			    Tcl_Obj ***objvPtr);
static Tcl_ObjInterfaceListAllProc	ArithSeriesGetElements;
static int		ArithSeriesObjStep(Tcl_Obj *arithSeriesObj,
			    Tcl_Obj **stepObj);
static void		DupArithSeriesInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static void		FreeArithSeriesInternalRep(Tcl_Obj *arithSeriesObjPtr);
static void		UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObjPtr);
static int		SetArithSeriesFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
static int		ArithSeriesInOperation(Tcl_Interp *interp,
			    Tcl_Obj *valueObj, Tcl_Obj *arithSeriesObj,
			    int *boolResult);
static int		TclArithSeriesObjStep(Tcl_Obj *arithSeriesObj,
			    Tcl_Obj **stepObj);

/* ------------------------ ArithSeries object type -------------------------- */


static int ArithSeriesObjStep(Tcl_Obj *arithSeriesObj, Tcl_Obj **stepObj);


static const Tcl_ObjType arithSeriesType = {
    "arithseries",			/* name */
    FreeArithSeriesInternalRep,		/* freeIntRepProc */
    DupArithSeriesInternalRep,		/* dupIntRepProc */
    UpdateStringOfArithSeries,		/* updateStringProc */
static ObjectType arithSeriesType = {
    "arithseries",
    FreeArithSeriesInternalRep,	/* freeIntRepProc */
    DupArithSeriesInternalRep,	/* dupIntRepProc */
    UpdateStringOfArithSeries,	/* updateStringProc */
    SetArithSeriesFromAny,		/* setFromAnyProc */
    2,
    NULL
};
    TCL_OBJTYPE_V2(
    ArithSeriesObjLength,
    TclArithSeriesObjIndex,
    TclArithSeriesObjRange,
    TclArithSeriesObjReverse,
    TclArithSeriesGetElements,
    NULL, // SetElement
    NULL, // Replace


void TclArithSeriesInit(void) {
    Tcl_ObjInterface *oiPtr;
    oiPtr = Tcl_NewObjInterface();
    Tcl_ObjInterfaceSetFnListContains(oiPtr ,ArithSeriesInOperation);
    Tcl_ObjInterfaceSetFnListAll(oiPtr ,ArithSeriesGetElements);
    Tcl_ObjInterfaceSetFnListIndex(oiPtr ,ArithSeriesObjIndex);
    Tcl_ObjInterfaceSetFnListLength(oiPtr ,ArithSeriesObjLength);
    Tcl_ObjInterfaceSetFnListRange(oiPtr ,ArithSeriesObjRange);
    Tcl_ObjInterfaceSetFnListReverse(oiPtr ,ArithSeriesObjReverse);
    Tcl_ObjTypeSetInterface((Tcl_ObjType *)&arithSeriesType ,oiPtr);
	return;
}

    ArithSeriesInOperation) // "in" operator
};

/*
 * Helper functions
 *
 * - power10 -- Fast version of pow(10, (int) n) for common cases.
 * - ArithRound -- Round doubles to the number of significant fractional
 *                 digits
 * - ArithSeriesIndexDbl -- base list indexing operation for doubles
 * - ArithSeriesIndexInt --   "    "      "        "      "  integers
 * - ArithSeriesGetInternalRep -- Return the internal rep from a Tcl_Obj
 * - Precision -- determine the number of factional digits for the given
 *   double value
 * - maxPrecision -- Using the values provide, determine the longest percision
 * - maxPrecision -- Using the values provided, determine the longest precision
 *   in the arithSeries
 */

static inline double
power10(
    unsigned n)
{
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
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







-
+





-
+
-
-
-
+
+
-


+
-
+
-
-
+







    unsigned i = Precision(start);

    dp = i>dp ? i : dp;
    i  = Precision(end);
    dp = i>dp ? i : dp;
    return dp;
}


/*
 *----------------------------------------------------------------------
 *
 * ArithSeriesLen --
 *
 *	Compute the length of the equivalent list where
 *	Compute the length of the equivalent list where every element is generated
 *	every element is generated starting from *start*,
 *	and adding *step* to generate every successive element
 *	that's < *end* for positive steps, or > *end* for negative
 *	starting from *start*, and adding *step* to generate every successive
 *	element that's < *end* for positive steps, or > *end* for negative steps.
 *	steps.
 *
 * Results:
 *
 *	The length of the list generated by the given range,
 *	The length of the list generated by the given range, that may be zero.  The
 *	that may be zero.
 *	The function returns -1 if the list is of length infinite.
 *	function returns -1 if the list is of length infinite.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
static Tcl_WideInt
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
290
291
292
293
294
295
296



























































































297
298
299
300
301
302
303







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    istart = start * power10(precision);
    iend = end * power10(precision);
    istep = step * power10(precision);
    ilen = (iend - istart + istep) / istep;
    return floor(ilen);
}

/*
 *----------------------------------------------------------------------
 *
 * DupArithSeriesInternalRep --
 *
 *	Initialize the internal representation of a arithseries Tcl_Obj to a
 *	copy of the internal representation of an existing arithseries object.
 *	The copy does not share the cache of the elements.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	We set "copyPtr"s internal rep to a pointer to a
 *	newly allocated ArithSeries structure.
 *
 *----------------------------------------------------------------------
 */

static void
DupArithSeriesInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    ArithSeries *srcRepPtr = (ArithSeries *)
	    srcPtr->internalRep.twoPtrValue.ptr1;

    if (srcRepPtr->isDouble) {
	ArithSeriesDbl *srcDblPtr = (ArithSeriesDbl *) srcRepPtr;
	ArithSeriesDbl *copyDblPtr = (ArithSeriesDbl *)
		Tcl_Alloc(sizeof(ArithSeriesDbl));

	*copyDblPtr = *srcDblPtr;
	copyDblPtr->base.elements = NULL;
	copyPtr->internalRep.twoPtrValue.ptr1 = copyDblPtr;
    } else {
	ArithSeriesInt *srcIntPtr = (ArithSeriesInt *) srcRepPtr;
	ArithSeriesInt *copyIntPtr = (ArithSeriesInt *)
		Tcl_Alloc(sizeof(ArithSeriesInt));

	*copyIntPtr = *srcIntPtr;
	copyIntPtr->base.elements = NULL;
	copyPtr->internalRep.twoPtrValue.ptr1 = copyIntPtr;
    }
    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
    copyPtr->typePtr = &arithSeriesType;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeArithSeriesInternalRep --
 *
 *	Free any allocated memory in the ArithSeries Rep
 *
 * Results:
 *	None.
 *
 * Side effects:
 *
 *----------------------------------------------------------------------
 */

static inline void
FreeElements(
    ArithSeries *arithSeriesRepPtr)
{
    if (arithSeriesRepPtr->elements) {
	Tcl_WideInt i, len = arithSeriesRepPtr->len;

	for (i=0; i<len; i++) {
	    Tcl_DecrRefCount(arithSeriesRepPtr->elements[i]);
	}
	Tcl_Free((char *) arithSeriesRepPtr->elements);
	arithSeriesRepPtr->elements = NULL;
    }
}

static void
FreeArithSeriesInternalRep(
    Tcl_Obj *arithSeriesObjPtr)
{
    ArithSeries *arithSeriesRepPtr = (ArithSeries *)
	    arithSeriesObjPtr->internalRep.twoPtrValue.ptr1;

    if (arithSeriesRepPtr) {
	FreeElements(arithSeriesRepPtr);
	Tcl_Free((char *) arithSeriesRepPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * NewArithSeriesInt --
 *
 *	Creates a new ArithSeries object. The returned object has
 *	refcount = 0.
416
417
418
419
420
421
422
423

424
425
426
427
428
429
430
338
339
340
341
342
343
344

345
346
347
348
349
350
351
352







-
+







    arithSeriesRepPtr->base.elements = NULL;
    arithSeriesRepPtr->base.isDouble = 0;
    arithSeriesRepPtr->start = start;
    arithSeriesRepPtr->end = end;
    arithSeriesRepPtr->step = step;
    arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
    arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL;
    arithSeriesObj->typePtr = &arithSeriesType;
    arithSeriesObj->typePtr = (Tcl_ObjType *)&arithSeriesType;
    if (length > 0) {
	Tcl_InvalidateStringRep(arithSeriesObj);
    }

    return arithSeriesObj;
}

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
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







-
+














-
+







    arithSeriesRepPtr->base.isDouble = 1;
    arithSeriesRepPtr->start = start;
    arithSeriesRepPtr->end = end;
    arithSeriesRepPtr->step = step;
    arithSeriesRepPtr->precision = maxPrecision(start, end, step);
    arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
    arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL;
    arithSeriesObj->typePtr = &arithSeriesType;
    arithSeriesObj->typePtr = (Tcl_ObjType *)&arithSeriesType;

    if (length > 0) {
	Tcl_InvalidateStringRep(arithSeriesObj);
    }

    return arithSeriesObj;
}

/*
 *----------------------------------------------------------------------
 *
 * assignNumber --
 *
 *	Create the appropriate Tcl_Obj value for the given numeric values.
 *      Used locally only for decoding [lseq] numeric arguments.
 *	Used locally only for decoding [lseq] numeric arguments.
 *	refcount = 0.
 *
 * Results:
 *	A Tcl_Obj pointer.  No assignment on error.
 *
 * Side Effects:
 *	None.
541
542
543
544
545
546
547
548

549
550
551
552
553
554
555
463
464
465
466
467
468
469

470
471
472
473
474
475
476
477







-
+







/*
 *----------------------------------------------------------------------
 *
 * TclNewArithSeriesObj --
 *
 *	Creates a new ArithSeries object. Some arguments may be NULL and will
 *	be computed based on the other given arguments.
 *      refcount = 0.
 *	refcount = 0.
 *
 * Results:
 *	A Tcl_Obj pointer to the created ArithSeries object.
 *	NULL if the range is invalid.
 *
 * Side Effects:
 *	None.
626
627
628
629
630
631
632
633
634
635



636
637
638
639
640
641
642
548
549
550
551
552
553
554



555
556
557
558
559
560
561
562
563
564







-
-
-
+
+
+








    if (!endObj) {
	if (useDoubles) {
	    // Compute precision based on given command argument values
	    unsigned precision = maxPrecision(dstart, len, dstep);

	    dend = dstart + (dstep * (len-1));
	    // Make computed end value match argument(s) precision
	    dend = ArithRound(dend, precision);
	    end = dend;
            // Make computed end value match argument(s) precision
            dend = ArithRound(dend, precision);
            end = dend;
	} else {
	    end = start + (step * (len - 1));
	    dend = end;
	}
    }

    if (len > TCL_SIZE_MAX) {
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
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







-
+

-
-
+
+
-
-
-


+
-
+
+


-
-
+
+




-
+







	    : NewArithSeriesInt(start, end, step, len);
    return objPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjIndex --
 * ArithSeriesObjIndex --
 *
 *	Returns the element with the specified index in the list
 *	represented by the specified Arithmetic Sequence object.
 *	Stores in **resultPtr the element with the specified index in the list
 *	represented by the specified Arithmetic Sequence object. 
 *	If the index is out of range, TCL_ERROR is returned,
 *	otherwise TCL_OK is returned and the integer value of the
 *	element is stored in *element.
 *
 * Results:
 *
 *	TCL_OK on success.
 * 	On success, returns TCL_OK and stores the position of the element in
 * 	*element.  Returns TCL_ERROR if the given index is out of range.
 *
 * Side Effects:
 *	On success, the integer pointed by *element is modified.
 *	An empty string ("") is assigned if index is out-of-bounds.
 *	On success, stores the stores the position of the element in *elemObj,
 *	and on failure, stores the empty string ("").
 *
 *----------------------------------------------------------------------
 */
int
TclArithSeriesObjIndex(
ArithSeriesObjIndex(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Obj *arithSeriesObj,	/* List obj */
    Tcl_Size index,		/* index to element of interest */
    Tcl_Obj **elemObj)		/* Return value */
{
    ArithSeries *arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);

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
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







+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
+
+
+
+
+
+
+
+




-
+













-
-
+
+







 *	The length of the series as Tcl_WideInt.
 *
 * Side Effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
int ArithSeriesObjLength(TCL_UNUSED(Tcl_Interp *),
    Tcl_Obj *arithSeriesObj
Tcl_Size
ArithSeriesObjLength(
    Tcl_Obj *arithSeriesObj)
	,Tcl_Size *result)
{
    ArithSeries *arithSeriesRepPtr = (ArithSeries *)
	    arithSeriesObj->internalRep.twoPtrValue.ptr1;
    *result = arithSeriesRepPtr->len;
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * DupArithSeriesInternalRep --
 *
 *	Initialize the internal representation of a arithseries Tcl_Obj to a
 *	copy of the internal representation of an existing arithseries object.
 *	The copy does not share the cache of the elements.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	We set "copyPtr"s internal rep to a pointer to a
 *	newly allocated ArithSeries structure.
 *
 *----------------------------------------------------------------------
 */

static void
DupArithSeriesInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    ArithSeries *srcRepPtr = (ArithSeries *)
	    srcPtr->internalRep.twoPtrValue.ptr1;

    if (srcRepPtr->isDouble) {
	ArithSeriesDbl *srcDblPtr = (ArithSeriesDbl *) srcRepPtr;
	ArithSeriesDbl *copyDblPtr = (ArithSeriesDbl *)
		Tcl_Alloc(sizeof(ArithSeriesDbl));

	*copyDblPtr = *srcDblPtr;
	copyDblPtr->base.elements = NULL;
	copyPtr->internalRep.twoPtrValue.ptr1 = copyDblPtr;
    } else {
	ArithSeriesInt *srcIntPtr = (ArithSeriesInt *) srcRepPtr;
	ArithSeriesInt *copyIntPtr = (ArithSeriesInt *)
		Tcl_Alloc(sizeof(ArithSeriesInt));

	*copyIntPtr = *srcIntPtr;
	copyIntPtr->base.elements = NULL;
	copyPtr->internalRep.twoPtrValue.ptr1 = copyIntPtr;
    }
    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
    copyPtr->typePtr = (Tcl_ObjType *)&arithSeriesType;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeArithSeriesInternalRep --
 *
 *	Free any allocated memory in the ArithSeries Rep
 *
 * Results:
 *	None.
 *
 * Side effects:
 *
 *----------------------------------------------------------------------
 */

static inline void
FreeElements(
    ArithSeries *arithSeriesRepPtr)
{
    if (arithSeriesRepPtr->elements) {
	Tcl_WideInt i, len = arithSeriesRepPtr->len;

	for (i=0; i<len; i++) {
	    Tcl_DecrRefCount(arithSeriesRepPtr->elements[i]);
	}
	Tcl_Free((char *) arithSeriesRepPtr->elements);
	arithSeriesRepPtr->elements = NULL;
    }
}

static void
FreeArithSeriesInternalRep(
    Tcl_Obj *arithSeriesObjPtr)
{
    ArithSeries *arithSeriesRepPtr = (ArithSeries *)
	    arithSeriesObj->internalRep.twoPtrValue.ptr1;
    return arithSeriesRepPtr->len;
}
	    arithSeriesObjPtr->internalRep.twoPtrValue.ptr1;

    if (arithSeriesRepPtr) {
	FreeElements(arithSeriesRepPtr);
	Tcl_Free((char *) arithSeriesRepPtr);
    }
}


/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjStep --
 * ArithSeriesObjStep --
 *
 *	Return a Tcl_Obj with the step value from the give ArithSeries Obj.
 *	refcount = 0.
 *
 * Results:
 *	A Tcl_Obj pointer to the created ArithSeries object.
 *	A NULL pointer of the range is invalid.
 *
 * Side Effects:
 *	None.
 *----------------------------------------------------------------------
 */

int
TclArithSeriesObjStep(
static int
ArithSeriesObjStep(
    Tcl_Obj *arithSeriesObj,
    Tcl_Obj **stepObj)
{
    ArithSeries *arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);

    if (arithSeriesRepPtr->isDouble) {
	*stepObj = Tcl_NewDoubleObj(((ArithSeriesDbl *) arithSeriesRepPtr)->step);
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
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







-
-
+
+








-
+


-
+



-
+









-
-
-
+
+
+

-
-
+
+

















-
+













-
+

-
+

-
+





-
+







 *	Tcl Panic if called.
 *
 *----------------------------------------------------------------------
 */

static int
SetArithSeriesFromAny(
    TCL_UNUSED(Tcl_Interp *),		/* Used for error reporting if not NULL. */
    TCL_UNUSED(Tcl_Obj *))		/* The object to convert. */
    TCL_UNUSED(Tcl_Interp *),	/* Used for error reporting if not NULL. */
    TCL_UNUSED(Tcl_Obj *))	/* The object to convert. */
{
    Tcl_Panic("SetArithSeriesFromAny: should never be called");
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjRange --
 * ArithSeriesObjRange --
 *
 *	Makes a slice of an ArithSeries value.
 *      *arithSeriesObj must be known to be a valid list.
 *	*arithSeriesObj must be known to be a valid list.
 *
 * Results:
 *	Returns a pointer to the sliced series.
 *      This may be a new object or the same object if not shared.
 *	This may be a new object or the same object if not shared.
 *
 * Side effects:
 *	?The possible conversion of the object referenced by listPtr?
 *	?to a list object.?
 *
 *----------------------------------------------------------------------
 */

int
TclArithSeriesObjRange(
    Tcl_Interp *interp,         /* For error message(s) */
    Tcl_Obj *arithSeriesObj,	/* List object to take a range from. */
ArithSeriesObjRange(
    Tcl_Interp *interp,		/* For error message(s) */
    Tcl_Obj *arithSeriesObj,/* List object to take a range from. */
    Tcl_Size fromIdx,		/* Index of first element to include. */
    Tcl_Size toIdx,		/* Index of last element to include. */
    Tcl_Obj **newObjPtr)        /* return value */
    Tcl_Size toIdx,			/* Index of last element to include. */
    Tcl_Obj **resPtrPtr)	/* return value */
{
    ArithSeries *arithSeriesRepPtr;
    Tcl_Obj *startObj, *endObj, *stepObj;

    (void)interp; /* silence compiler */

    arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);

    if (fromIdx == TCL_INDEX_NONE) {
	fromIdx = 0;
    }

    if (toIdx >= arithSeriesRepPtr->len) {
	toIdx = arithSeriesRepPtr->len-1;
    }

    if (fromIdx > toIdx || fromIdx >= arithSeriesRepPtr->len) {
	TclNewObj(*newObjPtr);
	TclNewObj(*resPtrPtr);
	return TCL_OK;
    }

    if (fromIdx < 0) {
	fromIdx = 0;
    }
    if (toIdx < 0) {
	toIdx = 0;
    }
    if (toIdx > arithSeriesRepPtr->len - 1) {
	toIdx = arithSeriesRepPtr->len - 1;
    }

    TclArithSeriesObjIndex(interp, arithSeriesObj, fromIdx, &startObj);
    ArithSeriesObjIndex(interp, arithSeriesObj, fromIdx, &startObj);
    Tcl_IncrRefCount(startObj);
    TclArithSeriesObjIndex(interp, arithSeriesObj, toIdx, &endObj);
    ArithSeriesObjIndex(interp, arithSeriesObj, toIdx, &endObj);
    Tcl_IncrRefCount(endObj);
    TclArithSeriesObjStep(arithSeriesObj, &stepObj);
    ArithSeriesObjStep(arithSeriesObj, &stepObj);
    Tcl_IncrRefCount(stepObj);

    if (Tcl_IsShared(arithSeriesObj) || ((arithSeriesObj->refCount > 1))) {
	Tcl_Obj *newSlicePtr = TclNewArithSeriesObj(interp,
	    arithSeriesRepPtr->isDouble, startObj, endObj, stepObj, NULL);
	*newObjPtr = newSlicePtr;
	*resPtrPtr = newSlicePtr;
	Tcl_DecrRefCount(startObj);
	Tcl_DecrRefCount(endObj);
	Tcl_DecrRefCount(stepObj);
	return newSlicePtr ? TCL_OK : TCL_ERROR;
    }

    /*
893
894
895
896
897
898
899
900

901
902
903
904
905
906
907

908
909
910
911
912
913
914
908
909
910
911
912
913
914

915
916
917
918
919
920
921

922
923
924
925
926
927
928
929







-
+






-
+







	intRepPtr->base.len = ArithSeriesLenInt(start, end, step);
    }

    Tcl_DecrRefCount(startObj);
    Tcl_DecrRefCount(endObj);
    Tcl_DecrRefCount(stepObj);

    *newObjPtr = arithSeriesObj;
    *resPtrPtr = arithSeriesObj;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesGetElements --
 * ArithSeriesGetElements --
 *
 *	This function returns an (objc,objv) array of the elements in a list
 *	object.
 *
 * Results:
 *	The return value is normally TCL_OK; in this case *objcPtr is set to
 *	the count of list elements and *objvPtr is set to a pointer to an
927
928
929
930
931
932
933
934

935
936
937
938
939
940
941
942
943

944
945
946
947
948
949
950
942
943
944
945
946
947
948

949
950
951
952
953
954
955
956
957

958
959
960
961
962
963
964
965







-
+








-
+







 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclArithSeriesGetElements(
ArithSeriesGetElements(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *objPtr,		/* ArithSeries object for which an element
				 * array is to be returned. */
    Tcl_Size *objcPtr,		/* Where to store the count of objects
				 * referenced by objv. */
    Tcl_Obj ***objvPtr)		/* Where to store the pointer to an array of
				 * pointers to the list's objects. */
{
    if (TclHasInternalRep(objPtr, &arithSeriesType)) {
    if (TclHasInternalRep(objPtr,(Tcl_ObjType *)&arithSeriesType)) {
	ArithSeries *arithSeriesRepPtr = ArithSeriesGetInternalRep(objPtr);
	Tcl_Obj **objv;
	Tcl_Size objc = arithSeriesRepPtr->len;

	if (objc > 0) {
	    if (arithSeriesRepPtr->elements) {
		/* If this exists, it has already been populated */
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







-
+







		    }
		    return TCL_ERROR;
		}
		arithSeriesRepPtr->elements = objv;

		Tcl_Size i;
		for (i = 0; i < objc; i++) {
		    int status = TclArithSeriesObjIndex(interp, objPtr, i, &objv[i]);
		    int status = ArithSeriesObjIndex(interp, objPtr, i, &objv[i]);

		    if (status) {
			return TCL_ERROR;
		    }
		    Tcl_IncrRefCount(objv[i]);
		}
	    }
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
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







-
+






-
+


-
+




-
-
-
+
+
+
-
+



-






-
-
+
+







-
+

-
+

-
+
















-
-
-
-
-
-
-
-
-
-
-
-
-
+

-
-
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
+
-




-
-
+
+
-
-
+







    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjReverse --
 * ArithSeriesObjReverse --
 *
 *	Reverse the order of the ArithSeries value. The arithSeriesObj is
 *	assumed to be a valid ArithSeries. The new Obj has the Start and End
 *	values appropriately swapped and the Step value sign is changed.
 *
 * Results:
 *      The result will be an ArithSeries in the reverse order.
 *	The result will be an ArithSeries in the reverse order.
 *
 * Side effects:
 *      The ogiginal obj will be modified and returned if it is not Shared.
 *	The original obj will be modified and returned if it is not Shared.
 *
 *----------------------------------------------------------------------
 */
int
TclArithSeriesObjReverse(
    Tcl_Interp *interp,         /* For error message(s) */
    Tcl_Obj *arithSeriesObj,	/* List object to reverse. */
ArithSeriesObjReverse(
    Tcl_Interp *interp,		/* For error message(s) */
    Tcl_Obj *arithSeriesObj	/* List object to reverse. */
    Tcl_Obj **newObjPtr)
    )
{
    ArithSeries *arithSeriesRepPtr;
    Tcl_Obj *startObj, *endObj, *stepObj;
    Tcl_Obj *resultObj;
    Tcl_WideInt start, end, step, len;
    double dstart, dend, dstep;
    int isDouble;

    (void)interp;

    if (newObjPtr == NULL) {
	return TCL_ERROR;
    if (Tcl_IsShared(arithSeriesObj)) {
	Tcl_Panic("%s called with shared object", "ArithSeriesObjReverse");
    }

    arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);

    isDouble = arithSeriesRepPtr->isDouble;
    len = arithSeriesRepPtr->len;

    TclArithSeriesObjIndex(NULL, arithSeriesObj, len - 1, &startObj);
    ArithSeriesObjIndex(NULL, arithSeriesObj, len - 1, &startObj);
    Tcl_IncrRefCount(startObj);
    TclArithSeriesObjIndex(NULL, arithSeriesObj, 0, &endObj);
    ArithSeriesObjIndex(NULL, arithSeriesObj, 0, &endObj);
    Tcl_IncrRefCount(endObj);
    TclArithSeriesObjStep(arithSeriesObj, &stepObj);
    ArithSeriesObjStep(arithSeriesObj, &stepObj);
    Tcl_IncrRefCount(stepObj);

    if (isDouble) {
	Tcl_GetDoubleFromObj(NULL, startObj, &dstart);
	Tcl_GetDoubleFromObj(NULL, endObj, &dend);
	Tcl_GetDoubleFromObj(NULL, stepObj, &dstep);
	dstep = -dstep;
	TclSetDoubleObj(stepObj, dstep);
    } else {
	Tcl_GetWideIntFromObj(NULL, startObj, &start);
	Tcl_GetWideIntFromObj(NULL, endObj, &end);
	Tcl_GetWideIntFromObj(NULL, stepObj, &step);
	step = -step;
	TclSetIntObj(stepObj, step);
    }

    if (Tcl_IsShared(arithSeriesObj) || (arithSeriesObj->refCount > 1)) {
	Tcl_Obj *lenObj;

	TclNewIntObj(lenObj, len);
	resultObj = TclNewArithSeriesObj(interp, isDouble,
	    startObj, endObj, stepObj, lenObj);
	Tcl_DecrRefCount(lenObj);
    } else {
	/*
	 * In-place is possible.
	 */

	TclInvalidateStringRep(arithSeriesObj);
    TclInvalidateStringRep(arithSeriesObj);

	if (isDouble) {
	    ArithSeriesDbl *dblRepPtr = (ArithSeriesDbl *) arithSeriesRepPtr;
    if (isDouble) {
	ArithSeriesDbl *dblRepPtr = (ArithSeriesDbl *) arithSeriesRepPtr;

	    dblRepPtr->start = dstart;
	    dblRepPtr->end = dend;
	    dblRepPtr->step = dstep;
	} else {
	    ArithSeriesInt *intRepPtr = (ArithSeriesInt *) arithSeriesRepPtr;
	    intRepPtr->start = start;
	    intRepPtr->end = end;
	    intRepPtr->step = step;
	}
	FreeElements(arithSeriesRepPtr);
	dblRepPtr->start = dstart;
	dblRepPtr->end = dend;
	dblRepPtr->step = dstep;
    } else {
	ArithSeriesInt *intRepPtr = (ArithSeriesInt *) arithSeriesRepPtr;
	intRepPtr->start = start;
	intRepPtr->end = end;
	intRepPtr->step = step;
    }
    FreeElements(arithSeriesRepPtr);
	resultObj = arithSeriesObj;
    }


    Tcl_DecrRefCount(startObj);
    Tcl_DecrRefCount(endObj);
    Tcl_DecrRefCount(stepObj);

    *newObjPtr = resultObj;

    return TCL_OK;
}
    return resultObj ? TCL_OK : TCL_ERROR;
}


/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfArithSeries --
 *
 *	Update the string representation for an arithseries object.
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
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







-
+
-


-
+

-
+


















-
+












-
+

-
+

-
+




-
+



-
+

-
+
+

+








-
-
+
+





-
+







-

+









-
+



-
-
+
+

-
-
-
+
+
+




-
+

-
+










-
+

















-
+

-
-
+
+







 *	much faster. Because the programmer shouldn't expect the
 *	string conversion of a big arithmetic sequence to be fast
 *	this version takes more care of space than time.
 *
 *----------------------------------------------------------------------
 */
static void
UpdateStringOfArithSeries(
UpdateStringOfArithSeries(Tcl_Obj *arithSeriesPtr)
    Tcl_Obj *arithSeriesObjPtr)
{
    ArithSeries *arithSeriesRepPtr = (ArithSeries *)
	    arithSeriesObjPtr->internalRep.twoPtrValue.ptr1;
	arithSeriesPtr->internalRep.twoPtrValue.ptr1;
    char *p;
    Tcl_Obj *eleObj;
    Tcl_Obj *elemObj;
    Tcl_Size i, bytlen = 0;

    /*
     * Pass 1: estimate space.
     */
    if (!arithSeriesRepPtr->isDouble) {
	for (i = 0; i < arithSeriesRepPtr->len; i++) {
	    double d = ArithSeriesIndexInt(arithSeriesRepPtr, i);
	    size_t slen = d>0 ? log10(d)+1 : d<0 ? log10(-d)+2 : 1;

	    bytlen += slen;
	}
    } else {
	for (i = 0; i < arithSeriesRepPtr->len; i++) {
	    double d = ArithSeriesIndexDbl(arithSeriesRepPtr, i);
	    char tmp[TCL_DOUBLE_SPACE + 2];

	    tmp[0] = 0;
	    Tcl_PrintDouble(NULL,d,tmp);
	    Tcl_PrintDouble(NULL, d, tmp);
	    if ((bytlen + strlen(tmp)) > TCL_SIZE_MAX) {
		break; // overflow
	    }
	    bytlen += strlen(tmp);
	}
    }
    bytlen += arithSeriesRepPtr->len; // Space for each separator

    /*
     * Pass 2: generate the string repr.
     */

    p = Tcl_InitStringRep(arithSeriesObjPtr, NULL, bytlen);
    p = Tcl_InitStringRep(arithSeriesPtr, NULL, bytlen);
    for (i = 0; i < arithSeriesRepPtr->len; i++) {
	if (TclArithSeriesObjIndex(NULL, arithSeriesObjPtr, i, &eleObj) == TCL_OK) {
	if (ArithSeriesObjIndex(NULL, arithSeriesPtr, i, &elemObj) == TCL_OK) {
	    Tcl_Size slen;
	    char *str = TclGetStringFromObj(eleObj, &slen);
	    char *str = Tcl_GetStringFromObj(elemObj, &slen);

	    strcpy(p, str);
	    p[slen] = ' ';
	    p += slen + 1;
	    Tcl_DecrRefCount(eleObj);
	    Tcl_DecrRefCount(elemObj);
	} // else TODO: report error here?
    }
    if (bytlen > 0) {
	arithSeriesObjPtr->bytes[bytlen - 1] = '\0';
	arithSeriesPtr->bytes[bytlen - 1] = '\0';
    }
    arithSeriesObjPtr->length = bytlen - 1;
    arithSeriesPtr->length = bytlen - 1;
    return;
}


/*
 *----------------------------------------------------------------------
 *
 * ArithSeriesInOperator --
 *
 *	Evaluate the "in" operation for expr
 *
 *      This can be done more efficiently in the Arith Series relative to
 *      doing a linear search as implemented in expr.
 *	This can be done more efficiently in the Arith Series relative to
 *	doing a linear search as implemented in expr.
 *
 * Results:
 *	Boolean true or false (1/0)
 *
 * Side effects:
 *      None
 *	None
 *
 *----------------------------------------------------------------------
 */

static int
ArithSeriesInOperation(
    Tcl_Interp *interp,
    Tcl_Obj *valueObj,
    Tcl_Obj *arithSeriesObjPtr,
    Tcl_Obj *valueObj,
    int *boolResult)
{
    ArithSeries *repPtr = (ArithSeries *)
	    arithSeriesObjPtr->internalRep.twoPtrValue.ptr1;
    int status;
    Tcl_Size index, incr, elen, vlen;

    if (repPtr->isDouble) {
	ArithSeriesDbl *dblRepPtr = (ArithSeriesDbl *) repPtr;
	double y;
        double y;
	int test = 0;

	incr = 0; // Check index+incr where incr is 0 and 1
	status = Tcl_GetDoubleFromObj(interp, valueObj, &y);
	if (status != TCL_OK) {
        status = Tcl_GetDoubleFromObj(interp, valueObj, &y);
        if (status != TCL_OK) {
	    test = 0;
	} else {
	    const char *vstr = TclGetStringFromObj(valueObj, &vlen);
	    index = (y - dblRepPtr->start) / dblRepPtr->step;
        } else {
            char *vstr = Tcl_GetStringFromObj(valueObj, &vlen);
            index = (y - dblRepPtr->start) / dblRepPtr->step;
	    while (incr<2) {
		Tcl_Obj *elemObj;

		elen = 0;
		TclArithSeriesObjIndex(interp, arithSeriesObjPtr, (index+incr), &elemObj);
		ArithSeriesObjIndex(interp, arithSeriesObjPtr, (index+incr), &elemObj);

		const char *estr = elemObj ? TclGetStringFromObj(elemObj, &elen) : "";
		const char *estr = elemObj ? Tcl_GetStringFromObj(elemObj, &elen) : "";

		/* "in" operation defined as a string compare */
		test = (elen == vlen) ? (memcmp(estr, vstr, elen) == 0) : 0;
		Tcl_BounceRefCount(elemObj);
		/* Stop if we have a match */
		if (test) {
		    break;
		}
		incr++;
	    }
	}
        }
	if (boolResult) {
	    *boolResult = test;
	}
    } else {
	ArithSeriesInt *intRepPtr = (ArithSeriesInt *) repPtr;
	Tcl_WideInt y;

	status = Tcl_GetWideIntFromObj(NULL, valueObj, &y);
	if (status != TCL_OK) {
	    if (boolResult) {
		*boolResult = 0;
	    }
	} else {
	    Tcl_Obj *elemObj;

	    elen = 0;
	    index = (y - intRepPtr->start) / intRepPtr->step;
	    TclArithSeriesObjIndex(interp, arithSeriesObjPtr, index, &elemObj);
	    ArithSeriesObjIndex(interp, arithSeriesObjPtr, index, &elemObj);

	    char const *vstr = TclGetStringFromObj(valueObj, &vlen);
	    char const *estr = elemObj ? TclGetStringFromObj(elemObj, &elen) : "";
	    char const *vstr = Tcl_GetStringFromObj(valueObj, &vlen);
	    char const *estr = elemObj ? Tcl_GetStringFromObj(elemObj, &elen) : "";

	    if (boolResult) {
		*boolResult = (elen == vlen) ? (memcmp(estr, vstr, elen) == 0) : 0;
	    }
	    Tcl_BounceRefCount(elemObj);
	}
    }
Changes to generic/tclAssembly.c.

















1
2
3
4
5
6
7
8
9
10
11
12
13
14

15
16
17
18
19
20
21
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








-
-
-
-
-
-
+







/*
 * Copyright © 2010 Ozgur Dogan Ugurlu.
 * Copyright © 2010 Kevin B. Kenny.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclAssembly.c --
 *
 *	Assembler for Tcl bytecodes.
 *
 * This file contains the procedures that convert Tcl Assembly Language (TAL)
 * to a sequence of bytecode instructions for the Tcl execution engine.
 *
 * Copyright © 2010 Ozgur Dogan Ugurlu.
 * Copyright © 2010 Kevin B. Kenny.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */
*/

/*-
 *- THINGS TO DO:
 *- More instructions:
 *-   done - alternate exit point (affects stack and exception range checking)
 *-   break and continue - if exception ranges can be sorted out.
 *-   foreach_start4, foreach_step4
218
219
220
221
222
223
224
225

226
227

228
229
230
231
232
233
234
230
231
232
233
234
235
236

237
238

239
240
241
242
243
244
245
246







-
+

-
+







typedef struct AssemblyEnv {
    CompileEnv* envPtr;		/* Compilation environment being used for code
				 * generation */
    Tcl_Parse* parsePtr;	/* Parse of the current line of source */
    Tcl_HashTable labelHash;	/* Hash table whose keys are labels and whose
				 * values are 'label' objects storing the code
				 * offsets of the labels. */
    Tcl_Size cmdLine;	/* Current line number within the assembly
    Tcl_Size cmdLine;		/* Current line number within the assembly
				 * code */
    Tcl_Size* clNext;	/* Invisible continuation line for
    Tcl_Size* clNext;		/* Invisible continuation line for
				 * [info frame] */
    BasicBlock* head_bb;	/* First basic block in the code */
    BasicBlock* curr_bb;	/* Current basic block */
    int maxDepth;		/* Maximum stack depth encountered */
    int curCatchDepth;		/* Current depth of catches */
    int maxCatchDepth;		/* Maximum depth of catches encountered */
    int flags;			/* Compilation flags (TCL_EVAL_DIRECT) */
318
319
320
321
322
323
324
325
326
327
328




329

330
331
332
333
334
335
336
330
331
332
333
334
335
336




337
338
339
340

341
342
343
344
345
346
347
348







-
-
-
-
+
+
+
+
-
+







 */

static Tcl_FreeInternalRepProc	FreeAssembleCodeInternalRep;
static Tcl_DupInternalRepProc	DupAssembleCodeInternalRep;

static const Tcl_ObjType assembleCodeType = {
    "assemblecode",
    FreeAssembleCodeInternalRep, /* freeIntRepProc */
    DupAssembleCodeInternalRep,	 /* dupIntRepProc */
    NULL,			 /* updateStringProc */
    NULL,			 /* setFromAnyProc */
    FreeAssembleCodeInternalRep,
    DupAssembleCodeInternalRep,
    NULL,			/* updateStringProc */
    NULL,			/* setFromAnyProc */
    TCL_OBJTYPE_V0
	0
};

/*
 * Source instructions recognized in the Tcl Assembly Language (TAL)
 */

static const TalInstDesc TalInstructionTable[] = {
847
848
849
850
851
852
853
854

855
856
857
858
859
860
861
862
859
860
861
862
863
864
865

866

867
868
869
870
871
872
873







-
+
-







CompileAssembleObj(
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Obj *objPtr)		/* Source code to assemble */
{
    Interp *iPtr = (Interp *) interp;
				/* Internals of the interpreter */
    CompileEnv compEnv;		/* Compilation environment structure */
    ByteCode *codePtr = NULL;
    ByteCode *codePtr = NULL;	/* Bytecode resulting from the assembly */
				/* Bytecode resulting from the assembly */
    Namespace* namespacePtr;	/* Namespace in which variable and command
				 * names in the bytecode resolve */
    int status;			/* Status return from Tcl_AssembleCode */
    const char* source;		/* String representation of the source code */
    Tcl_Size sourceLen;		/* Length of the source code in bytes */

    /*
884
885
886
887
888
889
890
891

892
893
894
895
896
897
898
895
896
897
898
899
900
901

902
903
904
905
906
907
908
909







-
+







	Tcl_StoreInternalRep(objPtr, &assembleCodeType, NULL);
    }

    /*
     * Set up the compilation environment, and assemble the code.
     */

    source = TclGetStringFromObj(objPtr, &sourceLen);
    source = Tcl_GetStringFromObj(objPtr, &sourceLen);
    TclInitCompileEnv(interp, &compEnv, source, sourceLen, NULL, 0);
    status = TclAssembleCode(&compEnv, source, sourceLen, TCL_EVAL_DIRECT);
    if (status != TCL_OK) {
	/*
	 * Assembly failed. Clean up and report the error.
	 */
	TclFreeCompileEnv(&compEnv);
1262
1263
1264
1265
1266
1267
1268
1269

1270
1271
1272
1273
1274
1275
1276
1273
1274
1275
1276
1277
1278
1279

1280
1281
1282
1283
1284
1285
1286
1287







-
+







    TalInstType instType;	/* Type of the instruction */
    Tcl_Obj* operand1Obj = NULL;
				/* First operand to the instruction */
    const char* operand1;	/* String rep of the operand */
    Tcl_Size operand1Len;	/* String length of the operand */
    int opnd;			/* Integer representation of an operand */
    int litIndex;		/* Literal pool index of a constant */
    Tcl_Size localVar;	/* LVT index of a local variable */
    Tcl_Size localVar;		/* LVT index of a local variable */
    int flags;			/* Flags for a basic block */
    JumptableInfo* jtPtr;	/* Pointer to a jumptable */
    int infoIndex;		/* Index of the jumptable in auxdata */
    int status = TCL_ERROR;	/* Return value from this function */

    /*
     * Make sure that the instruction name is known at compile time.
1302
1303
1304
1305
1306
1307
1308
1309

1310
1311
1312
1313
1314
1315
1316
1313
1314
1315
1316
1317
1318
1319

1320
1321
1322
1323
1324
1325
1326
1327







-
+







	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "value");
	    goto cleanup;
	}
	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
	    goto cleanup;
	}
	operand1 = TclGetStringFromObj(operand1Obj, &operand1Len);
	operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len);
	litIndex = TclRegisterLiteral(envPtr, operand1, operand1Len, 0);
	BBEmitInst1or4(assemEnvPtr, tblIdx, litIndex, 0);
	break;

    case ASSEM_1BYTE:
	if (parsePtr->numWords != 1) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "");
1469
1470
1471
1472
1473
1474
1475
1476

1477
1478
1479
1480
1481
1482
1483
1480
1481
1482
1483
1484
1485
1486

1487
1488
1489
1490
1491
1492
1493
1494







-
+







	if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    CompileEmbeddedScript(assemEnvPtr, tokenPtr+1,
		    TalInstructionTable+tblIdx);
	} else if (GetNextOperand(assemEnvPtr, &tokenPtr,
		&operand1Obj) != TCL_OK) {
	    goto cleanup;
	} else {
	    operand1 = TclGetStringFromObj(operand1Obj, &operand1Len);
	    operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len);
	    litIndex = TclRegisterLiteral(envPtr, operand1, operand1Len, 0);

	    /*
	     * Assumes that PUSH is the first slot!
	     */

	    BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0);
1959
1960
1961
1962
1963
1964
1965
1966

1967
1968
1969
1970
1971
1972
1973
1970
1971
1972
1973
1974
1975
1976

1977
1978
1979
1980
1981
1982
1983
1984







-
+







 */

static int
CreateMirrorJumpTable(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    Tcl_Obj* jumps)		/* List of alternating keywords and labels */
{
    Tcl_Size objc;			/* Number of elements in the 'jumps' list */
    Tcl_Size objc;		/* Number of elements in the 'jumps' list */
    Tcl_Obj** objv;		/* Pointers to the elements in the list */
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    BasicBlock* bbPtr = assemEnvPtr->curr_bb;
				/* Current basic block */
2309
2310
2311
2312
2313
2314
2315
2316

2317
2318
2319
2320
2321
2322
2323
2320
2321
2322
2323
2324
2325
2326

2327
2328
2329
2330
2331
2332
2333
2334







-
+







    const char* varNameStr;
    Tcl_Size varNameLen;
    Tcl_Size localVar;		/* Index of the variable in the LVT */

    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) {
	return TCL_INDEX_NONE;
    }
    varNameStr = TclGetStringFromObj(varNameObj, &varNameLen);
    varNameStr = Tcl_GetStringFromObj(varNameObj, &varNameLen);
    if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) {
	Tcl_DecrRefCount(varNameObj);
	return TCL_INDEX_NONE;
    }
    localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr);
    Tcl_DecrRefCount(varNameObj);
    if (localVar < 0) {
3816
3817
3818
3819
3820
3821
3822
3823

3824
3825
3826
3827
3828
3829
3830
3827
3828
3829
3830
3831
3832
3833

3834
3835
3836
3837
3838
3839
3840
3841







-
+







    }

    /*
     * All blocks referenced in a jump table are successors.
     */

    if (bbPtr->flags & BB_JUMPTABLE) {
	for (jtEntry = Tcl_FirstHashEntry(&bbPtr->jtPtr->hashTable,&jtSearch);
	for (jtEntry = Tcl_FirstHashEntry(&bbPtr->jtPtr->hashTable, &jtSearch);
		result == TCL_OK && jtEntry != NULL;
		jtEntry = Tcl_NextHashEntry(&jtSearch)) {
	    targetLabel = (Tcl_Obj*)Tcl_GetHashValue(jtEntry);
	    entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
		    TclGetString(targetLabel));
	    jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry);
	    result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget,
Changes to generic/tclAsync.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
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

-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



















-
+







-
+







/*
 * tclAsync.c --
 *
 *	This file provides low-level support needed to invoke signal handlers
 *	in a safe way. The code here doesn't actually handle signals, though.
 *	This code is based on proposals made by Mark Diekhans and Don Libes.
 *
 * Copyright © 1993 The Regents of the University of California.
 * Copyright © 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclAsync.c --
 *
 *	This file provides low-level support needed to invoke signal handlers
 *	in a safe way. The code here doesn't actually handle signals, though.
 *	This code is based on proposals made by Mark Diekhans and Don Libes.
 *
*/

#include "tclInt.h"

/* Forward declaration */
struct ThreadSpecificData;

/*
 * One of the following structures exists for each asynchronous handler:
 */

typedef struct AsyncHandler {
    int ready;			/* Non-zero means this handler should be
				 * invoked in the next call to
				 * Tcl_AsyncInvoke. */
    struct AsyncHandler *nextPtr, *prevPtr;
				/* Next, previous in list of all handlers
				 * for the process. */
    Tcl_AsyncProc *proc;	/* Procedure to call when handler is
				 * invoked. */
    void *clientData;	/* Value to pass to handler when it is
    void *clientData;		/* Value to pass to handler when it is
				 * invoked. */
    struct ThreadSpecificData *originTsd;
				/* Used in Tcl_AsyncMark to modify thread-
				 * specific data from outside the thread it is
				 * associated to. */
    Tcl_ThreadId originThrdId;	/* Origin thread where this token was created
				 * and where it will be yielded. */
    void *notifierData;	/* Platform notifier data or NULL. */
    void *notifierData;		/* Platform notifier data or NULL. */
} AsyncHandler;

typedef struct ThreadSpecificData {
    int asyncReady;		/* This is set to 1 whenever a handler becomes
				 * ready and it is cleared to zero whenever
				 * Tcl_AsyncInvoke is called. It can be
				 * checked elsewhere in the application by
138
139
140
141
142
143
144
145

146
147
148
149
150
151
152
150
151
152
153
154
155
156

157
158
159
160
161
162
163
164







-
+







 *----------------------------------------------------------------------
 */

Tcl_AsyncHandler
Tcl_AsyncCreate(
    Tcl_AsyncProc *proc,	/* Procedure to call when handler is
				 * invoked. */
    void *clientData)	/* Argument to pass to handler. */
    void *clientData)		/* Argument to pass to handler. */
{
    AsyncHandler *asyncPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    asyncPtr = (AsyncHandler*)Tcl_Alloc(sizeof(AsyncHandler));
    asyncPtr->ready = 0;
    asyncPtr->nextPtr = NULL;
186
187
188
189
190
191
192
193

194
195
196
197
198
199
200
198
199
200
201
202
203
204

205
206
207
208
209
210
211
212







-
+







 *	The handler gets marked for invocation later.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AsyncMark(
    Tcl_AsyncHandler async)		/* Token for handler. */
    Tcl_AsyncHandler async)	/* Token for handler. */
{
    AsyncHandler *token = (AsyncHandler *) async;

    Tcl_MutexLock(&asyncMutex);
    token->ready = 1;
    if (!token->originTsd->asyncActive) {
	token->originTsd->asyncReady = 1;
220
221
222
223
224
225
226
227
228


229
230
231
232
233
234
235
232
233
234
235
236
237
238


239
240
241
242
243
244
245
246
247







-
-
+
+







 *	The handler gets marked for invocation later.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_AsyncMarkFromSignal(
    Tcl_AsyncHandler async,		/* Token for handler. */
    int sigNumber)			/* Signal number. */
    Tcl_AsyncHandler async,	/* Token for handler. */
    int sigNumber)		/* Signal number. */
{
#if TCL_THREADS
    AsyncHandler *token = (AsyncHandler *) async;

    return TclAsyncNotifier(sigNumber, token->originThrdId,
	    token->notifierData, &token->ready, -1);
#else
374
375
376
377
378
379
380
381

382
383
384
385
386
387
388
386
387
388
389
390
391
392

393
394
395
396
397
398
399
400







-
+







 *	deleted by some other thread.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AsyncDelete(
    Tcl_AsyncHandler async)		/* Token for handler to delete. */
    Tcl_AsyncHandler async)	/* Token for handler to delete. */
{
    AsyncHandler *asyncPtr = (AsyncHandler *) async;

    /*
     * Assure early handling of the constraint
     */

Changes to generic/tclBasic.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
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

-
-
-
-
-
-











+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclBasic.c --
 *
 *	Contains the basic facilities for TCL command interpretation,
 *	including interpreter creation and deletion, command creation and
 *	deletion, and command/script execution.
 *
 * Copyright © 1987-1994 The Regents of the University of California.
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 * Copyright © 1998-1999 Scriptics Corporation.
 * Copyright © 2001, 2002 Kevin B. Kenny.  All rights reserved.
 * Copyright © 2007 Daniel A. Steffen <das@users.sourceforge.net>
 * Copyright © 2006-2008 Joe Mistachkin.  All rights reserved.
 * Copyright © 2008 Miguel Sofer <msofer@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclBasic.c --
 *
 *	Contains the basic facilities for TCL command interpretation,
 *	including interpreter creation and deletion, command creation and
 *	deletion, and command/script execution.
 *
*/

#include "tclInt.h"
#include "tclOOInt.h"
#include "tclCompile.h"
#include "tclTomMath.h"
#include <math.h>
#include <assert.h>
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
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







-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+
+







TCL_DECLARE_MUTEX(commandTypeLock);

/*
 * Declarations for managing contexts for non-recursive coroutines. Contexts
 * are used to save the evaluation state between NR calls to each coro.
 */

#define SAVE_CONTEXT(context)				\
    (context).framePtr = iPtr->framePtr;		\
    (context).varFramePtr = iPtr->varFramePtr;		\
    (context).cmdFramePtr = iPtr->cmdFramePtr;		\
    (context).lineLABCPtr = iPtr->lineLABCPtr
#define SAVE_CONTEXT(context) \
    do {								\
	(context).framePtr = iPtr->framePtr;				\
	(context).varFramePtr = iPtr->varFramePtr;			\
	(context).cmdFramePtr = iPtr->cmdFramePtr;			\
	(context).lineLABCPtr = iPtr->lineLABCPtr;			\
    } while (0)

#define RESTORE_CONTEXT(context)			\
    iPtr->framePtr = (context).framePtr;		\
    iPtr->varFramePtr = (context).varFramePtr;		\
    iPtr->cmdFramePtr = (context).cmdFramePtr;		\
    iPtr->lineLABCPtr = (context).lineLABCPtr
#define RESTORE_CONTEXT(context) \
    do {								\
	iPtr->framePtr = (context).framePtr;				\
	iPtr->varFramePtr = (context).varFramePtr;			\
	iPtr->cmdFramePtr = (context).cmdFramePtr;			\
	iPtr->lineLABCPtr = (context).lineLABCPtr;			\
    } while (0)

/*
 * Static functions in this file:
 */

static Tcl_ObjCmdProc	BadEnsembleSubcommand;
static char *		CallCommandTraces(Interp *iPtr, Command *cmdPtr,
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







-
-
+
+







	Tcl_Panic("Tcl_CallFrame must not be smaller than CallFrame");
    }

#if defined(_WIN32) && !defined(_WIN64)
    if (sizeof(time_t) != 8) {
	Tcl_Panic("<time.h> is not compatible with VS2005+");
    }
    if ((offsetof(Tcl_StatBuf,st_atime) != 32)
	    || (offsetof(Tcl_StatBuf,st_ctime) != 48)) {
    if ((offsetof(Tcl_StatBuf, st_atime) != 32)
	    || (offsetof(Tcl_StatBuf, st_ctime) != 48)) {
	Tcl_Panic("<sys/stat.h> is not compatible with VS2005+");
    }
#endif

    if (cancelTableInitialized == 0) {
	Tcl_MutexLock(&cancelLock);
	if (cancelTableInitialized == 0) {
920
921
922
923
924
925
926
927

928
929

930
931

932
933
934
935
936
937
938
936
937
938
939
940
941
942

943
944

945
946

947
948
949
950
951
952
953
954







-
+

-
+

-
+







    iPtr->returnOpts = NULL;
    iPtr->errorInfo = NULL;
    TclNewLiteralStringObj(iPtr->eiVar, "::errorInfo");
    Tcl_IncrRefCount(iPtr->eiVar);
    iPtr->errorStack = Tcl_NewListObj(0, NULL);
    Tcl_IncrRefCount(iPtr->errorStack);
    iPtr->resetErrorStack = 1;
    TclNewLiteralStringObj(iPtr->upLiteral,"UP");
    TclNewLiteralStringObj(iPtr->upLiteral, "UP");
    Tcl_IncrRefCount(iPtr->upLiteral);
    TclNewLiteralStringObj(iPtr->callLiteral,"CALL");
    TclNewLiteralStringObj(iPtr->callLiteral, "CALL");
    Tcl_IncrRefCount(iPtr->callLiteral);
    TclNewLiteralStringObj(iPtr->innerLiteral,"INNER");
    TclNewLiteralStringObj(iPtr->innerLiteral, "INNER");
    Tcl_IncrRefCount(iPtr->innerLiteral);
    iPtr->innerContext = Tcl_NewListObj(0, NULL);
    Tcl_IncrRefCount(iPtr->innerContext);
    iPtr->errorCode = NULL;
    TclNewLiteralStringObj(iPtr->ecVar, "::errorCode");
    Tcl_IncrRefCount(iPtr->ecVar);
    iPtr->returnLevel = 1;
1169
1170
1171
1172
1173
1174
1175

1176
1177
1178
1179
1180
1181
1182
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199







+







    /*
     * Register "clock" subcommands. These *do* go through
     * Tcl_CreateObjCommand, since they aren't in the global namespace and
     * involve ensembles.
     */

    TclClockInit(interp);
    TclClockClassicInit(interp);

    /*
     * Register the built-in functions. This is empty now that they are
     * implemented as commands in the ::tcl::mathfunc namespace.
     */

    /*
1225
1226
1227
1228
1229
1230
1231
1232

1233
1234
1235
1236
1237
1238
1239
1242
1243
1244
1245
1246
1247
1248

1249
1250
1251
1252
1253
1254
1255
1256







-
+







    Tcl_CreateObjCommand(interp, "::tcl::dtrace", DTraceObjCmd, NULL, NULL);
#endif /* USE_DTRACE */

    /*
     * Register the builtin math functions.
     */

    nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL,NULL);
    nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL, NULL);
    if (nsPtr == NULL) {
	Tcl_Panic("Can't create math function namespace");
    }
#define MATH_FUNC_PREFIX_LEN 17 /* == strlen("::tcl::mathfunc::") */
    memcpy(mathFuncName, "::tcl::mathfunc::", MATH_FUNC_PREFIX_LEN);
    for (builtinFuncPtr = BuiltinFuncTable; builtinFuncPtr->name != NULL;
	    builtinFuncPtr++) {
3701
3702
3703
3704
3705
3706
3707
3708

3709
3710
3711
3712
3713
3714
3715
3718
3719
3720
3721
3722
3723
3724

3725
3726
3727
3728
3729
3730
3731
3732







-
+








    cmdPtr->nsPtr->refCount++;

    if (cmdPtr->tracePtr != NULL) {
	CommandTrace *tracePtr;
	/* CallCommandTraces() does not cmdPtr, that's
	 * done just before Tcl_DeleteCommandFromToken() returns */
	CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE);
	CallCommandTraces(iPtr, cmdPtr, NULL, NULL, TCL_TRACE_DELETE);

	/*
	 * Now delete these traces.
	 */

	tracePtr = cmdPtr->tracePtr;
	while (tracePtr != NULL) {
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
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







-
-
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+








    /*
     * If the TCL_LEAVE_ERR_MSG flags bit is set, place an error in the
     * interp's result; otherwise, we leave it alone.
     */

    if (flags & TCL_LEAVE_ERR_MSG) {
	const char *id, *message = NULL;
	Tcl_Size length;
        const char *id, *message = NULL;
        Tcl_Size length;

	/*
	 * Setup errorCode variables so that we can differentiate between
	 * being canceled and unwound.
	 */
        /*
         * Setup errorCode variables so that we can differentiate between
         * being canceled and unwound.
         */

	if (iPtr->asyncCancelMsg != NULL) {
	    message = TclGetStringFromObj(iPtr->asyncCancelMsg, &length);
	} else {
	    length = 0;
	}
        if (iPtr->asyncCancelMsg != NULL) {
            message = Tcl_GetStringFromObj(iPtr->asyncCancelMsg, &length);
        } else {
            length = 0;
        }

	if (iPtr->flags & TCL_CANCEL_UNWIND) {
	    id = "IUNWIND";
	    if (length == 0) {
		message = "eval unwound";
	    }
	} else {
	    id = "ICANCEL";
	    if (length == 0) {
		message = "eval canceled";
	    }
	}
        if (iPtr->flags & TCL_CANCEL_UNWIND) {
            id = "IUNWIND";
            if (length == 0) {
                message = "eval unwound";
            }
        } else {
            id = "ICANCEL";
            if (length == 0) {
                message = "eval canceled";
            }
        }

	Tcl_SetObjResult(interp, Tcl_NewStringObj(message, TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, (char *)NULL);
        Tcl_SetObjResult(interp, Tcl_NewStringObj(message, -1));
        Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, (char *)NULL);
    }

    /*
     * Return TCL_ERROR to the caller (not necessarily just the Tcl core
     * itself) that indicates further processing of the script or command in
     * progress should halt gracefully and as soon as possible.
     */
4322
4323
4324
4325
4326
4327
4328
4329

4330
4331
4332
4333
4334
4335
4336
4339
4340
4341
4342
4343
4344
4345

4346
4347
4348
4349
4350
4351
4352
4353







-
+







     * cancellation request. Currently, clientData is ignored. If the
     * TCL_CANCEL_UNWIND flags bit is set, the script in progress is not
     * allowed to catch the script cancellation because the evaluation stack
     * for the interp is completely unwound.
     */

    if (resultObjPtr != NULL) {
	result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length);
	result = Tcl_GetStringFromObj(resultObjPtr, &cancelInfo->length);
	cancelInfo->result = (char *)Tcl_Realloc(cancelInfo->result, cancelInfo->length);
	memcpy(cancelInfo->result, result, cancelInfo->length);
	TclDecrRefCount(resultObjPtr);	/* Discard their result object. */
    } else {
	cancelInfo->result = NULL;
	cancelInfo->length = 0;
    }
4626
4627
4628
4629
4630
4631
4632
4633


4634
4635
4636
4637
4638
4639
4640
4643
4644
4645
4646
4647
4648
4649

4650
4651
4652
4653
4654
4655
4656
4657
4658







-
+
+







	    a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++;
	}
	TCL_DTRACE_CMD_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
		a[8], a[9]);
    }
    if (TCL_DTRACE_CMD_INFO_ENABLED() && iPtr->cmdFramePtr) {
	Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr);
	const char *a[6]; Tcl_Size i[2];
	const char *a[6];
	Tcl_Size i[2];

	TclDTraceInfo(info, a, i);
	TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]);
	TclDecrRefCount(info);
    }
    if ((TCL_DTRACE_CMD_RETURN_ENABLED() || TCL_DTRACE_CMD_RESULT_ENABLED())
	    && objc) {
4829
4830
4831
4832
4833
4834
4835
4836

4837
4838
4839
4840
4841
4842
4843
4847
4848
4849
4850
4851
4852
4853

4854
4855
4856
4857
4858
4859
4860
4861







-
+







	/*
	 * If there was an error, a command string will be needed for the
	 * error log: get it out of the itemPtr. The details depend on the
	 * type.
	 */

	listPtr = Tcl_NewListObj(objc, objv);
	cmdString = TclGetStringFromObj(listPtr, &cmdLen);
	cmdString = Tcl_GetStringFromObj(listPtr, &cmdLen);
	Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
	Tcl_DecrRefCount(listPtr);
    }
    iPtr->flags &= ~ERR_ALREADY_LOGGED;
    return result;
}

4975
4976
4977
4978
4979
4980
4981
4982

4983
4984
4985
4986
4987
4988
4989
4993
4994
4995
4996
4997
4998
4999

5000
5001
5002
5003
5004
5005
5006
5007







-
+







    Tcl_Size objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Command *cmdPtr = *cmdPtrPtr;
    Tcl_Size length, newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
    int traceCode = TCL_OK;
    const char *command = TclGetStringFromObj(commandPtr, &length);
    const char *command = Tcl_GetStringFromObj(commandPtr, &length);

    /*
     * Call trace functions.
     * Execute any command or execution traces. Note that we bump up the
     * command's reference count for the duration of the calling of the
     * traces so that the structure doesn't go away underneath our feet.
     */
5027
5028
5029
5030
5031
5032
5033
5034

5035
5036
5037
5038
5039
5040
5041
5045
5046
5047
5048
5049
5050
5051

5052
5053
5054
5055
5056
5057
5058
5059







-
+







    Interp *iPtr = (Interp *) interp;
    int traceCode = TCL_OK;
    Tcl_Size objc = PTR2INT(data[0]);
    Tcl_Obj *commandPtr = (Tcl_Obj *)data[1];
    Command *cmdPtr = (Command *)data[2];
    Tcl_Obj **objv = (Tcl_Obj **)data[3];
    Tcl_Size length;
    const char *command = TclGetStringFromObj(commandPtr, &length);
    const char *command = Tcl_GetStringFromObj(commandPtr, &length);

    if (!(cmdPtr->flags & CMD_DYING)) {
	if (cmdPtr->flags & CMD_HAS_EXEC_TRACES) {
	    traceCode = TclCheckExecutionTraces(interp, command, length,
		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
	}
	if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
6169
6170
6171
6172
6173
6174
6175
6176





6177
6178
6179
6180
6181
6182
6183
6187
6188
6189
6190
6191
6192
6193

6194
6195
6196
6197
6198
6199
6200
6201
6202
6203
6204
6205







-
+
+
+
+
+







	 * both listPtr and objPtr.
	 *
	 * TODO: Create a test to demo this need, or eliminate it.
	 * FIXME OPT: preserve just the internal rep?
	 */

	Tcl_IncrRefCount(objPtr);
	listPtr = TclListObjCopy(interp, objPtr);
	listPtr = TclDuplicatePureObj(interp, objPtr, tclListTypePtr);
	if (!listPtr) {
	    Tcl_DecrRefCount(objPtr);
	    return TCL_ERROR;
	}
	Tcl_IncrRefCount(listPtr);

	if (word != INT_MIN) {
	    /*
	     * TIP #280 Structures for tracking lines. As we know that this is
	     * dynamic execution we ignore the invoker, even if known.
	     *
6281
6282
6283
6284
6285
6286
6287
6288

6289
6290
6291
6292
6293
6294
6295
6303
6304
6305
6306
6307
6308
6309

6310
6311
6312
6313
6314
6315
6316
6317







-
+








	assert(invoker == NULL);

	iPtr->scriptCLLocPtr = TclContinuationsGet(objPtr);

	Tcl_IncrRefCount(objPtr);

	script = TclGetStringFromObj(objPtr, &numSrcBytes);
	script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
	result = Tcl_EvalEx(interp, script, numSrcBytes, flags);

	TclDecrRefCount(objPtr);

	iPtr->scriptCLLocPtr = saveCLLocPtr;
	return result;
    }
6312
6313
6314
6315
6316
6317
6318
6319

6320
6321
6322
6323
6324
6325
6326
6334
6335
6336
6337
6338
6339
6340

6341
6342
6343
6344
6345
6346
6347
6348







-
+







	}
	if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) {
	    const char *script;
	    Tcl_Size numSrcBytes;

	    ProcessUnexpectedResult(interp, result);
	    result = TCL_ERROR;
	    script = TclGetStringFromObj(objPtr, &numSrcBytes);
	    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
	    Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
	}

	/*
	 * We are returning to level 0, so should call TclResetCancellation.
	 * Let us just unset the flags inline.
	 */
6843
6844
6845
6846
6847
6848
6849
6850

6851
6852
6853
6854
6855
6856
6857
6865
6866
6867
6868
6869
6870
6871

6872
6873
6874
6875
6876
6877
6878
6879







-
+







void
Tcl_AppendObjToErrorInfo(
    Tcl_Interp *interp,		/* Interpreter to which error information
				 * pertains. */
    Tcl_Obj *objPtr)		/* Message to record. */
{
    Tcl_Size length;
    const char *message = TclGetStringFromObj(objPtr, &length);
    const char *message = Tcl_GetStringFromObj(objPtr, &length);
    Interp *iPtr = (Interp *) interp;

    Tcl_IncrRefCount(objPtr);

    /*
     * If we are just starting to log an error, errorInfo is initialized from
     * the error message in the interpreter's result.
7063
7064
7065
7066
7067
7068
7069
7070

7071
7072
7073
7074
7075
7076
7077
7085
7086
7087
7088
7089
7090
7091

7092
7093
7094
7095
7096
7097
7098
7099







-
+







    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
    if (code != TCL_OK) {
	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleTypePtr);

	if (irPtr) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}
    }
#endif
7103
7104
7105
7106
7107
7108
7109
7110

7111
7112
7113
7114
7115
7116
7117
7125
7126
7127
7128
7129
7130
7131

7132
7133
7134
7135
7136
7137
7138
7139







-
+







    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
    if (code != TCL_OK) {
	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleTypePtr);

	if (irPtr) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}
    }
#endif
7249
7250
7251
7252
7253
7254
7255
7256

7257
7258
7259
7260
7261
7262
7263
7271
7272
7273
7274
7275
7276
7277

7278
7279
7280
7281
7282
7283
7284
7285







-
+







    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
    if (code != TCL_OK) {
	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleTypePtr);

	if (irPtr) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}
    }
#endif
7303
7304
7305
7306
7307
7308
7309
7310

7311
7312
7313
7314
7315
7316
7317
7325
7326
7327
7328
7329
7330
7331

7332
7333
7334
7335
7336
7337
7338
7339







-
+







    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
    if (code != TCL_OK) {
	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleTypePtr);

	if (irPtr) {
	    d = irPtr->doubleValue;
	    Tcl_ResetResult(interp);
	    code = TCL_OK;
	}
    }
7367
7368
7369
7370
7371
7372
7373
7374

7375
7376
7377
7378
7379
7380
7381
7382
7383
7384
7385
7386
7387
7388
7389

7390
7391
7392
7393
7394
7395
7396
7389
7390
7391
7392
7393
7394
7395

7396
7397
7398
7399
7400
7401
7402
7403
7404
7405
7406
7407
7408
7409
7410

7411
7412
7413
7414
7415
7416
7417
7418







-
+














-
+







    if (objc != 3) {
	MathFuncWrongNumArgs(interp, 3, objc, objv);
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d1);
#ifdef ACCEPT_NAN
    if (code != TCL_OK) {
	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleTypePtr);

	if (irPtr) {
	    d1 = irPtr->doubleValue;
	    Tcl_ResetResult(interp);
	    code = TCL_OK;
	}
    }
#endif
    if (code != TCL_OK) {
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[2], &d2);
#ifdef ACCEPT_NAN
    if (code != TCL_OK) {
	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleTypePtr);

	if (irPtr) {
	    d2 = irPtr->doubleValue;
	    Tcl_ResetResult(interp);
	    code = TCL_OK;
	}
    }
7427
7428
7429
7430
7431
7432
7433
7434

7435
7436
7437
7438
7439
7440
7441
7449
7450
7451
7452
7453
7454
7455

7456
7457
7458
7459
7460
7461
7462
7463







-
+







	Tcl_WideInt l = *((const Tcl_WideInt *) ptr);

	if (l > 0) {
	    goto unChanged;
	} else if (l == 0) {
	    if (TclHasStringRep(objv[1])) {
		Tcl_Size numBytes;
		const char *bytes = TclGetStringFromObj(objv[1], &numBytes);
		const char *bytes = Tcl_GetStringFromObj(objv[1], &numBytes);

		while (numBytes) {
		    if (*bytes == '-') {
			Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
			return TCL_OK;
		    }
		    bytes++;
7544
7545
7546
7547
7548
7549
7550
7551

7552
7553
7554
7555
7556
7557
7558
7566
7567
7568
7569
7570
7571
7572

7573
7574
7575
7576
7577
7578
7579
7580







-
+








    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) {
#ifdef ACCEPT_NAN
	if (TclHasInternalRep(objv[1], &tclDoubleType)) {
	if (TclHasInternalRep(objv[1], tclDoubleTypePtr)) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}
#endif
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(dResult));
8926
8927
8928
8929
8930
8931
8932
8933

8934
8935
8936
8937
8938
8939
8940
8948
8949
8950
8951
8952
8953
8954

8955
8956
8957
8958
8959
8960
8961
8962







-
+







    }

    /*
     * Perform the tailcall
     */

    TclMarkTailcall(interp);
    TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL);
    TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL, NULL);
    iPtr->lookupNsPtr = (Namespace *) nsPtr;
    return TclNREvalObjv(interp, objc - 1, objv + 1, 0, NULL);
}

int
TclNRReleaseValues(
    void *data[],
9109
9110
9111
9112
9113
9114
9115
9116

9117
9118
9119
9120
9121
9122
9123
9131
9132
9133
9134
9135
9136
9137

9138
9139
9140
9141
9142
9143
9144
9145







-
+







    void *clientData)
{
    CoroutineData *corPtr = (CoroutineData *)clientData;
    Tcl_Interp *interp = corPtr->eePtr->interp;
    NRE_callback *rootPtr = TOP_CB(interp);

    if (COR_IS_SUSPENDED(corPtr)) {
	TclNRRunCallbacks(interp, RewindCoroutine(corPtr,TCL_OK), rootPtr);
	TclNRRunCallbacks(interp, RewindCoroutine(corPtr, TCL_OK), rootPtr);
    }
}

static int
NRCoroutineCallerCallback(
    void *data[],
    Tcl_Interp *interp,
9306
9307
9308
9309
9310
9311
9312

9313
9314
9315
9316
9317
9318
9319
9328
9329
9330
9331
9332
9333
9334
9335
9336
9337
9338
9339
9340
9341
9342







+







	corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;

	iPtr->execEnvPtr = corPtr->callerEEPtr;
    }

    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * CoroTypeObjCmd --
 *
 *	Implementation of [::tcl::unsupported::corotype] command.
9765
9766
9767
9768
9769
9770
9771
9772

9773
9774
9775
9776
9777
9778
9779
9788
9789
9790
9791
9792
9793
9794

9795
9796
9797
9798
9799
9800
9801
9802







-
+







    {
	Tcl_HashSearch hSearch;
	Tcl_HashEntry *hePtr;

	corPtr->lineLABCPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(corPtr->lineLABCPtr, TCL_ONE_WORD_KEYS);

	for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr,&hSearch);
	for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr, &hSearch);
		hePtr; hePtr = Tcl_NextHashEntry(&hSearch)) {
	    int isNew;
	    Tcl_HashEntry *newPtr =
		    Tcl_CreateHashEntry(corPtr->lineLABCPtr,
		    Tcl_GetHashKey(iPtr->lineLABCPtr, hePtr),
		    &isNew);

Changes to generic/tclBinary.c.
1
2
3
4
5
6
7
8
9
10
11
12

















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclBinary.c --
 *
 *	This file contains the implementation of the "binary" Tcl built-in
 *	command and the Tcl binary data object.
 *
 * Copyright © 1997 Sun Microsystems, Inc.
 * Copyright © 1998-1999 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclBinary.c --
 *
 *	This file contains the implementation of the "binary" Tcl built-in
 *	command and the Tcl binary data object.
 *
*/

#include "tclInt.h"
#include "tclTomMath.h"

#include <math.h>
#include <assert.h>

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
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







-
+



















+
-
+




-
+
+

-
+








static const Tcl_ObjType properByteArrayType = {
    "bytearray",
    FreeProperByteArrayInternalRep,
    DupProperByteArrayInternalRep,
    UpdateStringOfByteArray,
    NULL,
    TCL_OBJTYPE_V0
	0
};

/*
 * The following structure is the internal rep for a ByteArray object. Keeps
 * track of how much memory has been used and how much has been allocated for
 * the byte array to enable growing and shrinking of the ByteArray object with
 * fewer mallocs.
 */

typedef struct {
    Tcl_Size used;		/* The number of bytes used in the byte
				 * array. */
    Tcl_Size allocated;		/* The amount of space actually allocated
				 * minus 1 byte. */
    unsigned char bytes[TCLFLEXARRAY];	/* The array of bytes. The actual size of this
				 * field depends on the 'allocated' field
				 * above. */
} ByteArray;

#define BYTEARRAY_MAX_LEN \
#define BYTEARRAY_MAX_LEN (TCL_SIZE_MAX - (Tcl_Size)offsetof(ByteArray, bytes))
    (TCL_SIZE_MAX - (Tcl_Size)offsetof(ByteArray, bytes))
#define BYTEARRAY_SIZE(len) \
	( (len < 0 || BYTEARRAY_MAX_LEN < (len)) \
	? (Tcl_Panic("negative length specified or max size of a Tcl value exceeded"), 0) \
	: (offsetof(ByteArray, bytes) + (len)) )
#define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1)
#define GET_BYTEARRAY(irPtr) \
    ((ByteArray *) (irPtr)->twoPtrValue.ptr1)
#define SET_BYTEARRAY(irPtr, baPtr) \
		(irPtr)->twoPtrValue.ptr1 = (baPtr)
    (irPtr)->twoPtrValue.ptr1 = (baPtr)

int
TclIsPureByteArray(
    Tcl_Obj * objPtr)
{
    return TclHasInternalRep(objPtr, &properByteArrayType);
}
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
394
395
396
397
398
399
400





























401
402
403
404
405
406
407







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








    if (numBytesPtr != NULL) {
	*numBytesPtr = baPtr->used;
    }
    return baPtr->bytes;
}

#if !defined(TCL_NO_DEPRECATED)
unsigned char *
TclGetBytesFromObj(
    Tcl_Interp *interp,		/* For error reporting */
    Tcl_Obj *objPtr,		/* Value to extract from */
    void *numBytesPtr)		/* If non-NULL, write the number of bytes
				 * in the array here */
{
    Tcl_Size numBytes = 0;
    unsigned char *bytes = Tcl_GetBytesFromObj(interp, objPtr, &numBytes);

    if (bytes && numBytesPtr) {
	if (numBytes > INT_MAX) {
	    /* Caller asked for numBytes to be written to an int, but the
	     * value is outside the int range. */

	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"byte sequence length exceeds INT_MAX", -1));
		Tcl_SetErrorCode(interp, "TCL", "API", "OUTDATED", (void *)NULL);
	    }
	    return NULL;
	} else {
	    *(int *)numBytesPtr = (int) numBytes;
	}
    }
    return bytes;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetByteArrayLength --
 *
 *	This procedure changes the length of the byte array for this object.
498
499
500
501
502
503
504
505

506
507
508
509
510
511
512
483
484
485
486
487
488
489

490
491
492
493
494
495
496
497







-
+







    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    Tcl_Size limit,
    int demandProper,
    ByteArray **byteArrayPtrPtr)
{
    Tcl_Size length;
    const char *src = TclGetStringFromObj(objPtr, &length);
    const char *src = Tcl_GetStringFromObj(objPtr, &length);
    Tcl_Size numBytes = (limit >= 0 && limit < length) ? limit : length;
    ByteArray *byteArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(numBytes));
    unsigned char *dst = byteArrayPtr->bytes;
    unsigned char *dstEnd = dst + numBytes;
    const char *srcEnd = src + length;
    int proper = 1;

732
733
734
735
736
737
738
739

740
741
742
743
744
745
746
717
718
719
720
721
722
723

724
725
726
727
728
729
730
731







-
+







    Tcl_Size len)
{
    ByteArray *byteArrayPtr;
    Tcl_Size needed;
    Tcl_ObjInternalRep *irPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
	Tcl_Panic("%s called with shared object", "TclAppendBytesToByteArray");
    }
    if (len < 0) {
	Tcl_Panic("%s must be called with definite number of bytes to append",
		"TclAppendBytesToByteArray");
    }
    if (len == 0) {
	/*
1081
1082
1083
1084
1085
1086
1087
1088

1089
1090
1091
1092
1093
1094
1095
1066
1067
1068
1069
1070
1071
1072

1073
1074
1075
1076
1077
1078
1079
1080







-
+







	    Tcl_DecrRefCount(copy);
	    break;
	}
	case 'b':
	case 'B': {
	    unsigned char *last;

	    str = TclGetStringFromObj(objv[arg], &length);
	    str = Tcl_GetStringFromObj(objv[arg], &length);
	    arg++;
	    if (count == BINARY_ALL) {
		count = length;
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    last = cursor + ((count + 7) / 8);
1143
1144
1145
1146
1147
1148
1149
1150

1151
1152
1153
1154
1155
1156
1157
1128
1129
1130
1131
1132
1133
1134

1135
1136
1137
1138
1139
1140
1141
1142







-
+







	    break;
	}
	case 'h':
	case 'H': {
	    unsigned char *last;
	    int c;

	    str = TclGetStringFromObj(objv[arg], &length);
	    str = Tcl_GetStringFromObj(objv[arg], &length);
	    arg++;
	    if (count == BINARY_ALL) {
		count = length;
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    last = cursor + ((count + 1) / 2);
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
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







-
+



















-
+

















-
+







	/*
	 * Double-precision floating point values. Tcl_GetDoubleFromObj
	 * returns TCL_ERROR for NaN, but we can check by comparing the
	 * object's type pointer.
	 */

	if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
	    const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, &tclDoubleType);
	    const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, tclDoubleTypePtr);
	    if (irPtr == NULL) {
		return TCL_ERROR;
	    }
	    dvalue = irPtr->doubleValue;
	}
	CopyNumber(&dvalue, *cursorPtr, sizeof(double), type);
	*cursorPtr += sizeof(double);
	return TCL_OK;

    case 'f':
    case 'r':
    case 'R':
	/*
	 * Single-precision floating point values. Tcl_GetDoubleFromObj
	 * returns TCL_ERROR for NaN, but we can check by comparing the
	 * object's type pointer.
	 */

	if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
	    const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, &tclDoubleType);
	    const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, tclDoubleTypePtr);

	    if (irPtr == NULL) {
		return TCL_ERROR;
	    }
	    dvalue = irPtr->doubleValue;
	}

	/*
	 * Because some compilers will generate floating point exceptions on
	 * an overflow cast (e.g. Borland), we restrict the values to the
	 * valid range for float.
	 */

	if (fabs(dvalue) > (double) FLT_MAX) {
	    if (fabs(dvalue) > (FLT_MAX + pow(2, (FLT_MAX_EXP - FLT_MANT_DIG - 1)))) {
		fvalue = (dvalue >= 0.0) ? INFINITY : -INFINITY;	// c99
	    } else {
	    fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX;
		fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX;
	    }
	} else {
	    fvalue = (float) dvalue;
	}
	CopyNumber(&fvalue, *cursorPtr, sizeof(float), type);
	*cursorPtr += sizeof(float);
	return TCL_OK;
2508
2509
2510
2511
2512
2513
2514
2515

2516
2517
2518
2519
2520
2521
2522
2493
2494
2495
2496
2497
2498
2499

2500
2501
2502
2503
2504
2505
2506
2507







-
+







	}
    }

    TclNewObj(resultObj);
    data = Tcl_GetBytesFromObj(NULL, objv[objc - 1], &count);
    if (data == NULL) {
	pure = 0;
	data = (unsigned char *)TclGetStringFromObj(objv[objc - 1], &count);
	data = (unsigned char *)Tcl_GetStringFromObj(objv[objc - 1], &count);
    }
    datastart = data;
    dataend = data + count;
    size = (count + 1) / 2;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	value = 0;
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+







 * Results:
 *	The base64 encoded value prescribed by the input arguments.
 *
 *----------------------------------------------------------------------
 */

#define OUTPUT(c) \
    do {						\
	*cursor++ = (c);				\
	outindex++;					\
	if (maxlen > 0 && cursor != limit) {		\
	    if (outindex == maxlen) {			\
		memcpy(cursor, wrapchar, wrapcharlen);	\
		cursor += wrapcharlen;			\
		outindex = 0;				\
	    }						\
	}						\
	if (cursor > limit) {				\
	    Tcl_Panic("limit hit");			\
	}						\
    do {								\
	*cursor++ = (c);						\
	outindex++;							\
	if (maxlen > 0 && cursor != limit) {				\
	    if (outindex == maxlen) {					\
		memcpy(cursor, wrapchar, wrapcharlen);			\
		cursor += wrapcharlen;					\
		outindex = 0;						\
	    }								\
	}								\
	if (cursor > limit) {						\
	    Tcl_Panic("limit hit");					\
	}								\
    } while (0)

static int
BinaryEncode64(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
2642
2643
2644
2645
2646
2647
2648
2649

2650
2651
2652
2653
2654
2655
2656
2627
2628
2629
2630
2631
2632
2633

2634
2635
2636
2637
2638
2639
2640
2641







-
+







	    }
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = (const char *)Tcl_GetBytesFromObj(NULL,
		    objv[i + 1], &wrapcharlen);
	    if (wrapchar == NULL) {
		purewrap = 0;
		wrapchar = TclGetStringFromObj(objv[i + 1], &wrapcharlen);
		wrapchar = Tcl_GetStringFromObj(objv[i + 1], &wrapcharlen);
	    }
	    break;
	}
    }
    if (wrapcharlen == 0) {
	maxlen = 0;
    }
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
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







-
+











+
-
+







		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
			"LINE_LENGTH", (void *)NULL);
		return TCL_ERROR;
	    }
	    lineLength = ((lineLength - 1) & -4) + 1; /* 5, 9, 13 ... */
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = (const unsigned char *)TclGetStringFromObj(
	    wrapchar = (const unsigned char *)Tcl_GetStringFromObj(
		    objv[i + 1], &wrapcharlen);
	    {
		const unsigned char *p = wrapchar;
		Tcl_Size numBytes = wrapcharlen;

		while (numBytes) {
		    switch (*p) {
			case '\t':
			case '\v':
			case '\f':
			case '\r':
			    p++;
			    p++; numBytes--;
			    numBytes--;
			    continue;
			case '\n':
			    numBytes--;
			    break;
			default:
			badwrap:
			    Tcl_SetObjResult(interp, Tcl_NewStringObj(
2912
2913
2914
2915
2916
2917
2918
2919

2920
2921
2922
2923
2924
2925
2926
2898
2899
2900
2901
2902
2903
2904

2905
2906
2907
2908
2909
2910
2911
2912







-
+







	}
    }

    TclNewObj(resultObj);
    data = Tcl_GetBytesFromObj(NULL, objv[objc - 1], &count);
    if (data == NULL) {
	pure = 0;
	data = (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count);
	data = (unsigned char *) Tcl_GetStringFromObj(objv[objc - 1], &count);
    }
    datastart = data;
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    lineLen = -1;

3087
3088
3089
3090
3091
3092
3093
3094

3095
3096
3097
3098
3099
3100
3101
3073
3074
3075
3076
3077
3078
3079

3080
3081
3082
3083
3084
3085
3086
3087







-
+







	}
    }

    TclNewObj(resultObj);
    data = Tcl_GetBytesFromObj(NULL, objv[objc - 1], &count);
    if (data == NULL) {
	pure = 0;
	data = (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count);
	data = (unsigned char *) Tcl_GetStringFromObj(objv[objc - 1], &count);
    }
    datastart = data;
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	unsigned long value = 0;
Changes to generic/tclCkalloc.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16


















17
18
19
20
21
22
23
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

-
-
-
-
-
-









+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclCkalloc.c --
 *
 *    Interface to malloc and free that provides support for debugging
 *    problems involving overwritten, double freeing memory and loss of
 *    memory.
 *
 * Copyright © 1991-1994 The Regents of the University of California.
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 * Copyright © 1998-1999 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * This code contributed by Karl Lehenbauer and Mark Diekhans
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclCkalloc.c --
 *
 *    Interface to malloc and free that provides support for debugging
 *    problems involving overwritten, double freeing memory and loss of
 *    memory.
 *
*/

#include "tclInt.h"
#include <assert.h>

#define FALSE	0
#define TRUE	1

443
444
445
446
447
448
449
450

451
452
453
454
455
456
457
455
456
457
458
459
460
461

462
463
464
465
466
467
468
469







-
+







		total_mallocs);
	fflush(stderr);
	alloc_tracing = TRUE;
	trace_on_at_malloc = 0;
    }

    if (alloc_tracing) {
	fprintf(stderr,"Tcl_Alloc %p %" TCL_Z_MODIFIER "u %s %d\n",
	fprintf(stderr, "Tcl_Alloc %p %" TCL_Z_MODIFIER "u %s %d\n",
		result->body, size, file, line);
    }

    if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
	break_on_malloc = 0;
	(void) fflush(stdout);
	Tcl_Panic("reached malloc break limit (%" TCL_Z_MODIFIER "u)", total_mallocs);
532
533
534
535
536
537
538
539

540
541
542
543
544
545
546
544
545
546
547
548
549
550

551
552
553
554
555
556
557
558







-
+







		total_mallocs);
	fflush(stderr);
	alloc_tracing = TRUE;
	trace_on_at_malloc = 0;
    }

    if (alloc_tracing) {
	fprintf(stderr,"Tcl_Alloc %p %" TCL_Z_MODIFIER "u %s %d\n",
	fprintf(stderr, "Tcl_Alloc %p %" TCL_Z_MODIFIER "u %s %d\n",
		result->body, size, file, line);
    }

    if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
	break_on_malloc = 0;
	(void) fflush(stdout);
	Tcl_Panic("reached malloc break limit (%" TCL_Z_MODIFIER "u)", total_mallocs);
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
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







-
+










-
+













-
+







	if (result != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s",
		    TclGetString(objv[2]), Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]),"break_on_malloc") == 0) {
    if (strcmp(TclGetString(objv[1]), "break_on_malloc") == 0) {
	Tcl_WideInt value;
	if (objc != 3) {
	    goto argError;
	}
	if (TclGetWideIntFromObj(interp, objv[2], &value) != TCL_OK) {
	    return TCL_ERROR;
	}
	break_on_malloc = value;
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]),"info") == 0) {
    if (strcmp(TclGetString(objv[1]), "info") == 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n",
		"total mallocs", total_mallocs, "total frees", total_frees,
		"current packets allocated", current_malloc_packets,
		"current bytes allocated", current_bytes_malloced,
		"maximum packets allocated", maximum_malloc_packets,
		"maximum bytes allocated", maximum_bytes_malloced));
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]), "init") == 0) {
	if (objc != 3) {
	    goto bad_suboption;
	}
	init_malloced_bodies = (strcmp(TclGetString(objv[2]),"on") == 0);
	init_malloced_bodies = (strcmp(TclGetString(objv[2]), "on") == 0);
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]), "objs") == 0) {
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "file");
	    return TCL_ERROR;
	}
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
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







-
+









-
+



-
+













-
+



-
+



-
+










-
+



-
+







	    return TCL_ERROR;
	}
	TclDbDumpActiveObjects(fileP);
	fclose(fileP);
	Tcl_DStringFree(&buffer);
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]),"onexit") == 0) {
    if (strcmp(TclGetString(objv[1]), "onexit") == 0) {
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "file");
	    return TCL_ERROR;
	}
	fileName = Tcl_TranslateFileName(interp, TclGetString(objv[2]), &buffer);
	if (fileName == NULL) {
	    return TCL_ERROR;
	}
	onExitMemDumpFileName = dumpFile;
	strcpy(onExitMemDumpFileName,fileName);
	strcpy(onExitMemDumpFileName, fileName);
	Tcl_DStringFree(&buffer);
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]),"tag") == 0) {
    if (strcmp(TclGetString(objv[1]), "tag") == 0) {
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "file");
	    return TCL_ERROR;
	}
	if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) {
	    TclpFree(curTagPtr);
	}
	len = strlen(TclGetString(objv[2]));
	curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(len));
	curTagPtr->refCount = 0;
	memcpy(curTagPtr->string, TclGetString(objv[2]), len + 1);
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]),"trace") == 0) {
    if (strcmp(TclGetString(objv[1]), "trace") == 0) {
	if (objc != 3) {
	    goto bad_suboption;
	}
	alloc_tracing = (strcmp(TclGetString(objv[2]),"on") == 0);
	alloc_tracing = (strcmp(TclGetString(objv[2]), "on") == 0);
	return TCL_OK;
    }

    if (strcmp(TclGetString(objv[1]),"trace_on_at_malloc") == 0) {
    if (strcmp(TclGetString(objv[1]), "trace_on_at_malloc") == 0) {
	Tcl_WideInt value;
	if (objc != 3) {
	    goto argError;
	}
	if (TclGetWideIntFromObj(interp, objv[2], &value) != TCL_OK) {
	    return TCL_ERROR;
	}
	trace_on_at_malloc = value;
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]),"validate") == 0) {
    if (strcmp(TclGetString(objv[1]), "validate") == 0) {
	if (objc != 3) {
	    goto bad_suboption;
	}
	validate_memory = (strcmp(TclGetString(objv[2]),"on") == 0);
	validate_memory = (strcmp(TclGetString(objv[2]), "on") == 0);
	return TCL_OK;
    }

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "bad option \"%s\": should be active, break_on_malloc, info, "
	    "init, objs, onexit, tag, trace, trace_on_at_malloc, or validate",
	    TclGetString(objv[1])));
Changes to generic/tclClock.c.
9
10
11
12
13
14
15










16
17
18
19
20
21
22
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32







+
+
+
+
+
+
+
+
+
+







 * Copyright © 1995 Sun Microsystems, Inc.
 * Copyright © 2004 Kevin B. Kenny. All rights reserved.
 * Copyright © 2015 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/


#include "tclInt.h"
#include "tclTomMath.h"
#include "tclStrIdxTree.h"
#include "tclDate.h"

/*
1524
1525
1526
1527
1528
1529
1530
1531

1532
1533
1534
1535
1536
1537
1538
1534
1535
1536
1537
1538
1539
1540

1541
1542
1543
1544
1545
1546
1547
1548







-
+







    }

    /*
     * fields.seconds could be an unsigned number that overflowed. Make sure
     * that it isn't.
     */

    if (TclHasInternalRep(objv[1], &tclBignumType)) {
    if (TclHasInternalRep(objv[1], tclBignumTypePtr)) {
	Tcl_SetObjResult(interp, lit[LIT_INTEGER_VALUE_TOO_LARGE]);
	return TCL_ERROR;
    }

    /* Extract fields */

    if (ClockGetDateFields(dataPtr, interp, &fields, objv[2],
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
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







-
+

















-
+







	    int idx;

	    if (Tcl_GetIndexFromObj(NULL, baseObj, nowOpts, "seconds",
		    TCL_EXACT, &idx) == TCL_OK) {
		goto baseNow;
	    }

	    if (TclHasInternalRep(baseObj, &tclBignumType)) {
	    if (TclHasInternalRep(baseObj, tclBignumTypePtr)) {
		goto baseOverflow;
	    }

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad seconds \"%s\": must be now or integer",
		TclGetString(baseObj)));
	    i = baseIdx;
	    goto badOption;
	}
	/*
	 * Seconds could be an unsigned number that overflowed. Make sure
	 * that it isn't. Additionally it may be too complex to calculate
	 * julianday etc (forwards/backwards) by too large/small values, thus
	 * just let accept a bit shorter values to avoid overflow.
	 * Note the year is currently an integer, thus avoid to overflow it also.
	 */

	if (TclHasInternalRep(baseObj, &tclBignumType)
	if (TclHasInternalRep(baseObj, tclBignumTypePtr)
		|| baseVal < TCL_MIN_SECONDS || baseVal > TCL_MAX_SECONDS) {
	baseOverflow:
	    Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]);
	    i = baseIdx;
	    goto badOption;
	}
    } else {
4426
4427
4428
4429
4430
4431
4432
4433

4434
4435
4436
4437
4438
4439
4440
4436
4437
4438
4439
4440
4441
4442

4443
4444
4445
4446
4447
4448
4449
4450







-
+







	    continue;
	}
	/* get unit */
	if (Tcl_GetIndexFromObj(interp, objv[i + 1], units, "unit", 0,
		&unitIndex) != TCL_OK) {
	    goto done;
	}
	if (TclHasInternalRep(objv[i], &tclBignumType)
	if (TclHasInternalRep(objv[i], tclBignumTypePtr)
		|| offs > (unitIndex < CLC_ADD_HOURS ? 0x7fffffff : TCL_MAX_SECONDS)
		|| offs < (unitIndex < CLC_ADD_HOURS ? -0x7fffffff : TCL_MIN_SECONDS)) {
	    Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]);
	    goto done;
	}

	/* nothing to do if zero quantity */
Added generic/tclClockClassic.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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * Copyright © 1991-1995 Karl Lehenbauer & Mark Diekhans.
 * Copyright © 1995 Sun Microsystems, Inc.
 * Copyright © 2004 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclClockClassic.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.
 */

#include "tclInt.h"
#include "tclTomMath.h"

/*
 * Windows has mktime. The configurators do not check.
 */

#ifdef _WIN32
#define HAVE_MKTIME 1
#endif

/*
 * Constants
 */

#define JULIAN_DAY_POSIX_EPOCH		2440588
#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 */

/*
 * Table of the days in each month, leap and common years
 */

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]
 */

typedef enum ClockLiteral {
    LIT__NIL,
    LIT__DEFAULT_FORMAT,
    LIT_BCE,		LIT_C,
    LIT_CANNOT_USE_GMT_AND_TIMEZONE,
    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__END
} ClockLiteral;
static const char *const literals[] = {
    "",
    "%a %b %d %H:%M:%S %Z %Y",
    "BCE",		"C",
    "cannot use -gmt and -timezone in same call",
    "CE",
    "dayOfMonth",	"dayOfWeek",		"dayOfYear",
    "era",		":GMT",			"gregorian",
    "integer value too large to represent",
    "iso8601Week",	"iso8601Year",
    "julianDay",	"localSeconds",
    "month",
    "seconds",		"tzName",		"tzOffset",
    "year"
};

/*
 * Structure containing the client data for [clock]
 */

typedef struct {
    size_t refCount;		/* Number of live references. */
    Tcl_Obj **literals;		/* Pool of object literals. */
} ClockClientData;

/*
 * Structure containing the fields used in [clock format] and [clock scan]
 */

typedef struct {
    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 */
    Tcl_Obj *tzName;		/* Time zone name */
    int julianDay;		/* Julian Day Number in local time zone */
    int isBce;			/* 1 if BCE */
    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 */
} TclDateFields;
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		ConvertUTCToLocal(Tcl_Interp *,
			    TclDateFields *, Tcl_Obj *, int);
static int		ConvertUTCToLocalUsingTable(Tcl_Interp *,
			    TclDateFields *, Tcl_Size, Tcl_Obj *const[]);
static int		ConvertUTCToLocalUsingC(Tcl_Interp *,
			    TclDateFields *, int);
static int		ConvertLocalToUTC(Tcl_Interp *,
			    TclDateFields *, Tcl_Obj *, int);
static int		ConvertLocalToUTCUsingTable(Tcl_Interp *,
			    TclDateFields *, Tcl_Size, Tcl_Obj *const[]);
static int		ConvertLocalToUTCUsingC(Tcl_Interp *,
			    TclDateFields *, int);
static Tcl_Obj *	LookupLastTransition(Tcl_Interp *, Tcl_WideInt,
			    Tcl_Size, Tcl_Obj *const *);
static void		GetYearWeekDay(TclDateFields *, int);
static void		GetGregorianEraYearDay(TclDateFields *, int);
static void		GetMonthDay(TclDateFields *);
static void		GetJulianDayFromEraYearWeekDay(TclDateFields *, int);
static void		GetJulianDayFromEraYearMonthDay(TclDateFields *, int);
static int		IsGregorianLeapYear(TclDateFields *);
static Tcl_WideInt	WeekdayOnOrBefore(int, Tcl_WideInt);
static Tcl_ObjCmdProc ClockClicksObjCmd;
static Tcl_ObjCmdProc ClockConvertlocaltoutcObjCmd;
static Tcl_ObjCmdProc ClockGetdatefieldsObjCmd;
static Tcl_ObjCmdProc ClockGetjuliandayfromerayearmonthdayObjCmd;
static Tcl_ObjCmdProc ClockGetjuliandayfromerayearweekdayObjCmd;
static Tcl_ObjCmdProc ClockGetenvObjCmd;
static Tcl_ObjCmdProc ClockMicrosecondsObjCmd;
static Tcl_ObjCmdProc ClockMillisecondsObjCmd;
static Tcl_ObjCmdProc ClockParseformatargsObjCmd;
static Tcl_ObjCmdProc ClockSecondsObjCmd;
static struct tm *	ThreadSafeLocalTime(const time_t *);
static void		TzsetIfNecessary(void);
static void		ClockDeleteCmdProc(void *);

/*
 * Structure containing description of "native" clock commands to create.
 */

struct ClockCommand {
    const char *name;		/* The tail of the command name. The full name
				 * is "<clockns>::<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. */
};

static const struct ClockCommand clockCommands[] = {
    {"getenv",			ClockGetenvObjCmd},
    {"Oldscan",		TclClockOldscanObjCmd},
    {"ConvertLocalToUTC",	ClockConvertlocaltoutcObjCmd},
    {"GetDateFields",		ClockGetdatefieldsObjCmd},
    {"GetJulianDayFromEraYearMonthDay",
		ClockGetjuliandayfromerayearmonthdayObjCmd},
    {"GetJulianDayFromEraYearWeekDay",
		ClockGetjuliandayfromerayearweekdayObjCmd},
    {"ParseFormatArgs",	ClockParseformatargsObjCmd},
    {NULL, NULL}
};

/*
 *----------------------------------------------------------------------
 *
 * TclClockClassicInit --
 *
 *	Registers the 'clock' subcommands with the Tcl interpreter and
 *	initializes its client data (which consists mostly of constant
 *	Tcl_Obj's that it is too much trouble to keep recreating).
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Installs the commands and creates the client data
 *
 *----------------------------------------------------------------------
 */

void
TclClockClassicInit(
    Tcl_Interp *interp)		/* Tcl interpreter */
{
    const struct ClockCommand *clockCmdPtr;
    char cmdName[57];		/* Buffer large enough to hold the string
				 *::tcl::clock::classic::GetJulianDayFromEraYearMonthDay
				 * plus a terminating NUL. */
    ClockClientData *data;
    int i;

    /* Structure of the 'clock' ensemble */

    static const EnsembleImplMap clockImplMap[] = {
	{"add",          NULL,                    TclCompileBasicMin1ArgCmd, NULL, NULL,       0},
	{"clicks",       ClockClicksObjCmd,       TclCompileClockClicksCmd,  NULL, NULL,       0},
	{"format",       NULL,                    TclCompileBasicMin1ArgCmd, NULL, NULL,       0},
	{"microseconds", ClockMicrosecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(1), 0},
	{"milliseconds", ClockMillisecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(2), 0},
	{"scan",         NULL,                    TclCompileBasicMin1ArgCmd, NULL, NULL      , 0},
	{"seconds",      ClockSecondsObjCmd,      TclCompileClockReadingCmd, NULL, INT2PTR(3), 0},
	{NULL,           NULL,                    NULL,                      NULL, NULL,       0}
    };

    /*
     * Safe interps get [::clock] as alias to a parent, 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 = (ClockClientData *)Tcl_Alloc(sizeof(ClockClientData));
    data->refCount = 0;
    data->literals = (Tcl_Obj **)Tcl_Alloc(LIT__END * sizeof(Tcl_Obj*));
    for (i = 0; i < LIT__END; ++i) {
	data->literals[i] = Tcl_NewStringObj(literals[i], -1);
	Tcl_IncrRefCount(data->literals[i]);
    }

    /*
     * Install the commands.
     * TODO - Let Tcl_MakeEnsemble do this?
     */

#define TCL_CLOCK_PREFIX_LEN 23 /* == strlen("::tcl::clock::classic::") */
    memcpy(cmdName, "::tcl::clock::classic::", TCL_CLOCK_PREFIX_LEN);
    for (clockCmdPtr=clockCommands ; clockCmdPtr->name!=NULL ; clockCmdPtr++) {
	strcpy(cmdName + TCL_CLOCK_PREFIX_LEN, clockCmdPtr->name);
	data->refCount++;
	Tcl_CreateObjCommand(interp, cmdName, clockCmdPtr->objCmdProc, data,
		ClockDeleteCmdProc);
    }

    /* Make the clock ensemble */

    TclMakeEnsemble(interp, "::tcl::clock::classic", clockImplMap);
}

/*
 *----------------------------------------------------------------------
 *
 * ClockConvertlocaltoutcObjCmd --
 *
 *	Tcl command that converts a UTC time to a local time by whatever means
 *	is available.
 *
 * Usage:
 *	ConvertUTCToLocal dictionary tzdata changeover
 *
 * Parameters:
 *	dict - Dictionary containing a 'localSeconds' entry.
 *	tzdata - Time zone data
 *	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
 *	augmented with a 'seconds' field giving the UTC time. On failure,
 *	leaves an error message in the interpreter result.
 *
 *----------------------------------------------------------------------
 */

static int
ClockConvertlocaltoutcObjCmd(
    void *clientData,	/* Client data */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter vector */
{
    ClockClientData *data = (ClockClientData *)clientData;
    Tcl_Obj *secondsObj;
    Tcl_Obj *dict;
    int changeover;
    TclDateFields fields;
    int created = 0;
    int status;

    /*
     * Check params and convert time.
     */

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "dict tzdata changeover");
	return TCL_ERROR;
    }
    dict = objv[1];
    if (Tcl_DictObjGet(interp, dict, data->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(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.
     */

    if (Tcl_IsShared(dict)) {
	dict = Tcl_DuplicateObj(dict);
	created = 1;
	Tcl_IncrRefCount(dict);
    }
    status = Tcl_DictObjPut(interp, dict, data->literals[LIT_SECONDS],
	    Tcl_NewWideIntObj(fields.seconds));
    if (status == TCL_OK) {
	Tcl_SetObjResult(interp, dict);
    }
    if (created) {
	Tcl_DecrRefCount(dict);
    }
    return status;
}

/*
 *----------------------------------------------------------------------
 *
 * ClockGetdatefieldsObjCmd --
 *
 *	Tcl command that determines the values that [clock format] will use in
 *	formatting a date, and populates a dictionary with them.
 *
 * Usage:
 *	GetDateFields seconds tzdata changeover
 *
 * Parameters:
 *	seconds - Time expressed in seconds from the Posix epoch.
 *	tzdata - Time zone data of the 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
 *			       local time zone.
 *		tzOffset - Time zone offset in seconds east of Greenwich
 *		tzName - Time zone name
 *		julianDay - Julian Day Number in the local time zone
 *
 *----------------------------------------------------------------------
 */

static int
ClockGetdatefieldsObjCmd(
    void *clientData,	/* Opaque pointer to literal pool, etc. */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter vector */
{
    TclDateFields fields;
    Tcl_Obj *dict;
    ClockClientData *data = (ClockClientData *)clientData;
    Tcl_Obj *const *lit = data->literals;
    int changeover;

    /*
     * Check params.
     */

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "seconds tzdata 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 (TclHasInternalRep(objv[1], tclBignumTypePtr)) {
	Tcl_SetObjResult(interp, lit[LIT_INTEGER_VALUE_TOO_LARGE]);
	return TCL_ERROR;
    }

    /*
     * Convert UTC time to local.
     */

    if (ConvertUTCToLocal(interp, &fields, objv[2], changeover) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Extract Julian day. Always round the quotient down by subtracting 1
     * when the remainder is negative (i.e. if the quotient was rounded up).
     */

    fields.julianDay = (int) ((fields.localSeconds / SECONDS_PER_DAY) -
	    ((fields.localSeconds % SECONDS_PER_DAY) < 0) +
	    JULIAN_DAY_POSIX_EPOCH);

    /*
     * Convert to Julian or Gregorian calendar.
     */

    GetGregorianEraYearDay(&fields, changeover);
    GetMonthDay(&fields);
    GetYearWeekDay(&fields, changeover);

    dict = Tcl_NewDictObj();
    Tcl_DictObjPut(NULL, dict, lit[LIT_LOCALSECONDS],
	    Tcl_NewWideIntObj(fields.localSeconds));
    Tcl_DictObjPut(NULL, dict, lit[LIT_SECONDS],
	    Tcl_NewWideIntObj(fields.seconds));
    Tcl_DictObjPut(NULL, dict, lit[LIT_TZNAME], fields.tzName);
    Tcl_DecrRefCount(fields.tzName);
    Tcl_DictObjPut(NULL, dict, lit[LIT_TZOFFSET],
	    Tcl_NewWideIntObj(fields.tzOffset));
    Tcl_DictObjPut(NULL, dict, lit[LIT_JULIANDAY],
	    Tcl_NewWideIntObj(fields.julianDay));
    Tcl_DictObjPut(NULL, dict, lit[LIT_GREGORIAN],
	    Tcl_NewWideIntObj(fields.gregorian));
    Tcl_DictObjPut(NULL, dict, lit[LIT_ERA],
	    lit[fields.isBce ? LIT_BCE : LIT_CE]);
    Tcl_DictObjPut(NULL, dict, lit[LIT_YEAR],
	    Tcl_NewWideIntObj(fields.year));
    Tcl_DictObjPut(NULL, dict, lit[LIT_DAYOFYEAR],
	    Tcl_NewWideIntObj(fields.dayOfYear));
    Tcl_DictObjPut(NULL, dict, lit[LIT_MONTH],
	    Tcl_NewWideIntObj(fields.month));
    Tcl_DictObjPut(NULL, dict, lit[LIT_DAYOFMONTH],
	    Tcl_NewWideIntObj(fields.dayOfMonth));
    Tcl_DictObjPut(NULL, dict, lit[LIT_ISO8601YEAR],
	    Tcl_NewWideIntObj(fields.iso8601Year));
    Tcl_DictObjPut(NULL, dict, lit[LIT_ISO8601WEEK],
	    Tcl_NewWideIntObj(fields.iso8601Week));
    Tcl_DictObjPut(NULL, dict, lit[LIT_DAYOFWEEK],
	    Tcl_NewWideIntObj(fields.dayOfWeek));
    Tcl_SetObjResult(interp, dict);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ClockGetjuliandayfromerayearmonthdayObjCmd --
 *
 *	Tcl command that converts a time from era-year-month-day to a Julian
 *	Day Number.
 *
 * Parameters:
 *	dict - Dictionary that contains 'era', 'year', 'month' and
 *	       'dayOfMonth' keys.
 *	changeover - Julian Day of changeover to the Gregorian calendar
 *
 * Results:
 *	Result is either TCL_OK, with the interpreter result being the
 *	dictionary augmented with a 'julianDay' key, or TCL_ERROR,
 *	with the result being an error message.
 *
 *----------------------------------------------------------------------
 */

static int
FetchEraField(
    Tcl_Interp *interp,
    Tcl_Obj *dict,
    Tcl_Obj *key,
    int *storePtr)
{
    Tcl_Obj *value = NULL;

    if (Tcl_DictObjGet(interp, dict, key, &value) != TCL_OK) {
	return TCL_ERROR;
    }
    if (value == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"expected key(s) not found in dictionary", -1));
	return TCL_ERROR;
    }
    return Tcl_GetIndexFromObj(interp, value, eras, "era", TCL_EXACT, storePtr);
}

static int
FetchIntField(
    Tcl_Interp *interp,
    Tcl_Obj *dict,
    Tcl_Obj *key,
    int *storePtr)
{
    Tcl_Obj *value = NULL;

    if (Tcl_DictObjGet(interp, dict, key, &value) != TCL_OK) {
	return TCL_ERROR;
    }
    if (value == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"expected key(s) not found in dictionary", -1));
	return TCL_ERROR;
    }
    return TclGetIntFromObj(interp, value, storePtr);
}

static int
ClockGetjuliandayfromerayearmonthdayObjCmd(
    void *clientData,	/* Opaque pointer to literal pool, etc. */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter vector */
{
    TclDateFields fields;
    Tcl_Obj *dict;
    ClockClientData *data = (ClockClientData *)clientData;
    Tcl_Obj *const *lit = data->literals;
    int changeover;
    int copied = 0;
    int status;
    int isBce = 0;

    /*
     * Check params.
     */

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dict changeover");
	return TCL_ERROR;
    }
    dict = objv[1];
    if (FetchEraField(interp, dict, lit[LIT_ERA], &isBce) != TCL_OK
	    || FetchIntField(interp, dict, lit[LIT_YEAR], &fields.year)
		!= TCL_OK
	    || FetchIntField(interp, dict, lit[LIT_MONTH], &fields.month)
		!= TCL_OK
	    || FetchIntField(interp, dict, lit[LIT_DAYOFMONTH],
		&fields.dayOfMonth) != TCL_OK
	    || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
	return TCL_ERROR;
    }
    fields.isBce = isBce;

    /*
     * Get Julian day.
     */

    GetJulianDayFromEraYearMonthDay(&fields, changeover);

    /*
     * Store Julian day in the dictionary - copy on write.
     */

    if (Tcl_IsShared(dict)) {
	dict = Tcl_DuplicateObj(dict);
	Tcl_IncrRefCount(dict);
	copied = 1;
    }
    status = Tcl_DictObjPut(interp, dict, lit[LIT_JULIANDAY],
	    Tcl_NewWideIntObj(fields.julianDay));
    if (status == TCL_OK) {
	Tcl_SetObjResult(interp, dict);
    }
    if (copied) {
	Tcl_DecrRefCount(dict);
    }
    return status;
}

/*
 *----------------------------------------------------------------------
 *
 * ClockGetjuliandayfromerayearweekdayObjCmd --
 *
 *	Tcl command that converts a time from the ISO calendar to a Julian Day
 *	Number.
 *
 * Parameters:
 *	dict - Dictionary that contains 'era', 'iso8601Year', 'iso8601Week'
 *	       and 'dayOfWeek' keys.
 *	changeover - Julian Day of changeover to the Gregorian calendar
 *
 * Results:
 *	Result is either TCL_OK, with the interpreter result being the
 *	dictionary augmented with a 'julianDay' key, or TCL_ERROR, with the
 *	result being an error message.
 *
 *----------------------------------------------------------------------
 */

static int
ClockGetjuliandayfromerayearweekdayObjCmd(
    void *clientData,	/* Opaque pointer to literal pool, etc. */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter vector */
{
    TclDateFields fields;
    Tcl_Obj *dict;
    ClockClientData *data = (ClockClientData *)clientData;
    Tcl_Obj *const *lit = data->literals;
    int changeover;
    int copied = 0;
    int status;
    int isBce = 0;

    /*
     * Check params.
     */

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dict changeover");
	return TCL_ERROR;
    }
    dict = objv[1];
    if (FetchEraField(interp, dict, lit[LIT_ERA], &isBce) != TCL_OK
	    || FetchIntField(interp, dict, lit[LIT_ISO8601YEAR],
		&fields.iso8601Year) != TCL_OK
	    || FetchIntField(interp, dict, lit[LIT_ISO8601WEEK],
		&fields.iso8601Week) != TCL_OK
	    || FetchIntField(interp, dict, lit[LIT_DAYOFWEEK],
		&fields.dayOfWeek) != TCL_OK
	    || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
	return TCL_ERROR;
    }
    fields.isBce = isBce;

    /*
     * Get Julian day.
     */

    GetJulianDayFromEraYearWeekDay(&fields, changeover);

    /*
     * Store Julian day in the dictionary - copy on write.
     */

    if (Tcl_IsShared(dict)) {
	dict = Tcl_DuplicateObj(dict);
	Tcl_IncrRefCount(dict);
	copied = 1;
    }
    status = Tcl_DictObjPut(interp, dict, lit[LIT_JULIANDAY],
	    Tcl_NewWideIntObj(fields.julianDay));
    if (status == TCL_OK) {
	Tcl_SetObjResult(interp, dict);
    }
    if (copied) {
	Tcl_DecrRefCount(dict);
    }
    return status;
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertLocalToUTC --
 *
 *	Converts a time (in a TclDateFields structure) from the local wall
 *	clock to UTC.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Populates the 'seconds' field if successful; stores an error message
 *	in the interpreter result on failure.
 *
 *----------------------------------------------------------------------
 */

static int
ConvertLocalToUTC(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Fields of the time */
    Tcl_Obj *tzdata,		/* Time zone data */
    int changeover)		/* Julian Day of the Gregorian transition */
{
    Tcl_Size rowc;			/* Number of rows in tzdata */
    Tcl_Obj **rowv;		/* Pointers to the rows */

    /*
     * Unpack the tz data.
     */

    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) {
	return ConvertLocalToUTCUsingC(interp, fields, changeover);
    } else {
	return ConvertLocalToUTCUsingTable(interp, fields, rowc, rowv);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertLocalToUTCUsingTable --
 *
 *	Converts a time (in a TclDateFields structure) from local time in a
 *	given time zone to UTC.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Stores an error message in the interpreter if an error occurs; if
 *	successful, stores the 'seconds' field in 'fields.
 *
 *----------------------------------------------------------------------
 */

static int
ConvertLocalToUTCUsingTable(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Time to convert, with 'seconds' filled in */
    Tcl_Size rowc,			/* Number of points at which time changes */
    Tcl_Obj *const rowv[])	/* Points at which time changes */
{
    Tcl_Obj *row;
    Tcl_Size cellc;
    Tcl_Obj **cellv;
    int have[8];
    int nHave = 0;
    int i;
    int found;

    /*
     * Perform an initial lookup assuming that local == UTC, and locate the
     * last time conversion prior to that time. Get the offset from that row,
     * and look up again. Continue until we find an offset that we found
     * before. This definition, rather than "the same offset" ensures that we
     * don't enter an endless loop, as would otherwise happen when trying to
     * convert a non-existent time such as 02:30 during the US Spring Daylight
     * Saving Time transition.
     */

    found = 0;
    fields->tzOffset = 0;
    fields->seconds = fields->localSeconds;
    while (!found) {
	row = LookupLastTransition(interp, fields->seconds, rowc, rowv);
	if ((row == NULL)
		|| TclListObjGetElements(interp, row, &cellc,
		    &cellv) != TCL_OK
		|| TclGetIntFromObj(interp, cellv[1],
		    &fields->tzOffset) != TCL_OK) {
	    return TCL_ERROR;
	}
	found = 0;
	for (i = 0; !found && i < nHave; ++i) {
	    if (have[i] == fields->tzOffset) {
		found = 1;
		break;
	    }
	}
	if (!found) {
	    if (nHave == 8) {
		Tcl_Panic("loop in ConvertLocalToUTCUsingTable");
	    }
	    have[nHave++] = fields->tzOffset;
	}
	fields->seconds = fields->localSeconds - fields->tzOffset;
    }
    fields->tzOffset = have[i];
    fields->seconds = fields->localSeconds - fields->tzOffset;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertLocalToUTCUsingC --
 *
 *	Converts a time from local wall clock to UTC when the local time zone
 *	cannot be determined. Uses 'mktime' to do the job.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Stores an error message in the interpreter if an error occurs; if
 *	successful, stores the 'seconds' field in 'fields.
 *
 *----------------------------------------------------------------------
 */

static int
ConvertLocalToUTCUsingC(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Time to convert, with 'seconds' filled in */
    int changeover)		/* Julian Day of the Gregorian transition */
{
    struct tm timeVal;
    int localErrno;
    int secondOfDay;
    Tcl_WideInt jsec;

    /*
     * Convert the given time to a date.
     */

    jsec = fields->localSeconds + JULIAN_SEC_POSIX_EPOCH;
    fields->julianDay = (int) (jsec / SECONDS_PER_DAY);
    secondOfDay = (int)(jsec % SECONDS_PER_DAY);
    if (secondOfDay < 0) {
	secondOfDay += SECONDS_PER_DAY;
	fields->julianDay--;
    }
    GetGregorianEraYearDay(fields, changeover);
    GetMonthDay(fields);

    /*
     * Convert the date/time to a 'struct tm'.
     */

    timeVal.tm_year = fields->year - 1900;
    timeVal.tm_mon = fields->month - 1;
    timeVal.tm_mday = fields->dayOfMonth;
    timeVal.tm_hour = (secondOfDay / 3600) % 24;
    timeVal.tm_min = (secondOfDay / 60) % 60;
    timeVal.tm_sec = secondOfDay % 60;
    timeVal.tm_isdst = -1;
    timeVal.tm_wday = -1;
    timeVal.tm_yday = -1;

    /*
     * Get local time. It is rumored that mktime is not thread safe on some
     * platforms, so seize a mutex before attempting this.
     */

    TzsetIfNecessary();
    Tcl_MutexLock(&clockMutex);
    errno = 0;
    fields->seconds = (Tcl_WideInt) mktime(&timeVal);
    localErrno = (fields->seconds == -1) ? errno : 0;
    Tcl_MutexUnlock(&clockMutex);

    /*
     * If conversion fails, report an error.
     */

    if (localErrno != 0
	    || (fields->seconds == -1 && timeVal.tm_yday == -1)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"time value too large/small to represent", -1));
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertUTCToLocal --
 *
 *	Converts a time (in a TclDateFields structure) from UTC to local time.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Populates the 'tzName' and 'tzOffset' fields.
 *
 *----------------------------------------------------------------------
 */

static int
ConvertUTCToLocal(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Fields of the time */
    Tcl_Obj *tzdata,		/* Time zone data */
    int changeover)		/* Julian Day of the Gregorian transition */
{
    Tcl_Size rowc;			/* Number of rows in tzdata */
    Tcl_Obj **rowv;		/* Pointers to the rows */

    /*
     * Unpack the tz data.
     */

    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) {
	return ConvertUTCToLocalUsingC(interp, fields, changeover);
    } else {
	return ConvertUTCToLocalUsingTable(interp, fields, rowc, rowv);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertUTCToLocalUsingTable --
 *
 *	Converts UTC to local time, given a table of transition points
 *
 * Results:
 *	Returns a standard Tcl result
 *
 * Side effects:
 *	On success, fills fields->tzName, fields->tzOffset and
 *	fields->localSeconds. On failure, places an error message in the
 *	interpreter result.
 *
 *----------------------------------------------------------------------
 */

static int
ConvertUTCToLocalUsingTable(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Fields of the date */
    Tcl_Size rowc,			/* Number of rows in the conversion table
				 * (>= 1) */
    Tcl_Obj *const rowv[])	/* Rows of the conversion table */
{
    Tcl_Obj *row;		/* Row containing the current information */
    Tcl_Size 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);
    if (row == NULL ||
	    TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK ||
	    TclGetIntFromObj(interp, cellv[1], &fields->tzOffset) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Convert the time.
     */

    fields->tzName = cellv[3];
    Tcl_IncrRefCount(fields->tzName);
    fields->localSeconds = fields->seconds + fields->tzOffset;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertUTCToLocalUsingC --
 *
 *	Converts UTC to localtime in cases where the local time zone is not
 *	determinable, using the C 'localtime' function to do it.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	On success, fills fields->tzName, fields->tzOffset and
 *	fields->localSeconds. On failure, places an error message in the
 *	interpreter result.
 *
 *----------------------------------------------------------------------
 */

static int
ConvertUTCToLocalUsingC(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Time to convert, with 'seconds' filled in */
    int changeover)		/* Julian Day of the Gregorian transition */
{
    time_t tock;
    struct tm *timeVal;		/* Time after conversion */
    int diff;			/* Time zone diff local-Greenwich */
    char buffer[16];		/* Buffer for time zone name */

    /*
     * Use 'localtime' to determine local year, month, day, time of day.
     */

    tock = (time_t) fields->seconds;
    if ((Tcl_WideInt) tock != fields->seconds) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"number too large to represent as a Posix time", -1));
	Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", (char *)NULL);
	return TCL_ERROR;
    }
    TzsetIfNecessary();
    timeVal = ThreadSafeLocalTime(&tock);
    if (timeVal == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"localtime failed (clock value may be too "
		"large/small to represent)", -1));
	Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * Fill in the date in 'fields' and use it to derive Julian Day.
     */

    fields->isBce = 0;
    fields->year = timeVal->tm_year + 1900;
    fields->month = timeVal->tm_mon + 1;
    fields->dayOfMonth = timeVal->tm_mday;
    GetJulianDayFromEraYearMonthDay(fields, changeover);

    /*
     * Convert that value to seconds.
     */

    fields->localSeconds = (((fields->julianDay * (Tcl_WideInt) 24
	    + timeVal->tm_hour) * 60 + timeVal->tm_min) * 60
	    + timeVal->tm_sec) - JULIAN_SEC_POSIX_EPOCH;

    /*
     * Determine a time zone offset and name; just use +hhmm for the name.
     */

    diff = (int) (fields->localSeconds - fields->seconds);
    fields->tzOffset = diff;
    if (diff < 0) {
	*buffer = '-';
	diff = -diff;
    } else {
	*buffer = '+';
    }
    snprintf(buffer+1, sizeof(buffer) - 1, "%02d", diff / 3600);
    diff %= 3600;
    snprintf(buffer+3, sizeof(buffer) - 3, "%02d", diff / 60);
    diff %= 60;
    if (diff > 0) {
	snprintf(buffer+5, sizeof(buffer) - 5, "%02d", diff);
    }
    fields->tzName = Tcl_NewStringObj(buffer, -1);
    Tcl_IncrRefCount(fields->tzName);
    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.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
LookupLastTransition(
    Tcl_Interp *interp,		/* Interpreter for error messages */
    Tcl_WideInt tick,		/* Time from the epoch */
    Tcl_Size rowc,			/* Number of rows of tzdata */
    Tcl_Obj *const *rowv)	/* Rows in tzdata */
{
    Tcl_Size l, u;
    Tcl_Obj *compObj;
    Tcl_WideInt compVal;

    /*
     * 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) {
	return rowv[0];
    }

    /*
     * Binary-search to find the transition.
     */

    l = 0;
    u = rowc-1;
    while (l < u) {
	Tcl_Size 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;
	} else {
	    u = m-1;
	}
    }
    return rowv[l];
}

/*
 *----------------------------------------------------------------------
 *
 * GetYearWeekDay --
 *
 *	Given a date with Julian Calendar Day, compute the year, week, and day
 *	in the ISO8601 calendar.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Stores 'iso8601Year', 'iso8601Week' and 'dayOfWeek' in the date
 *	fields.
 *
 *----------------------------------------------------------------------
 */

static void
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;
    GetGregorianEraYearDay(&temp, changeover);
    if (temp.isBce) {
	temp.iso8601Year = temp.year - 1;
    } else {
	temp.iso8601Year = temp.year + 1;
    }
    temp.iso8601Week = 1;
    temp.dayOfWeek = 1;
    GetJulianDayFromEraYearWeekDay(&temp, changeover);

    /*
     * temp.julianDay is now the start of an ISO8601 year, either the one
     * corresponding to the given date, or the one after. If we guessed high,
     * move one year earlier
     */

    if (fields->julianDay < temp.julianDay) {
	if (temp.isBce) {
	    temp.iso8601Year += 1;
	} else {
	    temp.iso8601Year -= 1;
	}
	GetJulianDayFromEraYearWeekDay(&temp, changeover);
    }

    fields->iso8601Year = temp.iso8601Year;
    dayOfFiscalYear = fields->julianDay - temp.julianDay;
    fields->iso8601Week = (dayOfFiscalYear / 7) + 1;
    fields->dayOfWeek = (dayOfFiscalYear + 1) % 7;
    if (fields->dayOfWeek < 1) {
	fields->dayOfWeek += 7;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * GetGregorianEraYearDay --
 *
 *	Given a Julian Day Number, extracts the year and day of the year and
 *	puts them into TclDateFields, along with the era (BCE or CE) and a
 *	flag indicating whether the date is Gregorian or Julian.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Stores 'era', 'gregorian', 'year', and 'dayOfYear'.
 *
 *----------------------------------------------------------------------
 */

static void
GetGregorianEraYearDay(
    TclDateFields *fields,	/* Date fields containing 'julianDay' */
    int changeover)		/* Gregorian transition date */
{
    Tcl_WideInt jday = fields->julianDay;
    Tcl_WideInt day;
    Tcl_WideInt year;
    Tcl_WideInt n;

    if (jday >= changeover) {
	/*
	 * Gregorian calendar.
	 */

	fields->gregorian = 1;
	year = 1;

	/*
	 * n = Number of 400-year cycles since 1 January, 1 CE in the
	 * proleptic Gregorian calendar. day = remaining days.
	 */

	day = jday - JDAY_1_JAN_1_CE_GREGORIAN;
	n = day / FOUR_CENTURIES;
	day %= FOUR_CENTURIES;
	if (day < 0) {
	    day += FOUR_CENTURIES;
	    n--;
	}
	year += 400 * n;

	/*
	 * n = number of centuries since the start of (year);
	 * day = remaining days
	 */

	n = day / ONE_CENTURY_GREGORIAN;
	day %= ONE_CENTURY_GREGORIAN;
	if (n > 3) {
	    /*
	     * 31 December in the last year of a 400-year cycle.
	     */

	    n = 3;
	    day += ONE_CENTURY_GREGORIAN;
	}
	year += 100 * n;
    } else {
	/*
	 * Julian calendar.
	 */

	fields->gregorian = 0;
	year = 1;
	day = jday - JDAY_1_JAN_1_CE_JULIAN;
    }

    /*
     * n = number of 4-year cycles; days = remaining days.
     */

    n = day / FOUR_YEARS;
    day %= FOUR_YEARS;
    if (day < 0) {
	day += FOUR_YEARS;
	n--;
    }
    year += 4 * n;

    /*
     * n = number of years; days = remaining days.
     */

    n = day / ONE_YEAR;
    day %= ONE_YEAR;
    if (n > 3) {
	/*
	 * 31 December of a leap year.
	 */

	n = 3;
	day += 365;
    }
    year += n;

    /*
     * store era/year/day back into fields.
     */

    if (year <= 0) {
	fields->isBce = 1;
	fields->year = 1 - year;
    } else {
	fields->isBce = 0;
	fields->year = year;
    }
    fields->dayOfYear = day + 1;
}

/*
 *----------------------------------------------------------------------
 *
 * GetMonthDay --
 *
 *	Given a date as year and day-of-year, find month and day.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Stores 'month' and 'dayOfMonth' in the 'fields' structure.
 *
 *----------------------------------------------------------------------
 */

static void
GetMonthDay(
    TclDateFields *fields)	/* Date to convert */
{
    int day = fields->dayOfYear;
    int month;
    const int *dipm = daysInPriorMonths[IsGregorianLeapYear(fields)];

    /*
     * Estimate month by calculating `dayOfYear / (365/12)`
     */
    month = (day*12) / dipm[12];
    /* then do forwards backwards correction */
    while (1) {
	if (day > dipm[month]) {
	    if (month >= 11 || day <= dipm[month+1]) {
		break;
	    }
	    month++;
	} else {
	    if (month == 0) {
		break;
	    }
	    month--;
	}
    }
    day -= dipm[month];
    fields->month = month+1;
    fields->dayOfMonth = day;
}

/*
 *----------------------------------------------------------------------
 *
 * GetJulianDayFromEraYearWeekDay --
 *
 *	Given a TclDateFields structure containing era, ISO8601 year, ISO8601
 *	week, and day of week, computes the Julian Day Number.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Stores 'julianDay' in the fields.
 *
 *----------------------------------------------------------------------
 */

static void
GetJulianDayFromEraYearWeekDay(
    TclDateFields *fields,	/* Date to convert */
    int changeover)		/* Julian Day Number of the Gregorian
				 * transition */
{
    Tcl_WideInt firstMonday;	/* Julian day number of week 1, day 1 in the
				 * given year */
    TclDateFields firstWeek;

    /*
     * Find January 4 in the ISO8601 year, which will always be in week 1.
     */

    firstWeek.isBce = fields->isBce;
    firstWeek.year = fields->iso8601Year;
    firstWeek.month = 1;
    firstWeek.dayOfMonth = 4;
    GetJulianDayFromEraYearMonthDay(&firstWeek, changeover);

    /*
     * Find Monday of week 1.
     */

    firstMonday = WeekdayOnOrBefore(1, firstWeek.julianDay);

    /*
     * Advance to the given week and day.
     */

    fields->julianDay = firstMonday + 7 * (fields->iso8601Week - 1)
	    + fields->dayOfWeek - 1;
}

/*
 *----------------------------------------------------------------------
 *
 * GetJulianDayFromEraYearMonthDay --
 *
 *	Given era, year, month, and dayOfMonth (in TclDateFields), and the
 *	Gregorian transition date, computes the Julian Day Number.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Stores day number in 'julianDay'
 *
 *----------------------------------------------------------------------
 */

static void
GetJulianDayFromEraYearMonthDay(
    TclDateFields *fields,	/* Date to convert */
    int changeover)		/* Gregorian transition date as a Julian Day */
{
    Tcl_WideInt year, ym1, ym1o4, ym1o100, ym1o400;
    int month, mm1, q, r;

    if (fields->isBce) {
	year = 1 - fields->year;
    } else {
	year = fields->year;
    }

    /*
     * Reduce month modulo 12.
     */

    month = fields->month;
    mm1 = month - 1;
    q = mm1 / 12;
    r = (mm1 % 12);
    if (r < 0) {
	r += 12;
	q -= 1;
    }
    year += q;
    month = r + 1;
    ym1 = year - 1;

    /*
     * Adjust the year after reducing the month.
     */

    fields->gregorian = 1;
    if (year < 1) {
	fields->isBce = 1;
	fields->year = 1-year;
    } else {
	fields->isBce = 0;
	fields->year = year;
    }

    /*
     * Try an initial conversion in the Gregorian calendar.
     */

#if 0 /* BUG https://core.tcl-lang.org/tcl/tktview?name=da340d4f32 */
    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) {
	ym1o100--;
    }
    ym1o400 = ym1 / 400;
    if (ym1 % 400 < 0) {
	ym1o400--;
    }
    fields->julianDay = JDAY_1_JAN_1_CE_GREGORIAN - 1
	    + fields->dayOfMonth
	    + daysInPriorMonths[IsGregorianLeapYear(fields)][month - 1]
	    + (ONE_YEAR * ym1)
	    + ym1o4
	    - ym1o100
	    + ym1o400;

    /*
     * If the resulting date is before the Gregorian changeover, convert in
     * the Julian calendar instead.
     */

    if (fields->julianDay < changeover) {
	fields->gregorian = 0;
	fields->julianDay = JDAY_1_JAN_1_CE_JULIAN - 1
		+ fields->dayOfMonth
		+ daysInPriorMonths[year%4 == 0][month - 1]
		+ (365 * ym1)
		+ 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.
 *
 *----------------------------------------------------------------------
 */

static int
IsGregorianLeapYear(
    TclDateFields *fields)	/* Date to test */
{
    Tcl_WideInt year = fields->year;

    if (fields->isBce) {
	year = 1 - year;
    }
    if (year%4 != 0) {
	return 0;
    } else if (!(fields->gregorian)) {
	return 1;
    } else if (year%400 == 0) {
	return 1;
    } else if (year%100 == 0) {
	return 0;
    } else {
	return 1;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * WeekdayOnOrBefore --
 *
 *	Finds the Julian Day Number of a given day of the week that falls on
 *	or before a given date, expressed as Julian Day Number.
 *
 * Results:
 *	Returns the Julian Day Number
 *
 *----------------------------------------------------------------------
 */

static Tcl_WideInt
WeekdayOnOrBefore(
    int dayOfWeek,		/* Day of week; Sunday == 0 or 7 */
    Tcl_WideInt julianDay)	/* Reference date */
{
    int k = (dayOfWeek + 6) % 7;
    if (k < 0) {
	k += 7;
    }
    return julianDay - ((julianDay - k) % 7);
}

/*
 *----------------------------------------------------------------------
 *
 * ClockGetenvObjCmd --
 *
 *	Tcl command that reads an environment variable from the system
 *
 * Usage:
 *	getEnv NAME
 *
 * Parameters:
 *	NAME - Name of the environment variable desired
 *
 * Results:
 *	Returns a standard Tcl result. Returns an error if the variable does
 *	not exist, with a message left in the interpreter. Returns TCL_OK and
 *	the value of the variable if the variable does exist,
 *
 *----------------------------------------------------------------------
 */

static int
ClockGetenvObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
#ifdef _WIN32
    const WCHAR *varName;
    const WCHAR *varValue;
    Tcl_DString ds;
#else
    const char *varName;
    const char *varValue;
#endif

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
#ifdef _WIN32
    Tcl_DStringInit(&ds);
    varName = Tcl_UtfToWCharDString(TclGetString(objv[1]), -1, &ds);
    varValue = _wgetenv(varName);
    if (varValue == NULL) {
	Tcl_DStringFree(&ds);
    } else {
	Tcl_DStringSetLength(&ds, 0);
	Tcl_WCharToUtfDString(varValue, -1, &ds);
	Tcl_DStringResult(interp, &ds);
    }
#else
    varName = TclGetString(objv[1]);
    varValue = getenv(varName);
    if (varValue != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(varValue, -1));
    }
#endif
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ThreadSafeLocalTime --
 *
 *	Wrapper around the 'localtime' library function to make it thread
 *	safe.
 *
 * Results:
 *	Returns a pointer to a 'struct tm' in thread-specific data.
 *
 * Side effects:
 *	Invokes localtime or localtime_r as appropriate.
 *
 *----------------------------------------------------------------------
 */

static struct tm *
ThreadSafeLocalTime(
    const time_t *timePtr)	/* Pointer to the number of seconds since the
				 * local system's epoch */
{
    /*
     * Get a thread-local buffer to hold the returned time.
     */

    struct tm *tmPtr = (struct tm *)Tcl_GetThreadData(&tmKey, sizeof(struct tm));
#ifdef HAVE_LOCALTIME_R
    tmPtr = localtime_r(timePtr, tmPtr);
#else
    struct tm *sysTmPtr;

    Tcl_MutexLock(&clockMutex);
    sysTmPtr = localtime(timePtr);
    if (sysTmPtr == NULL) {
	Tcl_MutexUnlock(&clockMutex);
	return NULL;
    }
    memcpy(tmPtr, sysTmPtr, sizeof(struct tm));
    Tcl_MutexUnlock(&clockMutex);
#endif
    return tmPtr;
}

/*----------------------------------------------------------------------
 *
 * ClockClicksObjCmd --
 *
 *	Returns a high-resolution counter.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 * This function implements the 'clock clicks' Tcl command. Refer to the user
 * documentation for details on what it does.
 *
 *----------------------------------------------------------------------
 */

static int
ClockClicksObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter values */
{
    static const char *const clicksSwitches[] = {
	"-milliseconds", "-microseconds", NULL
    };
    enum ClicksSwitch {
	CLICKS_MILLIS, CLICKS_MICROS, CLICKS_NATIVE
    };
    int index = CLICKS_NATIVE;
    Tcl_Time now;
    Tcl_WideInt clicks = 0;

    switch (objc) {
    case 1:
	break;
    case 2:
	if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "option", 0,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	break;
    default:
	Tcl_WrongNumArgs(interp, 1, objv, "?-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;
}

/*----------------------------------------------------------------------
 *
 * ClockMillisecondsObjCmd -
 *
 *	Returns a count of milliseconds since the epoch.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 * This function implements the 'clock milliseconds' Tcl command. Refer to the
 * user documentation for details on what it does.
 *
 *----------------------------------------------------------------------
 */

static int
ClockMillisecondsObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter values */
{
    Tcl_Time now;
    Tcl_Obj *timeObj;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    Tcl_GetTime(&now);
    TclNewUIntObj(timeObj, (Tcl_WideUInt)
	    now.sec * 1000 + now.usec / 1000);
    Tcl_SetObjResult(interp, timeObj);
    return TCL_OK;
}

/*----------------------------------------------------------------------
 *
 * ClockMicrosecondsObjCmd -
 *
 *	Returns a count of microseconds since the epoch.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 * This function implements the 'clock microseconds' Tcl command. Refer to the
 * user documentation for details on what it does.
 *
 *----------------------------------------------------------------------
 */

static int
ClockMicrosecondsObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter values */
{
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetMicroseconds()));
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * ClockParseformatargsObjCmd --
 *
 *	Parses the arguments for [clock format].
 *
 * Results:
 *	Returns a standard Tcl result, whose value is a four-element list
 *	comprising the time format, the locale, and the timezone.
 *
 * This function exists because the loop that parses the [clock format]
 * options is a known performance "hot spot", and is implemented in an effort
 * to speed that particular code up.
 *
 *-----------------------------------------------------------------------------
 */

static int
ClockParseformatargsObjCmd(
    void *clientData,	/* Client data containing literal pool */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[])	/* Parameter vector */
{
    ClockClientData *dataPtr = (ClockClientData *)clientData;
    Tcl_Obj **litPtr = dataPtr->literals;
    Tcl_Obj *results[3];	/* Format, locale and timezone */
#define formatObj results[0]
#define localeObj results[1]
#define timezoneObj results[2]
    int gmtFlag = 0;
    static const char *const options[] = { /* Command line options expected */
	"-format",	"-gmt",		"-locale",
	"-timezone",	NULL };
    enum optionInd {
	CLOCK_FORMAT_FORMAT,	CLOCK_FORMAT_GMT,	CLOCK_FORMAT_LOCALE,
	CLOCK_FORMAT_TIMEZONE
    };
    int optionIndex;		/* Index of an option. */
    int saw = 0;		/* Flag == 1 if option was seen already. */
    Tcl_WideInt clockVal;	/* Clock value - just used to parse. */
    int i;

    /*
     * Args consist of a time followed by keyword-value pairs.
     */

    if (objc < 2 || (objc % 2) != 0) {
	Tcl_WrongNumArgs(interp, 0, objv,
		"clock format clockval ?-format string? "
		"?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?");
	Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * Extract values for the keywords.
     */

    formatObj = litPtr[LIT__DEFAULT_FORMAT];
    localeObj = litPtr[LIT_C];
    timezoneObj = litPtr[LIT__NIL];
    for (i = 2; i < objc; i+=2) {
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
		&optionIndex) != TCL_OK) {
	    Tcl_SetErrorCode(interp, "CLOCK", "badOption",
		    TclGetString(objv[i]), (char *)NULL);
	    return TCL_ERROR;
	}
	switch (optionIndex) {
	case CLOCK_FORMAT_FORMAT:
	    formatObj = objv[i+1];
	    break;
	case CLOCK_FORMAT_GMT:
	    if (Tcl_GetBooleanFromObj(interp, objv[i+1], &gmtFlag) != TCL_OK){
		return TCL_ERROR;
	    }
	    break;
	case CLOCK_FORMAT_LOCALE:
	    localeObj = objv[i+1];
	    break;
	case CLOCK_FORMAT_TIMEZONE:
	    timezoneObj = objv[i+1];
	    break;
	}
	saw |= 1 << optionIndex;
    }

    /*
     * Check options.
     */

    if (TclGetWideIntFromObj(interp, objv[1], &clockVal) != TCL_OK) {
	return TCL_ERROR;
    }
    if ((saw & (1 << CLOCK_FORMAT_GMT))
	    && (saw & (1 << CLOCK_FORMAT_TIMEZONE))) {
	Tcl_SetObjResult(interp, litPtr[LIT_CANNOT_USE_GMT_AND_TIMEZONE]);
	Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", (char *)NULL);
	return TCL_ERROR;
    }
    if (gmtFlag) {
	timezoneObj = litPtr[LIT_GMT];
    }

    /*
     * Return options as a list.
     */

    Tcl_SetObjResult(interp, Tcl_NewListObj(3, results));
    return TCL_OK;

#undef timezoneObj
#undef localeObj
#undef formatObj
}


/*----------------------------------------------------------------------
 *
 * ClockSecondsObjCmd -
 *
 *	Returns a count of microseconds since the epoch.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 * This function implements the 'clock seconds' Tcl command. Refer to the user
 * documentation for details on what it does.
 *
 *----------------------------------------------------------------------
 */

static int
ClockSecondsObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter values */
{
    Tcl_Time now;
    Tcl_Obj *timeObj;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    Tcl_GetTime(&now);
    TclNewUIntObj(timeObj, (Tcl_WideUInt)now.sec);

    Tcl_SetObjResult(interp, timeObj);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TzsetIfNecessary --
 *
 *	Calls the tzset() library function if the contents of the TZ
 *	environment variable has changed.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Calls tzset.
 *
 *----------------------------------------------------------------------
 */

#ifdef _WIN32
#define getenv(x) _wgetenv(L##x)
#else
#define WCHAR char
#define wcslen strlen
#define wcscmp strcmp
#define wcscpy strcpy
#endif

static void
TzsetIfNecessary(void)
{
    static WCHAR* tzWas = (WCHAR *)INT2PTR(-1);	 /* Previous value of TZ, protected by
					  * clockMutex. */
    static long long tzLastRefresh = 0;	 /* Used for latency before next refresh */
    static size_t tzEnvEpoch = 0;        /* Last env epoch, for faster signaling,
					    that TZ changed via TCL */
    const WCHAR *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 changed with tcl-env (compare both epoch values)
     */
    Tcl_Time now;
    Tcl_GetTime(&now);
    if (now.sec == tzLastRefresh && tzEnvEpoch == TclEnvEpoch) {
	return;
    }

    tzEnvEpoch = TclEnvEpoch;
    tzLastRefresh = now.sec;

    Tcl_MutexLock(&clockMutex);
    tzIsNow = getenv("TZ");
    if (tzIsNow != NULL && (tzWas == NULL || tzWas == (WCHAR *)INT2PTR(-1)
	    || wcscmp(tzIsNow, tzWas) != 0)) {
	tzset();
	if (tzWas != NULL && tzWas != (WCHAR *)INT2PTR(-1)) {
	    Tcl_Free(tzWas);
	}
	tzWas = (WCHAR *)Tcl_Alloc(sizeof(WCHAR) * (wcslen(tzIsNow) + 1));
	wcscpy(tzWas, tzIsNow);
    } else if (tzIsNow == NULL && tzWas != NULL) {
	tzset();
	if (tzWas != (WCHAR *)INT2PTR(-1)) {
	    Tcl_Free(tzWas);
	}
	tzWas = NULL;
    }
    Tcl_MutexUnlock(&clockMutex);
}

/*
 *----------------------------------------------------------------------
 *
 * ClockDeleteCmdProc --
 *
 *	Remove a reference to the clock client data, and clean up memory
 *	when it's all gone.
 *
 * Results:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
ClockDeleteCmdProc(
    void *clientData)	/* Opaque pointer to the client data */
{
    ClockClientData *data = (ClockClientData *)clientData;
    int i;

    if (data->refCount-- <= 1) {
	for (i = 0; i < LIT__END; ++i) {
	    Tcl_DecrRefCount(data->literals[i]);
	}
	Tcl_Free(data->literals);
	Tcl_Free(data);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclClockFmt.c.
1
2
3
4
5
6
7
8
9
10
11









12
13
14
15
16
17
18
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











+
+
+
+
+
+
+
+
+







/*
 * 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" 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
641
642
643
644
645
646
647
648

649
650
651
652
653
654
655
650
651
652
653
654
655
656

657
658
659
660
661
662
663
664







-
+








static const Tcl_ObjType ClockFmtObjType = {
    "clock-format",			/* name */
    ClockFmtObj_FreeInternalRep,	/* freeIntRepProc */
    ClockFmtObj_DupInternalRep,		/* dupIntRepProc */
    ClockFmtObj_UpdateString,		/* updateStringProc */
    ClockFmtObj_SetFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V0
    0
};

#define ObjClockFmtScn(objPtr) \
    (*((ClockFmtScnStorage **)&(objPtr)->internalRep.twoPtrValue.ptr1))

#define ObjLocFmtKey(objPtr) \
    (*((Tcl_Obj **)&(objPtr)->internalRep.twoPtrValue.ptr2))
Changes to generic/tclCmdAH.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
















14
15
16
17
18
19
20
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

-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclCmdAH.c --
 *
 *	This file contains the top-level command routines for most of the Tcl
 *	built-in commands whose names begin with the letters A to H.
 *
 * Copyright © 1987-1993 The Regents of the University of California.
 * Copyright © 1994-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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclCmdAH.c --
 *
 *	This file contains the top-level command routines for most of the Tcl
 *	built-in commands whose names begin with the letters A to H.
 */

#include "tclInt.h"
#include "tclIO.h"
#include "tclTomMath.h"
#ifdef _WIN32
#   include "tclWinInt.h"
#endif

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
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







-
-
+
+


-
+


-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+







}

/*
 *------------------------------------------------------------------------
 *
 * EncodingConvertParseOptions --
 *
 *    Common routine for parsing arguments passed to encoding convertfrom
 *    and encoding convertto.
 *	Common routine for parsing arguments passed to encoding convertfrom
 *	and encoding convertto.
 *
 * Results:
 *    TCL_OK or TCL_ERROR.
 *	TCL_OK or TCL_ERROR.
 *
 * Side effects:
 *    On success,
 *    - *encPtr is set to the encoding. Must be freed with Tcl_FreeEncoding
 *      if non-NULL
 *    - *dataObjPtr is set to the Tcl_Obj containing the data to encode or
 *      decode
 *    - *profilePtr is set to encoding error handling profile
 *    - *failVarPtr is set to -failindex option value or NULL
 *    On error, all of the above are uninitialized.
 *	On success,
 *	- *encPtr is set to the encoding. Must be freed with Tcl_FreeEncoding
 *	  if non-NULL
 *	- *dataObjPtr is set to the Tcl_Obj containing the data to encode or
 *	  decode
 *	- *profilePtr is set to encoding error handling profile
 *	- *failVarPtr is set to -failindex option value or NULL
 *	On error, all of the above are uninitialized.
 *
 *------------------------------------------------------------------------
 */
static int
EncodingConvertParseOptions(
    Tcl_Interp *interp,		/* For error messages. May be NULL */
    int objc,			/* Number of arguments */
520
521
522
523
524
525
526
527

528
529
530
531
532
533
534
531
532
533
534
535
536
537

538
539
540
541
542
543
544
545







-
+







    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *data;		/* Byte array to convert */
    Tcl_DString ds;		/* Buffer to hold the string */
    Tcl_Encoding encoding;	/* Encoding to use */
    Tcl_Size length = 0;			/* Length of the byte array being converted */
    Tcl_Size length = 0;	/* Length of the byte array being converted */
    const char *bytesPtr;	/* Pointer to the first byte of the array */
    int flags;
    int result;
    Tcl_Obj *failVarObj;
    Tcl_Size errorLocation;

    if (EncodingConvertParseOptions(interp, objc, objv, &encoding, &data,
632
633
634
635
636
637
638
639

640
641
642
643
644
645
646
643
644
645
646
647
648
649

650
651
652
653
654
655
656
657







-
+







	return TCL_ERROR;
    }

    /*
     * Convert the string to a byte array in 'ds'
     */

    stringPtr = TclGetStringFromObj(data, &length);
    stringPtr = Tcl_GetStringFromObj(data, &length);
    result = Tcl_UtfToExternalDStringEx(interp, encoding, stringPtr, length, flags,
	    &ds, failVarObj ? &errorLocation : NULL);
    /* NOTE: ds must be freed beyond this point even on error */

    switch (result) {
    case TCL_OK:
	errorLocation = TCL_INDEX_NONE;
2062
2063
2064
2065
2066
2067
2068
2069

2070
2071
2072
2073
2074
2075
2076
2073
2074
2075
2076
2077
2078
2079

2080
2081
2082
2083
2084
2085
2086
2087







-
+







{
    Tcl_Obj *res;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    res = Tcl_FSSplitPath(objv[1], (Tcl_Size *)NULL);
    res = Tcl_FSSplitPath(objv[1], NULL);
    if (res == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"could not read \"%s\": no such file or directory",
		TclGetString(objv[1])));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PATHSPLIT", "NONESUCH",
		(char *)NULL);
	return TCL_ERROR;
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
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







-
+









-
-
-
+
+
+


-
+
















-
+
+







	Tcl_IncrRefCount(result);
#define DOBJPUT(key, objValue)                  \
	Tcl_DictObjPut(NULL, result,            \
	    Tcl_NewStringObj((key), -1),        \
	    (objValue));
	DOBJPUT("dev",	Tcl_NewWideIntObj((long)statPtr->st_dev));
	DOBJPUT("ino",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));
	DOBJPUT("nlink",	Tcl_NewWideIntObj((long)statPtr->st_nlink));
	DOBJPUT("nlink",Tcl_NewWideIntObj((long)statPtr->st_nlink));
	DOBJPUT("uid",	Tcl_NewWideIntObj((long)statPtr->st_uid));
	DOBJPUT("gid",	Tcl_NewWideIntObj((long)statPtr->st_gid));
	DOBJPUT("size",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
	DOBJPUT("blocks",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
	DOBJPUT("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize));
#endif
	DOBJPUT("atime",	Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr)));
	DOBJPUT("mtime",	Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr)));
	DOBJPUT("ctime",	Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr)));
	DOBJPUT("atime",Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr)));
	DOBJPUT("mtime",Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr)));
	DOBJPUT("ctime",Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr)));
	mode = (unsigned short) statPtr->st_mode;
	DOBJPUT("mode",	Tcl_NewWideIntObj(mode));
	DOBJPUT("type",	Tcl_NewStringObj(GetTypeFromMode(mode), -1));
	DOBJPUT("type",	Tcl_NewStringObj(GetTypeFromMode(mode), TCL_AUTO_LENGTH));
#undef DOBJPUT
	Tcl_SetObjResult(interp, result);
	Tcl_DecrRefCount(result);
	return TCL_OK;
    }

    /*
     * Might be a better idea to call Tcl_SetVar2Ex() instead, except we want
     * to have an object (i.e. possibly cached) array variable name but a
     * string element name, so no API exists. Messy.
     */

#define STORE_ARY(fieldName, object) \
    TclNewLiteralStringObj(field, fieldName);				\
    Tcl_IncrRefCount(field);						\
    value = (object);							\
    if (Tcl_ObjSetVar2(interp,varName,field,value,TCL_LEAVE_ERR_MSG)==NULL) { \
    if (Tcl_ObjSetVar2(interp, varName, field, value,			\
	    TCL_LEAVE_ERR_MSG) == NULL) {				\
	TclDecrRefCount(field);						\
	return TCL_ERROR;						\
    }									\
    TclDecrRefCount(field);

    /*
     * Watch out porters; the inode is meant to be an *unsigned* value, so the
2803
2804
2805
2806
2807
2808
2809
2810
2811



2812
2813
2814
2815
2816
2817
2818
2815
2816
2817
2818
2819
2820
2821


2822
2823
2824
2825
2826
2827
2828
2829
2830
2831







-
-
+
+
+







    /*
     * Break up the value lists and variable lists into elements.
     */

    for (i=0 ; i<numLists ; i++) {
	/* List */
	/* Variables */
	statePtr->vCopyList[i] = TclListObjCopy(interp, objv[1+i*2]);
	if (statePtr->vCopyList[i] == NULL) {
	statePtr->vCopyList[i] = TclDuplicatePureObj(
	    interp, objv[1+i*2], tclListTypePtr);
	if (!statePtr->vCopyList[i]) {
	    result = TCL_ERROR;
	    goto done;
	}
	result = TclListObjLength(interp, statePtr->vCopyList[i],
	    &statePtr->varcList[i]);
	if (result != TCL_OK) {
	    result = TCL_ERROR;
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
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







-
-
+
+

+





+
-
+
+
+
+
+

-
-
-
+
+
+







	    result = TCL_ERROR;
	    goto done;
	}
	TclListObjGetElements(NULL, statePtr->vCopyList[i],
	    &statePtr->varcList[i], &statePtr->varvList[i]);

	/* Values */
	if (TclObjTypeHasProc(objv[2+i*2],indexProc)) {
	    /* Special case for AbstractList */
	if (TclObjectHasInterface(objv[2+i*2], list, length)) {
	    int status;
	    statePtr->aCopyList[i] = Tcl_DuplicateObj(objv[2+i*2]);
	    Tcl_IncrRefCount(statePtr->aCopyList[i]);
	    if (statePtr->aCopyList[i] == NULL) {
		result = TCL_ERROR;
		goto done;
	    }
	    /* Don't compute values here, wait until the last moment */
	    TclObjectDispatchNoDefault(interp, status, statePtr->aCopyList[i], list,
	    statePtr->argcList[i] = TclObjTypeLength(statePtr->aCopyList[i]);
		length, interp, statePtr->aCopyList[i], &statePtr->argcList[i]);
	    if (status != TCL_OK) {
		result = TCL_ERROR;
		goto done;
	    }
	} else {
	    /* List values */
	    statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]);
	    if (statePtr->aCopyList[i] == NULL) {
	    statePtr->aCopyList[i] = TclDuplicatePureObj(
		interp, objv[2+i*2], tclListTypePtr);
	    if (!statePtr->aCopyList[i]) {
		result = TCL_ERROR;
		goto done;
	    }
	    result = TclListObjGetElements(interp, statePtr->aCopyList[i],
		&statePtr->argcList[i], &statePtr->argvList[i]);
	    if (result != TCL_OK) {
		goto done;
2977
2978
2979
2980
2981
2982
2983
2984
2985



2986
2987
2988
2989
2990
2991




2992
2993
2994
2995
2996
2997
2998
2996
2997
2998
2999
3000
3001
3002


3003
3004
3005

3006
3007
3008


3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019







-
-
+
+
+
-



-
-
+
+
+
+







    struct ForeachState *statePtr)
{
    int i;
    Tcl_Size v, k;
    Tcl_Obj *valuePtr, *varValuePtr;

    for (i=0 ; i<statePtr->numLists ; i++) {
	int isAbstractList =
		TclObjTypeHasProc(statePtr->aCopyList[i],indexProc) != NULL;
	int status;
	int hasindexinterface = TclObjectHasInterface(
	    statePtr->aCopyList[i], list, index);

	for (v=0 ; v<statePtr->varcList[i] ; v++) {
	    k = statePtr->index[i]++;
	    if (k < statePtr->argcList[i]) {
		if (isAbstractList) {
		    if (TclObjTypeIndex(interp, statePtr->aCopyList[i], k, &valuePtr) != TCL_OK) {
		if (hasindexinterface) {
		    status = TclObjectDispatchNoDefault(interp, status, statePtr->aCopyList[i], list,
			index, interp, statePtr->aCopyList[i], k, &valuePtr);
		    if (status != TCL_OK) {
			Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
				"\n    (setting %s loop variable \"%s\")",
				(statePtr->resultList != NULL ? "lmap" : "foreach"),
				TclGetString(statePtr->varvList[i][v])));
			return TCL_ERROR;
		    }
		} else {
Changes to generic/tclCmdIL.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
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

-
-
-
-
-
-
-











+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclCmdIL.c --
 *
 *	This file contains the top-level command routines for most of the Tcl
 *	built-in commands whose names begin with the letters I through L. It
 *	contains only commands in the generic core (i.e., those that don't
 *	depend much upon UNIX facilities).
 *
 * Copyright © 1987-1993 The Regents of the University of California.
 * Copyright © 1993-1997 Lucent Technologies.
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 * Copyright © 1998-1999 Scriptics Corporation.
 * Copyright © 2001 Kevin B. Kenny. All rights reserved.
 * Copyright © 2005 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclCmdIL.c --
 *
 *	This file contains the top-level command routines for most of the Tcl
 *	built-in commands whose names begin with the letters I through L. It
 *	contains only commands in the generic core (i.e., those that don't
 *	depend much upon UNIX facilities).
 */

#include "tclInt.h"
#include "tclRegexp.h"
#include "tclTomMath.h"
#include <math.h>
#include <assert.h>

/*
559
560
561
562
563
564
565
566

567
568
569
570
571
572
573
570
571
572
573
574
575
576

577
578
579
580
581
582
583
584







-
+







     * bytecompiled - in that case, the return was a copy of the body's string
     * rep. In order to better isolate the implementation details of the
     * compiler/engine subsystem, we now always return a copy of the string
     * rep. It is important to return a copy so that later manipulations of
     * the object do not invalidate the internal rep.
     */

    bytes = TclGetStringFromObj(procPtr->bodyPtr, &numBytes);
    bytes = Tcl_GetStringFromObj(procPtr->bodyPtr, &numBytes);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(bytes, numBytes));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
780
781
782
783
784
785
786
787

788
789
790
791
792
793
794
791
792
793
794
795
796
797

798
799
800
801
802
803
804
805







-
+








	if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
	    entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);
	    while (entryPtr != NULL) {
		cmdName = (const char *)Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
		if ((simplePattern == NULL)
			|| Tcl_StringMatch(cmdName, simplePattern)) {
		    if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) {
		    if (Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName) == NULL) {
			Tcl_ListObjAppendElement(interp, listPtr,
				Tcl_NewStringObj(cmdName, -1));
		    }
		}
		entryPtr = Tcl_NextHashEntry(&search);
	    }
	}
1255
1256
1257
1258
1259
1260
1261
1262

1263
1264
1265
1266
1267
1268
1269
1266
1267
1268
1269
1270
1271
1272

1273
1274
1275
1276
1277
1278
1279
1280







-
+







Tcl_Obj *
TclInfoFrame(
    Tcl_Interp *interp,		/* Current interpreter. */
    CmdFrame *framePtr)		/* Frame to get info for. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *tmpObj;
    Tcl_Obj *lv[20] = {NULL};		/* Keep uptodate when more keys are added to
    Tcl_Obj *lv[20] = {NULL};	/* Keep uptodate when more keys are added to
				 * the dict. */
    int lc = 0;
    /*
     * This array is indexed by the TCL_LOCATION_... values, except
     * for _LAST.
     */
    static const char *const typeString[TCL_LOCATION_LAST] = {
1279
1280
1281
1282
1283
1284
1285
1286
1287


1288
1289
1290
1291
1292
1293
1294
1290
1291
1292
1293
1294
1295
1296


1297
1298
1299
1300
1301
1302
1303
1304
1305







-
-
+
+








    /*
     * Pull the information and construct the dictionary to return, as list.
     * Regarding use of the CmdFrame fields see tclInt.h, and its definition.
     */

#define ADD_PAIR(name, value) \
	TclNewLiteralStringObj(tmpObj, name); \
	lv[lc++] = tmpObj; \
	TclNewLiteralStringObj(tmpObj, name);				\
	lv[lc++] = tmpObj;						\
	lv[lc++] = (value)

    switch (framePtr->type) {
    case TCL_LOCATION_EVAL:
	/*
	 * Evaluation, dynamic script. Type, line, cmd, the latter through
	 * str.
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
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







-
-
+
+











-
-
+
+
-
-
-
+
+



-
+








+

+
+
+
-
-
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+







-
+

+
+
+
+





+
+
-
-
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







Tcl_JoinObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    Tcl_Size length, listLen;
    int isAbstractList = 0;
    Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs;
    int status;
    Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs = NULL;

    if ((objc < 2) || (objc > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
	return TCL_ERROR;
    }

    /*
     * Make sure the list argument is a list object and get its length and a
     * pointer to its array of element pointers.
     */

    if (TclObjTypeHasProc(objv[1], getElementsProc)) {
	listLen = TclObjTypeLength(objv[1]);
    if (TclObjectHasInterface(objv[1], list, length)) {
	status = TclObjectDispatchNoDefault(interp, status, objv[1], list,
	isAbstractList = (listLen ? 1 : 0);
	if (listLen > 1 && TclObjTypeGetElements(interp, objv[1],
		&listLen, &elemPtrs) != TCL_OK) {
	    length, interp, objv[1], &listLen);
	if (status != TCL_OK ) {
	    return TCL_ERROR;
	}
    } else if (TclListObjGetElements(interp, objv[1], &listLen,
	    &elemPtrs) != TCL_OK) {
	&elemPtrs) != TCL_OK) {
	return TCL_ERROR;
    }

    if (listLen == 0) {
	/* No elements to join; default empty result is correct. */
	return TCL_OK;
    }
    if (listLen == 1) {
	Tcl_Obj *valueObj;
	/* One element; return it */
	if (TclObjectHasInterface(objv[1], list, index)) {
	    TclObjectDispatchNoDefault(interp, status, objv[1], list,
		index, interp, objv[1], 0, &valueObj);
	if (!isAbstractList) {
	    Tcl_SetObjResult(interp, elemPtrs[0]);
	    if (status != TCL_OK) {
		return TCL_ERROR;
	    }
	    Tcl_SetObjResult(interp, valueObj);
	} else {
	    Tcl_Obj *elemObj;

	    if (TclObjTypeIndex(interp, objv[1], 0, &elemObj) != TCL_OK) {
		return TCL_ERROR;
	    }
	    Tcl_SetObjResult(interp, elemObj);
	    if (elemPtrs == NULL) {
		if (TclListObjGetElements(interp, objv[1], &listLen,
		    &elemPtrs) != TCL_OK) {
		    return TCL_ERROR;
		}
	    }
	    Tcl_SetObjResult(interp, elemPtrs[0]);
	}
	return TCL_OK;
    }

    joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2];
    Tcl_IncrRefCount(joinObjPtr);

    (void)TclGetStringFromObj(joinObjPtr, &length);
    (void)Tcl_GetStringFromObj(joinObjPtr, &length);
    if (length == 0) {
	if (TclListObjGetElements(interp, objv[1], &listLen,
	    &elemPtrs) != TCL_OK) {
	    return TCL_ERROR;
	}
	resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0);
    } else {
	Tcl_Size i;

	TclNewObj(resObjPtr);
	if (TclObjectHasInterface(objv[1], list, index)) {
	    Tcl_Obj *valueObj;
	for (i = 0;  i < listLen;  i++) {
	    if (i > 0) {
	    for (i = 0;  i < listLen;  i++) {
		if (i > 0) {

		/*
		 * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT**
		 * to shimmer joinObjPtr.  If it did, then the case where
		 * objv[1] and objv[2] are the same value would not be safe.
		 * Accessing elemPtrs would crash.
		 */
		    /*
		     * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT**
		     * to shimmer joinObjPtr.  If it did, then the case where
		     * objv[1] and objv[2] are the same value would not be safe.
		     * Accessing elemPtrs would crash.
		     */

		Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
	    }
	    Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]);
		    Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
		}
		TclObjectDispatchNoDefault(interp, status, objv[1], list,
		    index, interp, objv[1], i, &valueObj);
		if (status != TCL_OK) {
		    return TCL_ERROR;
		}
		Tcl_AppendObjToObj(resObjPtr, valueObj);
		TclBounceRefCount(valueObj);
	    }
	} else {
	    if (elemPtrs == NULL) {
		if (TclListObjGetElements(interp, objv[1], &listLen,
		    &elemPtrs) != TCL_OK) {
		    return TCL_ERROR;
		}
	    }
	    for (i = 0;  i < listLen;  i++) {
		if (i > 0) {

		    /*
		     * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT**
		     * to shimmer joinObjPtr.  If it did, then the case where
		     * objv[1] and objv[2] are the same value would not be safe.
		     * Accessing elemPtrs would crash.
		     */

		    Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
		}
		Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]);
	    }
	}
    }
    Tcl_DecrRefCount(joinObjPtr);
    if (resObjPtr) {
	Tcl_SetObjResult(interp, resObjPtr);
	return TCL_OK;
    }
2259
2260
2261
2262
2263
2264
2265
2266

2267
2268
2269
2270
2271
2272
2273
2310
2311
2312
2313
2314
2315
2316

2317
2318
2319
2320
2321
2322
2323
2324







-
+







    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *listPtr;
    Tcl_Size listObjc;		/* The length of the list. */
    Tcl_Size origListObjc;	/* Original length */
    int i;
    int i, status;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?varName ...?");
	return TCL_ERROR;
    }

    /*
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
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







-
+


-
-
-
+
+
+
+



-
-
-
-
+
+
+
+


-
+







		return TCL_ERROR;
	    }
	}
	Tcl_DecrRefCount(emptyObj);
    }

    if (listObjc > 0) {
	Tcl_Obj *resultObjPtr = NULL;
	Tcl_Obj *resultPtr = NULL;
	Tcl_Size fromIdx = origListObjc - listObjc;
	Tcl_Size toIdx = origListObjc - 1;
	if (TclObjTypeHasProc(listPtr, sliceProc)) {
	    if (TclObjTypeSlice(
		    interp, listPtr, fromIdx, toIdx, &resultObjPtr) != TCL_OK) {
	if (TclObjectHasInterface(listPtr, list, range)) {
		TclObjectDispatchNoDefault(interp, status, listPtr, list, range,
			interp, listPtr, fromIdx, toIdx, &resultPtr);
	    if (status != TCL_OK) {
		return TCL_ERROR;
	    }
	} else {
	    resultObjPtr = TclListObjRange(
		interp, listPtr, origListObjc - listObjc, origListObjc - 1);
	    if (resultObjPtr == NULL) {
		return TCL_ERROR;
	    status = TclListObjRange(interp, listPtr,
		origListObjc - listObjc, origListObjc - 1, &resultPtr);
	    if (status != TCL_OK || resultPtr == NULL) {
		return status;
	    }
	}
	Tcl_SetObjResult(interp, resultObjPtr);
	Tcl_SetObjResult(interp, resultPtr);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
2423
2424
2425
2426
2427
2428
2429
2430

2431
2432
2433
2434
2435
2436
2437
2475
2476
2477
2478
2479
2480
2481

2482
2483
2484
2485
2486
2487
2488
2489







-
+







 *----------------------------------------------------------------------
 */

int
Tcl_LinsertObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,		/* Number of arguments. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *listPtr;
    Tcl_Size len, index;
    int copied = 0, result;

    if (objc < 3) {
2461
2462
2463
2464
2465
2466
2467

2468



2469
2470
2471
2472
2473
2474
2475
2513
2514
2515
2516
2517
2518
2519
2520

2521
2522
2523
2524
2525
2526
2527
2528
2529
2530







+
-
+
+
+







    /*
     * If the list object is unshared we can modify it directly. Otherwise we
     * create a copy to modify: this is "copy on write".
     */

    listPtr = objv[1];
    if (Tcl_IsShared(listPtr)) {
	listPtr = TclDuplicatePureObj(interp, listPtr, tclListTypePtr);
	listPtr = TclListObjCopy(NULL, listPtr);
	if (!listPtr) {
	    return TCL_ERROR;
	}
	copied = 1;
    }

    if ((objc == 4) && (index == len)) {
	/*
	 * Special case: insert one element at the end of the list.
	 */
2516
2517
2518
2519
2520
2521
2522
2523
2524


2525
2526
2527
2528
2529
2530
2531
2532
2571
2572
2573
2574
2575
2576
2577


2578
2579

2580
2581
2582
2583
2584
2585
2586







-
-
+
+
-







 *----------------------------------------------------------------------
 */

int
Tcl_ListObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
				/* The argument objects. */
{
    /*
     * If there are no list elements, the result is an empty object.
     * Otherwise set the interpreter's result object to be a list object.
     */

    if (objc > 1) {
2553
2554
2555
2556
2557
2558
2559
2560

2561
2562
2563
2564
2565
2566
2567
2568
2607
2608
2609
2610
2611
2612
2613

2614

2615
2616
2617
2618
2619
2620
2621







-
+
-







 */

int
Tcl_LlengthObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])
    Tcl_Obj *const objv[])	/* Argument objects. */
				/* Argument objects. */
{
    Tcl_Size listLen;
    int result;
    Tcl_Obj *objPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "list");
2602
2603
2604
2605
2606
2607
2608
2609

2610
2611
2612
2613

2614
2615
2616
2617
2618
2619
2620
2655
2656
2657
2658
2659
2660
2661

2662

2663
2664

2665
2666
2667
2668
2669
2670
2671
2672







-
+
-


-
+







 */

int
Tcl_LpopObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])
    Tcl_Obj *const objv[])	/* Argument objects. */
				/* Argument objects. */
{
    Tcl_Size listLen;
    int copied = 0, result;
    int copied = 0, result, status;
    Tcl_Obj *elemPtr, *stored;
    Tcl_Obj *listPtr;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "listvar ?index?");
	return TCL_ERROR;
    }
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
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







-




+
-
+
+
+











-
-
-
-
-
+
-
-
+
-
-
-
-
+


-







	}
    }
    Tcl_SetObjResult(interp, elemPtr);
    Tcl_DecrRefCount(elemPtr);

    /*
     * Second, remove the element.
     * TclLsetFlat adds a ref count which is handled.
     */

    if (objc == 2) {
	if (Tcl_IsShared(listPtr)) {
	    listPtr = TclDuplicatePureObj(interp, listPtr, tclListTypePtr);
	    listPtr = TclListObjCopy(NULL, listPtr);
	    if (!listPtr) {
		return TCL_ERROR;
	    }
	    copied = 1;
	}
	result = Tcl_ListObjReplace(interp, listPtr, listLen - 1, 1, 0, NULL);
	if (result != TCL_OK) {
	    if (copied) {
		Tcl_DecrRefCount(listPtr);
	    }
	    return result;
	}
    } else {
	Tcl_Obj *newListPtr;
	Tcl_ObjTypeSetElement *proc = TclObjTypeHasProc(listPtr, setElementProc);
	if (proc) {
	    newListPtr = proc(interp, listPtr, objc-2, objv+2, NULL);
	} else {
	    newListPtr = TclLsetFlat(interp, listPtr, objc-2, objv+2, NULL);
	status = TclLsetFlat(interp, listPtr, objc-2, objv+2, NULL, &newListPtr);
	}
	if (newListPtr == NULL) {
	if (status != TCL_OK || newListPtr == NULL) {
	    if (copied) {
		Tcl_DecrRefCount(listPtr);
	    }
	    return TCL_ERROR;
	    return status;
	} else {
	    listPtr = newListPtr;
	    TclUndoRefCount(listPtr);
	}
    }

    stored = Tcl_ObjSetVar2(interp, objv[1], NULL, listPtr, TCL_LEAVE_ERR_MSG);
    if (stored == NULL) {
	return TCL_ERROR;
    }
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
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







-
+
-

-
-
+
+










+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
+
+
-
-
-
+

-
-
-
-
-
-
+







 */

int
Tcl_LrangeObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])
    Tcl_Obj *const objv[])	/* Argument objects. */
				/* Argument objects. */
{
    int result;
    Tcl_Size listLen, first, last;
    int result, status;
    Tcl_Size fromAnchor, first, fromIdx, last, listLen, toAnchor, toIdx;
    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "list first last");
	return TCL_ERROR;
    }

    result = TclListObjLength(interp, objv[1], &listLen);
    if (result != TCL_OK) {
	return result;
    }

    result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ TCL_SIZE_MAX - 1,
	&toIdx);
    if (result != TCL_OK) {
	return result;
    }

    result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ TCL_SIZE_MAX - 1,
	&fromIdx);
    if (result != TCL_OK) {
	return result;
    }

    toAnchor = TclIndexIsFromEnd(toIdx);
    fromAnchor = TclIndexIsFromEnd(fromIdx);

    if (!Tcl_LengthIsFinite(listLen)
	&& (toAnchor == 1 || fromAnchor == 1)
	&& TclObjectHasInterface(objv[1], list, rangeEnd)
    ) {
	Tcl_Obj *objResultPtr;

	status = TclObjectInterfaceCall(objv[1], list, rangeEnd,
	    interp, objv[1], toAnchor, toIdx, fromAnchor, fromIdx,
	    &objResultPtr);
	if (status != TCL_OK || objResultPtr == NULL) {
	    return TCL_ERROR;
	} else {
	    Tcl_SetObjResult(interp, objResultPtr);
	}
    } else {
	Tcl_Obj *resultPtr;
    result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ listLen - 1,
	    &first);
    if (result != TCL_OK) {
	return result;
    }
	result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ listLen - 1,
		&first);
	if (result != TCL_OK) {
	    return result;
	}

    result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
	    &last);
    if (result != TCL_OK) {
	return result;
    }
	result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
		&last);
	if (result != TCL_OK) {
	    return result;
	}

    if (TclObjTypeHasProc(objv[1], sliceProc)) {
	Tcl_Obj *resultObj;
	int status = TclObjTypeSlice(interp, objv[1], first, last, &resultObj);
	if (status == TCL_OK) {
	status = TclListObjRange(interp, objv[1], first, last, &resultPtr);
	if (status != TCL_OK || resultPtr == NULL) {
	    Tcl_SetObjResult(interp, resultObj);
	} else {
	    return TCL_ERROR;
	    return status;
	}
    } else {
	Tcl_Obj *resultObj = TclListObjRange(interp, objv[1], first, last);
	if (resultObj == NULL) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, resultObj);
	Tcl_SetObjResult(interp, resultPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
2852
2853
2854
2855
2856
2857
2858

2859




2860
2861
2862
2863
2864
2865
2866
2918
2919
2920
2921
2922
2923
2924
2925

2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936







+
-
+
+
+
+







    }

    /*
     * Make our working copy, then do the actual removes piecemeal.
     */

    if (Tcl_IsShared(listObj)) {
	listObj = TclDuplicatePureObj(interp, listObj, tclListTypePtr);
	listObj = TclListObjCopy(NULL, listObj);
	if (!listObj) {
	    status = TCL_ERROR;
	    goto done;
	}
	copied = 1;
    }
    num = 0;
    first = listLen;
    for (i = 0, prevIdx = -1 ; i < idxc ; i++) {
	Tcl_Size idx = idxv[i];

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
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







-
-
+
+
-

-
+
-











-
+




-
+







 *----------------------------------------------------------------------
 */

int
Tcl_LrepeatObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
				/* The argument objects. */
{
    Tcl_WideInt elementCount, i;
    Tcl_Size elementCount, i, totalElems;
    Tcl_Size totalElems;
    Tcl_Obj *listPtr, **dataArray = NULL;

    /*
     * Check arguments for legality:
     *		lrepeat count ?value ...?
     */

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "count ?value ...?");
	return TCL_ERROR;
    }
    if (TCL_OK != TclGetWideIntFromObj(interp, objv[1], &elementCount)) {
    if (TCL_OK != Tcl_GetSizeIntFromObj(interp, objv[1], &elementCount)) {
	return TCL_ERROR;
    }
    if (elementCount < 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad count \"%" TCL_LL_MODIFIER "d\": must be integer >= 0", elementCount));
		"bad count \"%" TCL_SIZE_MODIFIER "d\": must be integer >= 0", elementCount));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPEAT", "NEGARG",
		(char *)NULL);
	return TCL_ERROR;
    }

    /*
     * Skip forward to the interesting arguments now we've finished parsing.
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
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







-
+











+
-
+
+
+







	first = listLen;
    }

    if (last >= listLen) {
	last = listLen - 1;
    }
    if (first <= last) {
	numToDelete = (size_t)last - (size_t)first + 1; /* See [3d3124d01d] */
	numToDelete = last - first + 1;
    } else {
	numToDelete = 0;
    }

    /*
     * If the list object is unshared we can modify it directly, otherwise we
     * create a copy to modify: this is "copy on write".
     */

    listPtr = objv[1];
    if (Tcl_IsShared(listPtr)) {
	listPtr = TclDuplicatePureObj(interp, listPtr, tclListTypePtr);
	listPtr = TclListObjCopy(NULL, listPtr);
	if (!listPtr) {
	    return TCL_ERROR;
	}
    }

    /*
     * Note that we call Tcl_ListObjReplace even when numToDelete == 0 and
     * objc == 4. In this case, the list value of listPtr is not changed (no
     * elements are removed or added), but by making the call we are assured
     * we end up with a list in canonical form. Resist any temptation to
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
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







-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-







    Tcl_Size elemc, i, j;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "list");
	return TCL_ERROR;
    }

    /*
     *  Handle AbstractList special case - do not shimmer into a list, if it
     *  supports a private Reverse function, just to reverse it.
     */
    if (TclObjTypeHasProc(objv[1], reverseProc)) {
	Tcl_Obj *resultObj;

	if (TclObjTypeReverse(interp, objv[1], &resultObj) == TCL_OK) {
	    Tcl_SetObjResult(interp, resultObj);
	    return TCL_OK;
	}
    if (TclObjectHasInterface(objv[1], list, reverse)) {
	int status;
	Tcl_Obj *resObj;
	if (Tcl_IsShared(objv[1])) {
	    resObj = Tcl_DuplicateObj(objv[1]);
	} else {
	    resObj = objv[1];
	}
	TclObjectDispatchNoDefault(interp, status, resObj, list,
	    reverse, interp, resObj);
	    if (status == TCL_OK) {
		Tcl_SetObjResult(interp, resObj);
	    }
	    return status;
    }
    } /* end Abstract List */

    if (TclListObjLength(interp, objv[1], &elemc) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * If the list is empty, just return it. [Bug 1876793]
3259
3260
3261
3262
3263
3264
3265
3266

3267
3268
3269

3270
3271
3272
3273

3274
3275
3276
3277
3278
3279
3280
3333
3334
3335
3336
3337
3338
3339

3340
3341
3342

3343
3344
3345
3346

3347
3348
3349
3350
3351
3352
3353
3354







-
+


-
+



-
+







    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    const char *bytes, *patternBytes;
    int match, result=TCL_OK, bisect;
    Tcl_Size i, length = 0, listc, elemLen, start, index;
    Tcl_Size groupOffset, lower, upper;
    Tcl_Size groupSize, groupOffset, lower, upper;
    int allocatedIndexVector = 0;
    int isIncreasing;
    Tcl_WideInt patWide, objWide, wide, groupSize;
    Tcl_WideInt patWide, objWide, wide;
    int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
    double patDouble, objDouble;
    SortInfo sortInfo;
    Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr = NULL;
    Tcl_Obj *patObj, *itemPtr, *item2Ptr, *listPtr, *subjectPtr, *startPtr;
    SortStrCmpFn_t strCmpFn = TclUtfCmp;
    Tcl_RegExp regexp = NULL;
    static const char *const options[] = {
	"-all",	    "-ascii",   "-bisect", "-decreasing", "-dictionary",
	"-exact",   "-glob",    "-increasing", "-index",
	"-inline",  "-integer", "-nocase",     "-not",
	"-real",    "-regexp",  "-sorted",     "-start", "-stride",
3296
3297
3298
3299
3300
3301
3302

3303
3304
3305
3306
3307
3308
3309
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384







+







    enum modes mode;

    mode = GLOB;
    dataType = ASCII;
    isIncreasing = 1;
    allMatches = 0;
    inlineReturn = 0;
    itemPtr = NULL;
    returnSubindices = 0;
    negatedMatch = 0;
    bisect = 0;
    listPtr = NULL;
    startPtr = NULL;
    groupSize = 1;
    groupOffset = 0;
3563
3564
3565
3566
3567
3568
3569

3570

3571
3572
3573
3574
3575
3576
3577
3638
3639
3640
3641
3642
3643
3644
3645

3646
3647
3648
3649
3650
3651
3652
3653







+
-
+







    }

    /*
     * Make sure the list argument is a list object and get its length and a
     * pointer to its array of element pointers.
     */

    subjectPtr = objv[objc-2];
    result = TclListObjGetElements(interp, objv[objc - 2], &listc, &listv);
    result = Tcl_ListObjLength(interp, subjectPtr, &listc);
    if (result != TCL_OK) {
	goto done;
    }

    /*
     * Check for sanity when grouping elements of the overall list together
     * because of the -stride option. [TIP #351]
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
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







-
+
+








-
+



-
+





+



















-
+








-
-
+
+

-
-








-
-
+
+

-
-



-
+











+












+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
-
-
+
+
+
+
+
+
+
+
+

-
+




-
-
+
+
+
+
+







    }

    /*
     * Get the user-specified start offset.
     */

    if (startPtr) {
	result = TclGetIntForIndexM(interp, startPtr, listc-1, &start);
	result = TclGetIntForIndexM(interp, startPtr,
	    (Tcl_LengthIsFinite(listc) ? listc - 1 : TCL_SIZE_MAX), &start);
	if (result != TCL_OK) {
	    goto done;
	}
	if (start == TCL_INDEX_NONE) {
	    start = TCL_INDEX_START;
	}

	/*
	 * If the search started past the end of the list, we just return a
	 * If the search started past the end of the list, just return a
	 * "did not match anything at all" result straight away. [Bug 1374778]
	 */

	if (start >= listc) {
	if (Tcl_LengthIsFinite(listc) && start >= listc) {
	    if (allMatches || inlineReturn) {
		Tcl_ResetResult(interp);
	    } else {
		TclNewIntObj(itemPtr, -1);
		Tcl_SetObjResult(interp, itemPtr);
		itemPtr = NULL;
	    }
	    goto done;
	}

	/*
	 * If start points within a group, it points to the start of the group.
	 */

	if (groupSize > 1) {
	    start -= (start % groupSize);
	}
    }

    patObj = objv[objc - 1];
    patternBytes = NULL;
    if (mode == EXACT || mode == SORTED) {
	switch (dataType) {
	case ASCII:
	case DICTIONARY:
	    patternBytes = TclGetStringFromObj(patObj, &length);
	    patternBytes = Tcl_GetStringFromObj(patObj, &length);
	    break;
	case INTEGER:
	    result = TclGetWideIntFromObj(interp, patObj, &patWide);
	    if (result != TCL_OK) {
		goto done;
	    }

	    /*
	     * List representation might have been shimmered; restore it. [Bug
	     * 1844789]
	     * [Bug 1844789], "lsearch -exact -integer ..." crashes, was
	     * previously fixed at this point.
	     */

	    TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv);
	    break;
	case REAL:
	    result = Tcl_GetDoubleFromObj(interp, patObj, &patDouble);
	    if (result != TCL_OK) {
		goto done;
	    }

	    /*
	     * List representation might have been shimmered; restore it. [Bug
	     * 1844789]
	     * [Bug 1844789], "lsearch -exact -integer ..." crashes, was
	     * previously fixed at this point.
	     */

	    TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv);
	    break;
	}
    } else {
	patternBytes = TclGetStringFromObj(patObj, &length);
	patternBytes = Tcl_GetStringFromObj(patObj, &length);
    }

    /*
     * Set default index value to -1, indicating failure; if we find the item
     * in the course of our search, index will be set to the correct value.
     */

    index = -1;
    match = 0;

    if (mode == SORTED && !allMatches && !negatedMatch) {
	int isfinite;
	/*
	 * If the data is sorted, we can do a more intelligent search. Note
	 * that there is no point in being smart when -all was specified; in
	 * that case, we have to look at all items anyway, and there is no
	 * sense in doing this when the match sense is inverted.
	 */

	/*
	 * With -stride, lower, upper and i are kept as multiples of groupSize.
	 */

	lower = start - groupSize;
	isfinite = Tcl_LengthIsFinite(listc);
	if (isfinite) {
	upper = listc;
	itemPtr = NULL;
	while (lower + groupSize != upper && sortInfo.resultCode == TCL_OK) {
	    i = (lower + upper)/2;
	    upper = listc;
	} else {
	    upper = 1;
	}
	while (
	    (lower + groupSize < upper && sortInfo.resultCode == TCL_OK)
	    || !isfinite
	) {
	    i = (lower + upper) / 2;
	    if (i < 0) {
		result = TCL_ERROR;
		Tcl_SetObjResult(interp, Tcl_NewStringObj("sorted list is incoherent", -1));
		goto done;
	    }
	    i -= i % groupSize;
	    result = Tcl_ListObjIndex(interp, subjectPtr, i+groupOffset, &itemPtr);
	    if (result != TCL_OK) {
		if (isfinite) {
		    goto done;
		} else {
		    if (Tcl_ListObjLength(interp, subjectPtr, &listc) == TCL_OK) {
			isfinite = Tcl_LengthIsFinite(listc);
			if (isfinite) {
			    if (listc - 1 > i) {
				upper = listc = 1;
				break;
			    } else {
				goto done;

			    }
	    Tcl_BounceRefCount(itemPtr);
	    itemPtr = NULL;

			} else {
			    goto done;
			}
		    } else {
			goto done;
		    }
		}
	    }
	    Tcl_IncrRefCount(itemPtr);
	    if (sortInfo.indexc != 0) {
		itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo);
		item2Ptr = SelectObjFromSublist(itemPtr, &sortInfo);
		if (sortInfo.resultCode != TCL_OK) {
		    result = sortInfo.resultCode;
		    goto done;
		}
	    } else {
		itemPtr = listv[i+groupOffset];
		/* Increment item2Ptr refcount first in case it's the same
		 * object as itemPtr. */
		Tcl_IncrRefCount(item2Ptr);
		Tcl_DecrRefCount(itemPtr);
		itemPtr = item2Ptr;
	    }
	    switch (dataType) {
	    case ASCII:
		bytes = TclGetString(itemPtr);
		match = strCmpFn(patternBytes, bytes);
		break;
	    case DICTIONARY:
3763
3764
3765
3766
3767
3768
3769


3770
3771
3772
3773
3774
3775
3776
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887







+
+







		} else if (patDouble < objDouble) {
		    match = -1;
		} else {
		    match = 1;
		}
		break;
	    }
	    Tcl_DecrRefCount(itemPtr);
	    itemPtr = NULL;
	    if (match == 0) {
		/*
		 * Normally, binary search is written to stop when it finds a
		 * match. If there are duplicates of an element in the list,
		 * our first match might not be the first occurrence.
		 * Consider: 0 0 0 1 1 1 2 2 2
		 *
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
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







+
+
+


+




+


+
+
+

















-
+

-
-
-
+
+
+
+
+

-
+







-
-
+
+
+
+
+







-
+







		    lower = i;
		} else {
		    upper = i;
		}
	    } else if (match > 0) {
		if (isIncreasing) {
		    lower = i;
		    if (!isfinite) {
			upper *= 2;
		    }
		} else {
		    upper = i;
		    isfinite = 1;
		}
	    } else {
		if (isIncreasing) {
		    upper = i;
		    isfinite = 1;
		} else {
		    lower = i;
		    if (!isfinite) {
			upper *= 2;
		    }
		}
	    }
	}
	if (bisect && index < 0) {
	    index = lower;
	}
    } else {
	/*
	 * We need to do a linear search, because (at least one) of:
	 *   - our matcher can only tell equal vs. not equal
	 *   - our matching sense is negated
	 *   - we're building a list of all matched items
	 */

	if (allMatches) {
	    listPtr = Tcl_NewListObj(0, NULL);
	}
	for (i = start; i < listc; i += groupSize) {
	for (i = start; listc < 0 || i < listc; i += groupSize) {
	    match = 0;
	    Tcl_BounceRefCount(itemPtr);
	    itemPtr = NULL;

	    result = Tcl_ListObjIndex(interp, subjectPtr, i+groupOffset, &itemPtr);
	    if (result != TCL_OK) {
		goto done;
	    }
	    Tcl_IncrRefCount(itemPtr);
	    if (sortInfo.indexc != 0) {
		itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo);
		item2Ptr = SelectObjFromSublist(itemPtr, &sortInfo);
		if (sortInfo.resultCode != TCL_OK) {
		    if (listPtr != NULL) {
			Tcl_DecrRefCount(listPtr);
		    }
		    result = sortInfo.resultCode;
		    goto done;
		}
	    } else {
		itemPtr = listv[i+groupOffset];
		/* Increment item2Ptr refcount first in case it's the same
		 * object as itemPtr. */
		Tcl_IncrRefCount(item2Ptr);
		Tcl_DecrRefCount(itemPtr);
		itemPtr = item2Ptr;
	    }

	    switch (mode) {
	    case SORTED:
	    case EXACT:
		switch (dataType) {
		case ASCII:
		    bytes = TclGetStringFromObj(itemPtr, &elemLen);
		    bytes = Tcl_GetStringFromObj(itemPtr, &elemLen);
		    if (length == elemLen) {
			/*
			 * This split allows for more optimal compilation of
			 * memcmp/strcasecmp.
			 */

			if (noCase) {
3869
3870
3871
3872
3873
3874
3875
3876

3877
3878
3879
3880
3881
3882
3883
3993
3994
3995
3996
3997
3998
3999

4000
4001
4002
4003
4004
4005
4006
4007







-
+







			}
			goto done;
		    }
		    match = (objWide == patWide);
		    break;

		case REAL:
		    result = Tcl_GetDoubleFromObj(interp,itemPtr, &objDouble);
		    result = Tcl_GetDoubleFromObj(interp, itemPtr, &objDouble);
		    if (result != TCL_OK) {
			if (listPtr) {
			    Tcl_DecrRefCount(listPtr);
			}
			goto done;
		    }
		    match = (objDouble == patDouble);
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
3999
4000
4001
4002
4003
4004
4005
4006



4007
4008
4009
4010
4011
4012
4013
4014

4015
4016
4017
4018
4019
4020
4021
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
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







+
+




+
+



-
+

+
+


+
+
+
+
-
-
+
+
-
-
+
+

+
+
+
+
+
+
+
-
-
+
+
+

-
-
+
+
+
+





+



-
+





+


+



-
-
-


















+

-
-
+
+











+
+
+
+
+
-
+
-

+
+
+
+
+
+
+
+
+
+
-
+

+
+
+
+
-
+

+








-
-
-
+
+
+








+







	     * Invert match condition for -not.
	     */

	    if (negatedMatch) {
		match = !match;
	    }
	    if (!match) {
		Tcl_DecrRefCount(itemPtr);
		itemPtr = NULL;
		continue;
	    }
	    if (!allMatches) {
		index = i;
		Tcl_DecrRefCount(itemPtr);
		itemPtr = NULL;
		break;
	    } else if (inlineReturn) {
		/*
		 * Note that these appends are not expected to fail.
		 * These append operations are expected to not fail.
		 */
		Tcl_DecrRefCount(itemPtr);
		itemPtr = NULL;

		if (returnSubindices && (sortInfo.indexc != 0)) {
		    result = Tcl_ListObjIndex(interp, subjectPtr, i+groupOffset, &itemPtr);
		    if (result != TCL_OK) {
			goto done;
		    }
		    Tcl_BounceRefCount(itemPtr);
		    itemPtr = SelectObjFromSublist(listv[i+groupOffset],
		    Tcl_IncrRefCount(itemPtr);
		    item2Ptr = SelectObjFromSublist(itemPtr, &sortInfo);
			    &sortInfo);
		    Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
		    Tcl_ListObjAppendElement(interp, listPtr, item2Ptr);
		    Tcl_DecrRefCount(itemPtr);
		} else if (groupSize > 1) {
		    Tcl_Size j;
		    for (j = 0; j < groupSize; j++) {
			result = Tcl_ListObjIndex(interp, subjectPtr,
			    i+j, &itemPtr);
			if (result != TCL_OK) {
			    goto done;
			}
		    Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0,
			    groupSize, &listv[i]);
			Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0,
				1, &itemPtr);
		    }
		} else {
		    Tcl_BounceRefCount(itemPtr);
		    itemPtr = listv[i];
		    result = Tcl_ListObjIndex(interp, subjectPtr, i, &itemPtr);
		    if (result != TCL_OK) {
			goto done;
		    }
		    Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
		}
	    } else if (returnSubindices) {
		Tcl_Size j;

		Tcl_DecrRefCount(itemPtr);
		TclNewIndexObj(itemPtr, i+groupOffset);
		for (j=0 ; j<sortInfo.indexc ; j++) {
		    Tcl_Obj *elObj;
		    size_t elValue = TclIndexDecode(sortInfo.indexv[j], listc);
		    Tcl_Size elValue = TclIndexDecode(sortInfo.indexv[j], listc);
		    TclNewIndexObj(elObj, elValue);
		    Tcl_ListObjAppendElement(interp, itemPtr, elObj);
		}
		Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
	    } else {
		Tcl_DecrRefCount(itemPtr);
		Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewWideIntObj(i));
	    }
	    itemPtr = NULL;
	}
    }

    Tcl_BounceRefCount(itemPtr);
    itemPtr = NULL;

    /*
     * Return everything or a single value.
     */

    if (allMatches) {
	Tcl_SetObjResult(interp, listPtr);
    } else if (!inlineReturn) {
	if (returnSubindices) {
	    Tcl_Size j;

	    TclNewIndexObj(itemPtr, index+groupOffset);
	    for (j=0 ; j<sortInfo.indexc ; j++) {
		Tcl_Obj *elObj;
		size_t elValue = TclIndexDecode(sortInfo.indexv[j], listc);
		TclNewIndexObj(elObj, elValue);
		Tcl_ListObjAppendElement(interp, itemPtr, elObj);
	    }
	    Tcl_SetObjResult(interp, itemPtr);
	    itemPtr = NULL;
	} else {
		Tcl_Obj *elObj;
		TclNewIndexObj(elObj, index);
	    Tcl_Obj *elObj;
	    TclNewIndexObj(elObj, index);
	    Tcl_SetObjResult(interp, elObj);
	}
    } else if (index < 0) {
	/*
	 * Is this superfluous? The result should be a blank object by
	 * default...
	 */

	Tcl_SetObjResult(interp, Tcl_NewObj());
    } else {
	if (returnSubindices) {
	    result = Tcl_ListObjIndex(interp, subjectPtr, i+groupOffset, &itemPtr);
	    if (result != TCL_OK) {
		goto done;
	    }
	    item2Ptr = SelectObjFromSublist(itemPtr, &sortInfo);
	    Tcl_SetObjResult(interp, SelectObjFromSublist(listv[i+groupOffset],
	    Tcl_SetObjResult(interp, item2Ptr);
		    &sortInfo));
	} else if (groupSize > 1) {
	    Tcl_Size j;
	    listPtr = Tcl_NewListObj(0, NULL);
	    for (j = 0; j < groupSize; j++) {
		result = Tcl_ListObjIndex(interp, subjectPtr, index + j, &itemPtr);
		if (result != TCL_OK) {
		    Tcl_DecrRefCount(listPtr);
		    goto done;
		}
		Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
	    }
	    Tcl_SetObjResult(interp, Tcl_NewListObj(groupSize, &listv[index]));
	    Tcl_SetObjResult(interp, listPtr);
	} else {
	    result = Tcl_ListObjIndex(interp, subjectPtr, index, &itemPtr);
	    if (result != TCL_OK) {
		goto done;
	    }
	    Tcl_SetObjResult(interp, listv[index]);
	    Tcl_SetObjResult(interp, itemPtr);
	}
	itemPtr = NULL;
    }
    result = TCL_OK;

    /*
     * Cleanup the index list array.
     */

  done:
    /* potential lingering abstract list element */
    Tcl_BounceRefCount(itemPtr);

    if (itemPtr != NULL) {
	Tcl_DecrRefCount(itemPtr);
    }
    if (startPtr != NULL) {
	Tcl_DecrRefCount(startPtr);
    }
    if (allocatedIndexVector) {
	TclStackFree(interp, sortInfo.indexv);
    }
    return result;
}


/*
 *----------------------------------------------------------------------
 *
 * SequenceIdentifyArgument --
 *   (for [lseq] command)
 *
4066
4067
4068
4069
4070
4071
4072

4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4231
4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246

4247
4248
4249
4250
4251
4252
4253







+








-







		  "missing \"%s\" value.", TclGetString(argPtr)));
	    return ErrArg;
	}
	*keywordIndexPtr = opmode;
	return RangeKeywordArg;
    } else {
	Tcl_Obj *exprValueObj;
	int keyword;
	if (!(allowedArgs & NumericArg)) {
	    return NoneArg;
	}
    doExpr:
	/* Check for an index expression */
	if (Tcl_ExprObj(interp, argPtr, &exprValueObj) != TCL_OK) {
	    return ErrArg;
	}
	int keyword;
	/* Determine if result of expression is double or int */
	if (Tcl_GetNumberFromObj(interp, exprValueObj, &internalPtr,
		&keyword) != TCL_OK
	) {
	    return ErrArg;
	}
	*numValuePtr = exprValueObj; /* incremented in Tcl_ExprObj */
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
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







-
-
+




-
-
+





-
-
-
+
+
+
-







	step = one;
        useDoubles = 0; // Can only have Integer value. If a fractional value
                        // is given, this will fail later. In other words,
                        // "3.0" is allowed and used as Integer, but "3.1"
                        // will be flagged as an error. (bug f4a4bd7f1070)
	break;

/*    lseq n n */
    case 11:
    case 11:			/* lseq n n */
	start = numValues[0];
	end = numValues[1];
	break;

/*    lseq n n n */
    case 111:
    case 111:			/* lseq n n n */
	start = numValues[0];
	end = numValues[1];
	step = numValues[2];
	break;

/*    lseq n 'to' n    */
/*    lseq n 'count' n */
/*    lseq n 'by' n    */
    case 121:			/* lseq n 'to' n
				 * lseq n 'count' n
				 * lseq n 'by' n */
    case 121:
	opmode = (SequenceOperators)values[1];
	switch (opmode) {
	case LSEQ_DOTS:
	case LSEQ_TO:
	    start = numValues[0];
	    end = numValues[2];
	    break;
4255
4256
4257
4258
4259
4260
4261
4262
4263


4264
4265
4266
4267
4268
4269
4270
4271
4417
4418
4419
4420
4421
4422
4423


4424
4425

4426
4427
4428
4429
4430
4431
4432







-
-
+
+
-







	    step = one;
	    break;
	default:
	    goto done;
	}
	break;

/*    lseq n 'to' n n    */
/*    lseq n 'count' n n */
    case 1211:			/* lseq n 'to' n n
				 * lseq n 'count' n n */
    case 1211:
	opmode = (SequenceOperators)values[1];
	switch (opmode) {
	case LSEQ_DOTS:
	case LSEQ_TO:
	    start = numValues[0];
	    end = numValues[2];
	    step = numValues[3];
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
4442
4443
4444
4445
4446
4447
4448


4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465


4466
4467

4468
4469
4470
4471
4472
4473
4474







-
-
+
















-
-
+
+
-







	    break;
	default:
	    goto done;
	    break;
	}
	break;

/*    lseq n n 'by' n */
    case 1121:
    case 1121:			/* lseq n n 'by' n */
	start = numValues[0];
	end = numValues[1];
	opmode = (SequenceOperators)values[2];
	switch (opmode) {
	case LSEQ_BY:
	    step = numValues[3];
	    break;
	case LSEQ_DOTS:
	case LSEQ_TO:
	case LSEQ_COUNT:
	default:
	    goto done;
	    break;
	}
	break;

/*    lseq n 'to' n 'by' n    */
/*    lseq n 'count' n 'by' n */
    case 12121:			/* lseq n 'to' n 'by' n
				 * lseq n 'count' n 'by' n */
    case 12121:
	start = numValues[0];
	opmode = (SequenceOperators)values[3];
	switch (opmode) {
	case LSEQ_BY:
	    step = numValues[4];
	    break;
	default:
4338
4339
4340
4341
4342
4343
4344
4345

4346
4347
4348
4349
4350
4351
4352
4497
4498
4499
4500
4501
4502
4503

4504
4505
4506
4507
4508
4509
4510
4511







-
+







      syntax:
	 Tcl_WrongNumArgs(interp, 1, objv, "n ??op? n ??by? n??");
	 goto done;
	 break;
    }

    /* Count needs to be integer, so try to convert if possible */
    if (elementCount && TclHasInternalRep(elementCount, &tclDoubleType)) {
    if (elementCount && TclHasInternalRep(elementCount, tclDoubleTypePtr)) {
	double d;
        // Don't consider Count type to indicate using double values in seqence
        useDoubles -= (useDoubles > 0) ? 1 : 0;
	(void)Tcl_GetDoubleFromObj(NULL, elementCount, &d);
	if (floor(d) == d) {
	    if ((d >= (double)WIDE_MAX) || (d <= (double)WIDE_MIN)) {
		mp_int big;
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376


4377

4378
4379
4380
4381
4382
4383
4384
4525
4526
4527
4528
4529
4530
4531

4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545







-



+
+

+








    /*
     * Success!  Now lets create the series object.
     */
    arithSeriesPtr = TclNewArithSeriesObj(interp,
		  useDoubles, start, end, step, elementCount);

    status = TCL_ERROR;
    if (arithSeriesPtr) {
	status = TCL_OK;
	Tcl_SetObjResult(interp, arithSeriesPtr);
    } else {
	status = TCL_ERROR;
    }


 done:
    // Free number arguments.
    while (--value_i>=0) {
	if (numValues[value_i]) {
	    if (elementCount == numValues[value_i]) {
		elementCount = NULL;
4392
4393
4394
4395
4396
4397
4398

4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419

4420
4421
4422
4423
4424
4425

4426
4427
4428
4429
4430
4431
4432
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580

4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595







+




















-
+






+








    /* Undef constants */
    #undef zero
    #undef one

    return status;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_LsetObjCmd --
 *
 *	This procedure is invoked to process the "lset" Tcl command. See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LsetObjCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    Tcl_Obj *listPtr;		/* Pointer to the list being altered. */
    Tcl_Obj *finalValuePtr;	/* Value finally assigned to the variable. */
    int status = TCL_OK;

    /*
     * Check parameter count.
     */

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv,
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462


4463
4464
4465
4466
4467
4468
4469
4470

4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492

4493
4494
4495
4496
4497
4498
4499
4610
4611
4612
4613
4614
4615
4616









4617
4618

4619
4620
4621
4622
4623
4624

4625
4626
4627
4628
4629
4630
4631
4632
4633
4634

4635
4636
4637
4638
4639
4640
4641
4642
4643
4644
4645

4646
4647
4648
4649
4650
4651
4652
4653







-
-
-
-
-
-
-
-
-
+
+
-






-
+









-











-
+







     * Substitute the value in the value. Return either the value or else an
     * unshared copy of it.
     */

    if (objc == 4) {
	finalValuePtr = TclLsetList(interp, listPtr, objv[2], objv[3]);
    } else {
	if (TclObjTypeHasProc(listPtr, setElementProc)) {
	    finalValuePtr = TclObjTypeSetElement(interp, listPtr,
						       objc-3, objv+2, objv[objc-1]);
	    if (finalValuePtr) {
		Tcl_IncrRefCount(finalValuePtr);
	    }
	} else {
	    finalValuePtr = TclLsetFlat(interp, listPtr, objc-3, objv+2,
					objv[objc-1]);
	status = TclLsetFlat(interp, listPtr, objc-3, objv+2,
		objv[objc-1], &finalValuePtr);
	}
    }

    /*
     * If substitution has failed, bail out.
     */

    if (finalValuePtr == NULL) {
    if (status != TCL_OK || finalValuePtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Finally, update the variable so that traces fire.
     */

    listPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, finalValuePtr,
	    TCL_LEAVE_ERR_MSG);
    Tcl_DecrRefCount(finalValuePtr);
    if (listPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Return the new value of the variable as the interpreter result.
     */

    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_LsortObjCmd --
 *
 *	This procedure is invoked to process the "lsort" Tcl command. See the
 *	user documentation for details on what it does.
4513
4514
4515
4516
4517
4518
4519
4520
4521


4522
4523
4524
4525
4526
4527
4528
4667
4668
4669
4670
4671
4672
4673


4674
4675
4676
4677
4678
4679
4680
4681
4682







-
-
+
+







    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    int indices, nocase = 0, indexc;
    int sortMode = SORTMODE_ASCII;
    int group, allocatedIndexVector = 0;
    Tcl_Size j, idx, groupOffset, length;
    Tcl_WideInt wide, groupSize;
    Tcl_Size j, idx, groupSize, groupOffset, length;
    Tcl_WideInt wide;
    Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr;
    Tcl_Size i, elmArrSize;
    SortElement *elementArray = NULL, *elementPtr;
    SortInfo sortInfo;		/* Information about this sort that needs to
				 * be passed to the comparison function. */
#   define MAXCALLOC 1024000
#   define NUM_LISTS 30
4729
4730
4731
4732
4733
4734
4735
4736

4737
4738
4739
4740
4741
4742
4743
4883
4884
4885
4886
4887
4888
4889

4890
4891
4892
4893
4894
4895
4896
4897







-
+







	/*
	 * When sorting using a command, we are reentrant and therefore might
	 * have the representation of the list being sorted shimmered out from
	 * underneath our feet. Take a copy (cheap) to prevent this. [Bug
	 * 1675116]
	 */

	listObj = TclListObjCopy(interp, listObj);
	listObj = TclDuplicatePureObj(interp ,listObj, tclListTypePtr);
	if (listObj == NULL) {
	    sortInfo.resultCode = TCL_ERROR;
	    goto done;
	}

	/*
	 * The existing command is a list. We want to flatten it, append two
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763




4764
4765
4766
4767
4768
4769
4770
4908
4909
4910
4911
4912
4913
4914



4915
4916
4917
4918
4919
4920
4921
4922
4923
4924
4925







-
-
-
+
+
+
+







	    sortInfo.resultCode = TCL_ERROR;
	    goto done;
	}
	Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj());
	sortInfo.compareCmdPtr = newCommandPtr;
    }

    if (TclObjTypeHasProc(objv[1], getElementsProc)) {
	sortInfo.resultCode =
	    TclObjTypeGetElements(interp, listObj, &length, &listObjPtrs);
    if (TclObjectHasInterface(listObj, list, all)) {
	TCL_UNUSEDVAR(int status);
	sortInfo.resultCode = TclObjectDispatchNoDefault(interp, status,
	    listObj, list, all, interp, listObj, &length, &listObjPtrs);
    } else {
	sortInfo.resultCode = TclListObjGetElements(interp, listObj,
	    &length, &listObjPtrs);
    }
    if (sortInfo.resultCode != TCL_OK || length <= 0) {
	goto done;
    }
4949
4950
4951
4952
4953
4954
4955
4956

4957
4958
4959
4960
4961
4962
4963
5104
5105
5106
5107
5108
5109
5110

5111
5112
5113
5114
5115
5116
5117
5118







-
+







	ListRep listRep;
	Tcl_Obj **newArray, *objPtr;

	resultPtr = Tcl_NewListObj(sortInfo.numElements * groupSize, NULL);
	ListObjGetRep(resultPtr, &listRep);
	newArray = ListRepElementsBase(&listRep);
	if (group) {
	    for (i=0; elementPtr!=NULL ; elementPtr=elementPtr->nextPtr) {
	    for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
		idx = elementPtr->payload.index;
		for (j = 0; j < groupSize; j++) {
		    if (indices) {
			TclNewIndexObj(objPtr, idx + j - groupOffset);
			newArray[i++] = objPtr;
			Tcl_IncrRefCount(objPtr);
		    } else {
5077
5078
5079
5080
5081
5082
5083
5084

5085
5086
5087
5088
5089

5090



5091
5092
5093
5094
5095
5096
5097
5232
5233
5234
5235
5236
5237
5238

5239
5240
5241
5242
5243
5244
5245

5246
5247
5248
5249
5250
5251
5252
5253
5254
5255







-
+





+
-
+
+
+







	first = listLen;
    }

    if (last >= listLen) {
	last = listLen - 1;
    }
    if (first <= last) {
	numToDelete = (size_t)last - (size_t)first + 1; /* See [3d3124d01d] */
	numToDelete = last - first + 1;
    } else {
	numToDelete = 0;
    }

    if (Tcl_IsShared(listPtr)) {
	listPtr = TclDuplicatePureObj(interp, listPtr, tclListTypePtr);
	listPtr = TclListObjCopy(NULL, listPtr);
	if (!listPtr) {
	    return TCL_ERROR;
	}
	createdNewObj = 1;
    } else {
	createdNewObj = 0;
    }

    result =
	Tcl_ListObjReplace(interp, listPtr, first, numToDelete, objc - 4, objv + 4);
Changes to generic/tclCmdMZ.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
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

-
-
-
-
-
-
-










+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








+







/*
 * tclCmdMZ.c --
 *
 *	This file contains the top-level command routines for most of the Tcl
 *	built-in commands whose names begin with the letters M to Z. It
 *	contains only commands in the generic core (i.e. those that don't
 *	depend much upon UNIX facilities).
 *
 * Copyright © 1987-1993 The Regents of the University of California.
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 * Copyright © 1998-2000 Scriptics Corporation.
 * Copyright © 2002 ActiveState Corporation.
 * Copyright © 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclCmdMZ.c --
 *
 *	This file contains the top-level command routines for most of the Tcl
 *	built-in commands whose names begin with the letters M to Z. It
 *	contains only commands in the generic core (i.e. those that don't
 *	depend much upon UNIX facilities).
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tclRegexp.h"
#include "tclStringTrim.h"
#include "tclTomMath.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;
static Tcl_NRPostProc	TryPostFinal;
static Tcl_NRPostProc	TryPostHandler;
static int		UniCharIsAscii(int character);
static int		UniCharIsHexDigit(int character);
static int		StringCmpOpts(Tcl_Interp *interp, int objc,
1185
1186
1187
1188
1189
1190
1191
1192

1193
1194
1195
1196
1197
1198

1199
1200
1201
1202
1203
1204
1205
1197
1198
1199
1200
1201
1202
1203

1204
1205
1206
1207
1208
1209

1210
1211
1212
1213
1214
1215
1216
1217







-
+





-
+







    Tcl_Size splitCharLen, stringLen;
    Tcl_Obj *listPtr, *objPtr;

    if (objc == 2) {
	splitChars = " \n\t\r";
	splitCharLen = 4;
    } else if (objc == 3) {
	splitChars = TclGetStringFromObj(objv[2], &splitCharLen);
	splitChars = Tcl_GetStringFromObj(objv[2], &splitCharLen);
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?splitChars?");
	return TCL_ERROR;
    }

    stringPtr = TclGetStringFromObj(objv[1], &stringLen);
    stringPtr = Tcl_GetStringFromObj(objv[1], &stringLen);
    end = stringPtr + stringLen;
    TclNewObj(listPtr);

    if (stringLen == 0) {
	/*
	 * Do nothing.
	 */
1242
1243
1244
1245
1246
1247
1248
1249

1250
1251
1252
1253
1254
1255
1256
1254
1255
1256
1257
1258
1259
1260

1261
1262
1263
1264
1265
1266
1267
1268







-
+








	/*
	 * Handle the special case of splitting on a single character. This is
	 * only true for the one-char ASCII case, as one Unicode char is > 1
	 * byte in length.
	 */

	while (*stringPtr && (p=strchr(stringPtr,*splitChars)) != NULL) {
	while (*stringPtr && (p=strchr(stringPtr, *splitChars)) != NULL) {
	    objPtr = Tcl_NewStringObj(stringPtr, p - stringPtr);
	    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
	    stringPtr = p + 1;
	}
	TclNewStringObj(objPtr, stringPtr, end - stringPtr);
	Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
    } else {
1310
1311
1312
1313
1314
1315
1316
1317

1318
1319
1320
1321
1322
1323
1324
1322
1323
1324
1325
1326
1327
1328

1329
1330
1331
1332
1333
1334
1335
1336







-
+







    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Size start = TCL_INDEX_START;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"needleString haystackString ?startIndex?");
	    "needleString haystackString ?startIndex?");
	return TCL_ERROR;
    }

    if (objc == 4) {
	Tcl_Size end = Tcl_GetCharLength(objv[2]) - 1;

	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], end, &start)) {
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
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







+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+

-
-
-
-
+
+
+
+

-
-
+
+

-
-
-
+
+
+

-
-
-
-
+
+
+
+

-
-
+
+

-
-
-
+
+
+

-
-
-
-
-
+
+
+
+
+
+







    Tcl_Size index, end;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "string charIndex");
	return TCL_ERROR;
    }

    if (TclObjectHasInterface(objv[1], string, index)) {
	int status;
	Tcl_Obj *charPtr;
	status = TclStringIndexInterface(interp, objv[1], objv[2], &charPtr) ;
	if (status != TCL_OK) {
	    return status;
	} else {
	    Tcl_SetObjResult(interp, charPtr);
	    return TCL_OK;
	}
    } else {
    /*
     * Get the char length to calculate what 'end' means.
     */
	/*
	 * Get the char length to calculate what 'end' means.
	 */

    end = Tcl_GetCharLength(objv[1]) - 1;
    if (TclGetIntForIndexM(interp, objv[2], end, &index) != TCL_OK) {
	return TCL_ERROR;
    }
	end = Tcl_GetCharLength(objv[1]) - 1;
	if (TclGetIntForIndexM(interp, objv[2], end, &index) != TCL_OK) {
	    return TCL_ERROR;
	}

    if ((index >= 0) && (index <= end)) {
	int ch = Tcl_GetUniChar(objv[1], index);
	if ((index >= 0) && (index <= end)) {
	    int ch = Tcl_GetUniChar(objv[1], index);

	if (ch == -1) {
	    return TCL_OK;
	}
	    if (ch == -1) {
		return TCL_OK;
	    }

	/*
	 * If we have a ByteArray object, we're careful to generate a new
	 * bytearray for a result.
	 */
	    /*
	     * If we have a ByteArray object, we're careful to generate a new
	     * bytearray for a result.
	     */

	if (TclIsPureByteArray(objv[1])) {
	    unsigned char uch = UCHAR(ch);
	    if (TclIsPureByteArray(objv[1])) {
		unsigned char uch = UCHAR(ch);

	    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
	} else {
	    char buf[4] = "";
		Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
	    } else {
		char buf[4] = "";

	    end = Tcl_UniCharToUtf(ch, buf);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, end));
	}
    }
    return TCL_OK;
		end = Tcl_UniCharToUtf(ch, buf);
		Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, end));
	    }
	}
	return TCL_OK;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * StringInsertCmd --
 *
1606
1607
1608
1609
1610
1611
1612
1613

1614
1615
1616
1617
1618

1619
1620
1621
1622
1623
1624
1625
1630
1631
1632
1633
1634
1635
1636

1637
1638
1639
1640
1641

1642
1643
1644
1645
1646
1647
1648
1649







-
+




-
+







	break;
    case STR_IS_ASCII:
	chcomp = UniCharIsAscii;
	break;
    case STR_IS_BOOL:
    case STR_IS_TRUE:
    case STR_IS_FALSE:
	if (!TclHasInternalRep(objPtr, &tclBooleanType)
	if (!TclHasInternalRep(objPtr, tclBooleanTypePtr)
		&& (TCL_OK != TclSetBooleanFromAny(NULL, objPtr))) {
	    if (strict) {
		result = 0;
	    } else {
		string1 = TclGetStringFromObj(objPtr, &length1);
		string1 = Tcl_GetStringFromObj(objPtr, &length1);
		result = length1 == 0;
	    }
	} else if ((objPtr->internalRep.wideValue != 0)
		? (index == STR_IS_FALSE) : (index == STR_IS_TRUE)) {
	    result = 0;
	}
	break;
1640
1641
1642
1643
1644
1645
1646
1647

1648
1649
1650
1651
1652
1653
1654
1664
1665
1666
1667
1668
1669
1670

1671
1672
1673
1674
1675
1676
1677
1678







-
+







	     * SetDictFromAny().
	     */

	    const char *elemStart, *nextElem;
	    Tcl_Size lenRemain, elemSize;
	    const char *p;

	    string1 = TclGetStringFromObj(objPtr, &length1);
	    string1 = Tcl_GetStringFromObj(objPtr, &length1);
	    end = string1 + length1;
	    failat = -1;
	    for (p=string1, lenRemain=length1; lenRemain > 0;
		    p=nextElem, lenRemain=end-nextElem) {
		if (TCL_ERROR == TclFindElement(NULL, p, lenRemain,
			&elemStart, &nextElem, &elemSize, NULL)) {
		    Tcl_Obj *tmpStr;
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684



1685
1686
1687

1688
1689
1690
1691
1692
1693
1694
1699
1700
1701
1702
1703
1704
1705



1706
1707
1708
1709
1710

1711
1712
1713
1714
1715
1716
1717
1718







-
-
-
+
+
+


-
+







	}
	break;
    }
    case STR_IS_DIGIT:
	chcomp = Tcl_UniCharIsDigit;
	break;
    case STR_IS_DOUBLE: {
	if (TclHasInternalRep(objPtr, &tclDoubleType) ||
		TclHasInternalRep(objPtr, &tclIntType) ||
		TclHasInternalRep(objPtr, &tclBignumType)) {
	if (TclHasInternalRep(objPtr, tclDoubleTypePtr) ||
		TclHasInternalRep(objPtr, tclIntTypePtr) ||
		TclHasInternalRep(objPtr, tclBignumTypePtr)) {
	    break;
	}
	string1 = TclGetStringFromObj(objPtr, &length1);
	string1 = Tcl_GetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	end = string1 + length1;
1706
1707
1708
1709
1710
1711
1712
1713
1714


1715
1716
1717

1718
1719
1720
1721
1722
1723
1724
1730
1731
1732
1733
1734
1735
1736


1737
1738
1739
1740

1741
1742
1743
1744
1745
1746
1747
1748







-
-
+
+


-
+







	break;
    }
    case STR_IS_GRAPH:
	chcomp = Tcl_UniCharIsGraph;
	break;
    case STR_IS_INT:
    case STR_IS_ENTIER:
	if (TclHasInternalRep(objPtr, &tclIntType) ||
		TclHasInternalRep(objPtr, &tclBignumType)) {
	if (TclHasInternalRep(objPtr, tclIntTypePtr) ||
		TclHasInternalRep(objPtr, tclBignumTypePtr)) {
	    break;
	}
	string1 = TclGetStringFromObj(objPtr, &length1);
	string1 = Tcl_GetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	end = string1 + length1;
1752
1753
1754
1755
1756
1757
1758
1759

1760
1761
1762
1763
1764
1765
1766
1776
1777
1778
1779
1780
1781
1782

1783
1784
1785
1786
1787
1788
1789
1790







-
+







	}
	break;
    case STR_IS_WIDE:
	if (TCL_OK == TclGetWideIntFromObj(NULL, objPtr, &w)) {
	    break;
	}

	string1 = TclGetStringFromObj(objPtr, &length1);
	string1 = Tcl_GetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	result = 0;
1821
1822
1823
1824
1825
1826
1827
1828

1829
1830
1831
1832
1833
1834
1835
1845
1846
1847
1848
1849
1850
1851

1852
1853
1854
1855
1856
1857
1858
1859







-
+







	     */

	    const char *elemStart, *nextElem;
	    Tcl_Size lenRemain;
	    Tcl_Size elemSize;
	    const char *p;

	    string1 = TclGetStringFromObj(objPtr, &length1);
	    string1 = Tcl_GetStringFromObj(objPtr, &length1);
	    end = string1 + length1;
	    failat = -1;
	    for (p=string1, lenRemain=length1; lenRemain > 0;
		    p=nextElem, lenRemain=end-nextElem) {
		if (TCL_ERROR == TclFindElement(NULL, p, lenRemain,
			&elemStart, &nextElem, &elemSize, NULL)) {
		    Tcl_Obj *tmpStr;
1876
1877
1878
1879
1880
1881
1882
1883

1884
1885
1886
1887
1888
1889
1890
1900
1901
1902
1903
1904
1905
1906

1907
1908
1909
1910
1911
1912
1913
1914







-
+







	break;
    case STR_IS_XDIGIT:
	chcomp = UniCharIsHexDigit;
	break;
    }

    if (chcomp != NULL) {
	string1 = TclGetStringFromObj(objPtr, &length1);
	string1 = Tcl_GetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	end = string1 + length1;
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
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







-
+



















-
+








    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string");
	return TCL_ERROR;
    }

    if (objc == 4) {
	const char *string = TclGetStringFromObj(objv[1], &length2);
	const char *string = Tcl_GetStringFromObj(objv[1], &length2);

	if ((length2 > 1) &&
		strncmp(string, "-nocase", length2) == 0) {
	    nocase = 1;
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase", string));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string, (char *)NULL);
	    return TCL_ERROR;
	}
    }

    /*
     * This test is tricky, but has to be that way or you get other strange
     * inconsistencies (see test string-10.20.1 for illustration why!)
     */

    if (!TclHasStringRep(objv[objc-2])
	    && TclHasInternalRep(objv[objc-2], &tclDictType)) {
	    && TclHasInternalRep(objv[objc-2], tclDictTypePtr)) {
	Tcl_Size i;
	int done;
	Tcl_DictSearch search;

	/*
	 * We know the type exactly, so all dict operations will succeed for
	 * sure. This shortens this code quite a bit.
2235
2236
2237
2238
2239
2240
2241
2242

2243
2244
2245
2246
2247
2248
2249
2259
2260
2261
2262
2263
2264
2265

2266
2267
2268
2269
2270
2271
2272
2273







-
+







    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? pattern string");
	return TCL_ERROR;
    }

    if (objc == 4) {
	Tcl_Size length;
	const char *string = TclGetStringFromObj(objv[1], &length);
	const char *string = Tcl_GetStringFromObj(objv[1], &length);

	if ((length > 1) && strncmp(string, "-nocase", length) == 0) {
	    nocase = TCL_MATCH_NOCASE;
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase", string));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
2403
2404
2405
2406
2407
2408
2409
2410

2411
2412
2413
2414
2415
2416
2417
2427
2428
2429
2430
2431
2432
2433

2434
2435
2436
2437
2438
2439
2440
2441







-
+








    /*
     * The following test screens out most empty substrings as candidates for
     * replacement. When they are detected, no replacement is done, and the
     * result is the original string.
     */

    if ((last < 0) ||	/* Range ends before start of string */
    if ((last < 0) ||		/* Range ends before start of string */
	    (first > end) ||	/* Range begins after end of string */
	    (last < first)) {	/* Range begins after it starts */
	/*
	 * BUT!!! when (end < 0) -- an empty original string -- we can
	 * have (first <= end < 0 <= last) and an empty string is permitted
	 * to be replaced.
	 */
2523
2524
2525
2526
2527
2528
2529
2530

2531
2532
2533
2534

2535
2536
2537
2538
2539
2540
2541
2547
2548
2549
2550
2551
2552
2553

2554
2555
2556

2557
2558
2559
2560
2561
2562
2563
2564
2565







-
+


-

+







	    int delta = 0;
	    const Tcl_UniChar *next;

	    if (!Tcl_UniCharIsWordChar(ch)) {
		break;
	    }

	    next = ((p > string) ? (p - 1) : p);
		next = p > string ? p - 1 : p;
	    do {
		next += delta;
		ch = *next;
		delta = 1;
		ch = *next;
	    } while (next + delta < p);
	    p = next;
	}
	if (cur != index) {
	    cur += 1;
	}
    }
2645
2646
2647
2648
2649
2650
2651
2652

2653
2654
2655
2656
2657
2658
2659
2669
2670
2671
2672
2673
2674
2675

2676
2677
2678
2679
2680
2681
2682
2683







-
+







    str_cmp_args:
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-nocase? ?-length int? string1 string2");
	return TCL_ERROR;
    }

    for (i = 1; i < objc-2; i++) {
	string2 = TclGetStringFromObj(objv[i], &length);
	string2 = Tcl_GetStringFromObj(objv[i], &length);
	if ((length > 1) && !strncmp(string2, "-nocase", length)) {
	    nocase = 1;
	} else if ((length > 1)
		&& !strncmp(string2, "-length", length)) {
	    if (i+1 >= objc-2) {
		goto str_cmp_args;
	    }
2748
2749
2750
2751
2752
2753
2754
2755

2756
2757
2758
2759
2760
2761
2762
2772
2773
2774
2775
2776
2777
2778

2779
2780
2781
2782
2783
2784
2785
2786







-
+







    str_cmp_args:
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-nocase? ?-length int? string1 string2");
	return TCL_ERROR;
    }

    for (i = 1; i < objc-2; i++) {
	string = TclGetStringFromObj(objv[i], &length);
	string = Tcl_GetStringFromObj(objv[i], &length);
	if ((length > 1) && !strncmp(string, "-nocase", length)) {
	    *nocase = 1;
	} else if ((length > 1)
		&& !strncmp(string, "-length", length)) {
	    if (i+1 >= objc-2) {
		goto str_cmp_args;
	    }
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
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







-
+













-
+




















-
+







    char *string2;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
	return TCL_ERROR;
    }

    string1 = TclGetStringFromObj(objv[1], &length1);
    string1 = Tcl_GetStringFromObj(objv[1], &length1);

    if (objc == 2) {
	Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1);

	length1 = Tcl_UtfToLower(TclGetString(resultPtr));
	Tcl_SetObjLength(resultPtr, length1);
	Tcl_SetObjResult(interp, resultPtr);
    } else {
	Tcl_Size first, last;
	const char *start, *end;
	Tcl_Obj *resultPtr;

	length1 = Tcl_NumUtfChars(string1, length1) - 1;
	if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
	if (TclGetIntForIndexM(interp, objv[2], length1, &first) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (first < 0) {
	    first = 0;
	}
	last = first;

	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
		&last) != TCL_OK)) {
	    return TCL_ERROR;
	}

	if (last >= length1) {
	    last = length1;
	}
	if (last < first) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}

	string1 = TclGetStringFromObj(objv[1], &length1);
	string1 = Tcl_GetStringFromObj(objv[1], &length1);
	start = Tcl_UtfAtIndex(string1, first);
	end = Tcl_UtfAtIndex(start, last - first + 1);
	resultPtr = Tcl_NewStringObj(string1, end - string1);
	string2 = TclGetString(resultPtr) + (start - string1);

	length2 = Tcl_UtfToLower(string2);
	Tcl_SetObjLength(resultPtr, length2 + (start - string1));
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
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







-
+













-
+




















-
+







    char *string2;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
	return TCL_ERROR;
    }

    string1 = TclGetStringFromObj(objv[1], &length1);
    string1 = Tcl_GetStringFromObj(objv[1], &length1);

    if (objc == 2) {
	Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1);

	length1 = Tcl_UtfToUpper(TclGetString(resultPtr));
	Tcl_SetObjLength(resultPtr, length1);
	Tcl_SetObjResult(interp, resultPtr);
    } else {
	Tcl_Size first, last;
	const char *start, *end;
	Tcl_Obj *resultPtr;

	length1 = Tcl_NumUtfChars(string1, length1) - 1;
	if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
	if (TclGetIntForIndexM(interp, objv[2], length1, &first) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (first < 0) {
	    first = 0;
	}
	last = first;

	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
		&last) != TCL_OK)) {
	    return TCL_ERROR;
	}

	if (last >= length1) {
	    last = length1;
	}
	if (last < first) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}

	string1 = TclGetStringFromObj(objv[1], &length1);
	string1 = Tcl_GetStringFromObj(objv[1], &length1);
	start = Tcl_UtfAtIndex(string1, first);
	end = Tcl_UtfAtIndex(start, last - first + 1);
	resultPtr = Tcl_NewStringObj(string1, end - string1);
	string2 = TclGetString(resultPtr) + (start - string1);

	length2 = Tcl_UtfToUpper(string2);
	Tcl_SetObjLength(resultPtr, length2 + (start - string1));
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
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







-
+













-
+




















-
+







    char *string2;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
	return TCL_ERROR;
    }

    string1 = TclGetStringFromObj(objv[1], &length1);
    string1 = Tcl_GetStringFromObj(objv[1], &length1);

    if (objc == 2) {
	Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1);

	length1 = Tcl_UtfToTitle(TclGetString(resultPtr));
	Tcl_SetObjLength(resultPtr, length1);
	Tcl_SetObjResult(interp, resultPtr);
    } else {
	Tcl_Size first, last;
	const char *start, *end;
	Tcl_Obj *resultPtr;

	length1 = Tcl_NumUtfChars(string1, length1) - 1;
	if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
	if (TclGetIntForIndexM(interp, objv[2], length1, &first) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (first < 0) {
	    first = 0;
	}
	last = first;

	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
		&last) != TCL_OK)) {
	    return TCL_ERROR;
	}

	if (last >= length1) {
	    last = length1;
	}
	if (last < first) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}

	string1 = TclGetStringFromObj(objv[1], &length1);
	string1 = Tcl_GetStringFromObj(objv[1], &length1);
	start = Tcl_UtfAtIndex(string1, first);
	end = Tcl_UtfAtIndex(start, last - first + 1);
	resultPtr = Tcl_NewStringObj(string1, end - string1);
	string2 = TclGetString(resultPtr) + (start - string1);

	length2 = Tcl_UtfToTitle(string2);
	Tcl_SetObjLength(resultPtr, length2 + (start - string1));
3139
3140
3141
3142
3143
3144
3145
3146

3147
3148
3149
3150
3151
3152
3153
3154

3155
3156
3157
3158
3159
3160
3161
3163
3164
3165
3166
3167
3168
3169

3170
3171
3172
3173
3174
3175
3176
3177

3178
3179
3180
3181
3182
3183
3184
3185







-
+







-
+







    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *string2;
    Tcl_Size triml, trimr, length1, length2;

    if (objc == 3) {
	string2 = TclGetStringFromObj(objv[2], &length2);
	string2 = Tcl_GetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
	return TCL_ERROR;
    }
    string1 = TclGetStringFromObj(objv[1], &length1);
    string1 = Tcl_GetStringFromObj(objv[1], &length1);

    triml = TclTrim(string1, length1, string2, length2, &trimr);

    Tcl_SetObjResult(interp,
	    Tcl_NewStringObj(string1 + triml, length1 - triml - trimr));
    return TCL_OK;
}
3187
3188
3189
3190
3191
3192
3193
3194

3195
3196
3197
3198
3199
3200
3201
3202

3203
3204
3205
3206
3207
3208
3209
3211
3212
3213
3214
3215
3216
3217

3218
3219
3220
3221
3222
3223
3224
3225

3226
3227
3228
3229
3230
3231
3232
3233







-
+







-
+







    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *string2;
    int trim;
    Tcl_Size length1, length2;

    if (objc == 3) {
	string2 = TclGetStringFromObj(objv[2], &length2);
	string2 = Tcl_GetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
	return TCL_ERROR;
    }
    string1 = TclGetStringFromObj(objv[1], &length1);
    string1 = Tcl_GetStringFromObj(objv[1], &length1);

    trim = TclTrimLeft(string1, length1, string2, length2);

    Tcl_SetObjResult(interp, Tcl_NewStringObj(string1+trim, length1-trim));
    return TCL_OK;
}

3234
3235
3236
3237
3238
3239
3240
3241

3242
3243
3244
3245
3246
3247
3248
3249

3250
3251
3252
3253
3254
3255
3256
3258
3259
3260
3261
3262
3263
3264

3265
3266
3267
3268
3269
3270
3271
3272

3273
3274
3275
3276
3277
3278
3279
3280







-
+







-
+







    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *string2;
    int trim;
    Tcl_Size length1, length2;

    if (objc == 3) {
	string2 = TclGetStringFromObj(objv[2], &length2);
	string2 = Tcl_GetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
	return TCL_ERROR;
    }
    string1 = TclGetStringFromObj(objv[1], &length1);
    string1 = Tcl_GetStringFromObj(objv[1], &length1);

    trim = TclTrimRight(string1, length1, string2, length2);

    Tcl_SetObjResult(interp, Tcl_NewStringObj(string1, length1-trim));
    return TCL_OK;
}

3659
3660
3661
3662
3663
3664
3665
3666

3667
3668
3669
3670
3671
3672
3673
3683
3684
3685
3686
3687
3688
3689

3690
3691
3692
3693
3694
3695
3696
3697







-
+







    }

    for (i = 0; i < objc; i += 2) {
	/*
	 * See if the pattern matches the string.
	 */

	pattern = TclGetStringFromObj(objv[i], &patternLength);
	pattern = Tcl_GetStringFromObj(objv[i], &patternLength);

	if ((i == objc - 2) && (*pattern == 'd')
		&& (strcmp(pattern, "default") == 0)) {
	    Tcl_Obj *emptyObj = NULL;

	    /*
	     * If either indexVarObj or matchVarObj are non-NULL, we're in
3698
3699
3700
3701
3702
3703
3704
3705

3706
3707
3708
3709
3710
3711
3712
3722
3723
3724
3725
3726
3727
3728

3729
3730
3731
3732
3733
3734
3735
3736







-
+







	switch (mode) {
	case OPT_EXACT:
	    if (strCmpFn(TclGetString(stringObj), pattern) == 0) {
		goto matchFound;
	    }
	    break;
	case OPT_GLOB:
	    if (Tcl_StringCaseMatch(TclGetString(stringObj),pattern,noCase)) {
	    if (Tcl_StringCaseMatch(TclGetString(stringObj), pattern, noCase)) {
		goto matchFound;
	    }
	    break;
	case OPT_REGEXP:
	    regExpr = Tcl_GetRegExpFromObj(interp, objv[i],
		    TCL_REG_ADVANCED | (noCase ? TCL_REG_NOCASE : 0));
	    if (regExpr == NULL) {
5300
5301
5302
5303
5304
5305
5306
5307

5308
5309
5310
5311
5312
5313
5314
5324
5325
5326
5327
5328
5329
5330

5331
5332
5333
5334
5335
5336
5337
5338







-
+







TclListLines(
    Tcl_Obj *listObj,		/* Pointer to obj holding a string with list
				 * structure. Assumed to be valid. Assumed to
				 * contain n elements. */
    Tcl_Size line,		/* Line the list as a whole starts on. */
    Tcl_Size n,			/* #elements in lines */
    Tcl_Size *lines,		/* Array of line numbers, to fill. */
    Tcl_Obj *const *elems)      /* The list elems as Tcl_Obj*, in need of
    Tcl_Obj *const *elems)	/* The list elems as Tcl_Obj*, in need of
				 * derived continuation data */
{
    const char *listStr = TclGetString(listObj);
    const char *listHead = listStr;
    Tcl_Size i, length = strlen(listStr);
    const char *element = NULL, *next = NULL;
    ContLineLoc *clLocPtr = TclContinuationsGet(listObj);
Changes to generic/tclCompCmds.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
















16
17
18
19
20
21
22
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

-
-
-
-
-









+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclCompCmds.c --
 *
 *	This file contains compilation procedures that compile various Tcl
 *	commands into a sequence of instructions ("bytecodes").
 *
 * Copyright © 1997-1998 Sun Microsystems, Inc.
 * Copyright © 2001 Kevin B. Kenny.  All rights reserved.
 * Copyright © 2002 ActiveState Corporation.
 * Copyright © 2004-2013 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclCompCmds.c --
 *
 *	This file contains compilation procedures that compile various Tcl
 *	commands into a sequence of instructions ("bytecodes").
 */

#include "tclInt.h"
#include "tclCompile.h"
#include <assert.h>

/*
 * Prototypes for procedures defined later in this file:
 */
387
388
389
390
391
392
393

394

395
396


397
398
399
400
401
402
403
398
399
400
401
402
403
404
405

406
407

408
409
410
411
412
413
414
415
416







+
-
+

-
+
+







    /*
     * Prepare for the internal foreach.
     */

    keyVar = AnonymousLocal(envPtr);
    valVar = AnonymousLocal(envPtr);

    infoPtr = (ForeachInfo *)
    infoPtr = (ForeachInfo *)Tcl_Alloc(offsetof(ForeachInfo, varLists) + sizeof(ForeachVarList *));
	    Tcl_Alloc(offsetof(ForeachInfo, varLists) + sizeof(ForeachVarList *));
    infoPtr->numLists = 1;
    infoPtr->varLists[0] = (ForeachVarList *)Tcl_Alloc(offsetof(ForeachVarList, varIndexes) + 2 * sizeof(Tcl_Size));
    infoPtr->varLists[0] = (ForeachVarList *)
	    Tcl_Alloc(offsetof(ForeachVarList, varIndexes) + 2 * sizeof(Tcl_Size));
    infoPtr->varLists[0]->numVars = 2;
    infoPtr->varLists[0]->varIndexes[0] = keyVar;
    infoPtr->varLists[0]->varIndexes[1] = valVar;
    infoIndex = TclCreateAuxData(infoPtr, &newForeachInfoType, envPtr);

    /*
     * Start issuing instructions to write to the array.
889
890
891
892
893
894
895
896

897
898
899
900
901
902
903
902
903
904
905
906
907
908

909
910
911
912
913
914
915
916







-
+







	Tcl_Obj **objs;
	const char *bytes;
	Tcl_Size len, slen;

	TclListObjGetElements(NULL, listObj, &len, &objs);
	objPtr = Tcl_ConcatObj(len, objs);
	Tcl_DecrRefCount(listObj);
	bytes = TclGetStringFromObj(objPtr, &slen);
	bytes = Tcl_GetStringFromObj(objPtr, &slen);
	PushLiteral(envPtr, bytes, slen);
	Tcl_DecrRefCount(objPtr);
	return TCL_OK;
    }

    /*
     * General case: runtime concat.
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
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







-
+









-
+







	Tcl_Size numBytes;
	int code;
	Tcl_Token *incrTokenPtr;
	Tcl_Obj *intObj;

	incrTokenPtr = TokenAfter(keyTokenPtr);
	if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr);
	    return TclCompileBasic2Or3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
	}
	word = incrTokenPtr[1].start;
	numBytes = incrTokenPtr[1].size;

	intObj = Tcl_NewStringObj(word, numBytes);
	Tcl_IncrRefCount(intObj);
	code = TclGetIntFromObj(NULL, intObj, &incrAmount);
	TclDecrRefCount(intObj);
	if (code != TCL_OK) {
	    return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr);
	    return TclCompileBasic2Or3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
	}
    } else {
	incrAmount = 1;
    }

    /*
     * The dictionary variable must be a local scalar that is knowable at
1404
1405
1406
1407
1408
1409
1410
1411

1412
1413
1414
1415
1416
1417
1418
1417
1418
1419
1420
1421
1422
1423

1424
1425
1426
1427
1428
1429
1430
1431







-
+







	Tcl_DecrRefCount(valueObj);
    }

    /*
     * We did! Excellent. The "verifyDict" is to do type forcing.
     */

    bytes = TclGetStringFromObj(dictObj, &len);
    bytes = Tcl_GetStringFromObj(dictObj, &len);
    PushLiteral(envPtr, bytes, len);
    TclEmitOpcode(		INST_DUP,			envPtr);
    TclEmitOpcode(		INST_DICT_VERIFY,		envPtr);
    Tcl_DecrRefCount(dictObj);
    return TCL_OK;

    /*
1995
1996
1997
1998
1999
2000
2001
2002

2003
2004
2005
2006
2007
2008
2009
2008
2009
2010
2011
2012
2013
2014

2015
2016
2017
2018
2019
2020
2021
2022







-
+







    /*
     * Get the index of the local variable that we will be working with.
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    dictVarIndex = LocalScalarFromToken(tokenPtr, envPtr);
    if (dictVarIndex < 0) {
	return TclCompileBasicMin2ArgCmd(interp, parsePtr,cmdPtr, envPtr);
	return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    /*
     * Produce the string to concatenate onto the dictionary entry.
     */

    tokenPtr = TokenAfter(tokenPtr);
2844
2845
2846
2847
2848
2849
2850
2851

2852
2853
2854
2855
2856
2857
2858
2857
2858
2859
2860
2861
2862
2863

2864
2865
2866
2867
2868
2869
2870
2871







-
+







	for (j = 0;  j < numVars;  j++) {
	    Tcl_Obj *varNameObj;
	    const char *bytes;
	    int varIndex;
	    Tcl_Size length;

	    Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
	    bytes = TclGetStringFromObj(varNameObj, &length);
	    bytes = Tcl_GetStringFromObj(varNameObj, &length);
	    varIndex = LocalScalar(bytes, length, envPtr);
	    if (varIndex < 0) {
		code = TCL_ERROR;
		goto done;
	    }
	    varListPtr->varIndexes[j] = varIndex;
	}
2960
2961
2962
2963
2964
2965
2966
2967

2968
2969
2970
2971
2972
2973
2974
2973
2974
2975
2976
2977
2978
2979

2980
2981
2982
2983
2984
2985
2986
2987







-
+







 *	the new ForeachInfo record.
 *
 *----------------------------------------------------------------------
 */

static void *
DupForeachInfo(
    void *clientData)	/* The foreach command's compilation auxiliary
    void *clientData)		/* The foreach command's compilation auxiliary
				 * data to duplicate. */
{
    ForeachInfo *srcPtr = (ForeachInfo *)clientData;
    ForeachInfo *dupPtr;
    ForeachVarList *srcListPtr, *dupListPtr;
    int numVars, i, j, numLists = srcPtr->numLists;

3009
3010
3011
3012
3013
3014
3015
3016

3017
3018
3019
3020
3021
3022
3023
3022
3023
3024
3025
3026
3027
3028

3029
3030
3031
3032
3033
3034
3035
3036







-
+







 *	ForeachInfo structure.
 *
 *----------------------------------------------------------------------
 */

static void
FreeForeachInfo(
    void *clientData)	/* The foreach command's compilation auxiliary
    void *clientData)		/* The foreach command's compilation auxiliary
				 * data to free. */
{
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *listPtr;
    size_t i, numLists = infoPtr->numLists;

    for (i = 0;  i < numLists;  i++) {
3279
3280
3281
3282
3283
3284
3285
3286

3287
3288
3289
3290
3291
3292
3293
3292
3293
3294
3295
3296
3297
3298

3299
3300
3301
3302
3303
3304
3305
3306







-
+







    }

    /*
     * Not an error, always a constant result, so just push the result as a
     * literal. Job done.
     */

    bytes = TclGetStringFromObj(tmpObj, &len);
    bytes = Tcl_GetStringFromObj(tmpObj, &len);
    PushLiteral(envPtr, bytes, len);
    Tcl_DecrRefCount(tmpObj);
    return TCL_OK;

  checkForStringConcatCase:
    /*
     * See if we can generate a sequence of things to concatenate. This
3342
3343
3344
3345
3346
3347
3348
3349

3350
3351
3352
3353
3354
3355
3356
3357

3358
3359
3360
3361
3362
3363
3364
3355
3356
3357
3358
3359
3360
3361

3362
3363
3364
3365
3366
3367
3368
3369

3370
3371
3372
3373
3374
3375
3376
3377







-
+







-
+








    i = 0;			/* The count of things to concat. */
    j = 2;			/* The index into the argument tokens, for
				 * TIP#280 handling. */
    start = TclGetString(formatObj);
				/* The start of the currently-scanned literal
				 * in the format string. */
    TclNewObj(tmpObj);	/* The buffer used to accumulate the literal
    TclNewObj(tmpObj);		/* The buffer used to accumulate the literal
				 * being built. */
    for (bytes = start ; *bytes ; bytes++) {
	if (*bytes == '%') {
	    Tcl_AppendToObj(tmpObj, start, bytes - start);
	    if (*++bytes == '%') {
		Tcl_AppendToObj(tmpObj, "%", 1);
	    } else {
		const char *b = TclGetStringFromObj(tmpObj, &len);
		const char *b = Tcl_GetStringFromObj(tmpObj, &len);

		/*
		 * If there is a non-empty literal from the format string,
		 * push it and reset.
		 */

		if (len > 0) {
3384
3385
3386
3387
3388
3389
3390
3391

3392
3393
3394
3395
3396
3397
3398
3397
3398
3399
3400
3401
3402
3403

3404
3405
3406
3407
3408
3409
3410
3411







-
+







    }

    /*
     * Handle the case of a trailing literal.
     */

    Tcl_AppendToObj(tmpObj, start, bytes - start);
    bytes = TclGetStringFromObj(tmpObj, &len);
    bytes = Tcl_GetStringFromObj(tmpObj, &len);
    if (len > 0) {
	PushLiteral(envPtr, bytes, len);
	i++;
    }
    Tcl_DecrRefCount(tmpObj);
    Tcl_DecrRefCount(formatObj);

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
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







-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
+
+
+







	    name = varTokenPtr[1].start;
	    nameLen = p - varTokenPtr[1].start;
	    elName = p + 1;
	    remainingLen = (varTokenPtr[2].start - p) - 1;
	    elNameLen = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 1;

	    if (!(flags & TCL_NO_ELEMENT)) {
	      if (remainingLen) {
		/*
		 * Make a first token with the extra characters in the first
		 * token.
		 */
		if (remainingLen) {
		    /*
		     * Make a first token with the extra characters in the first
		     * token.
		     */

		elemTokenPtr = (Tcl_Token *)TclStackAlloc(interp, n * sizeof(Tcl_Token));
		allocedTokens = 1;
		elemTokenPtr->type = TCL_TOKEN_TEXT;
		elemTokenPtr->start = elName;
		elemTokenPtr->size = remainingLen;
		elemTokenPtr->numComponents = 0;
		elemTokenCount = n;
		    elemTokenPtr = (Tcl_Token *)
			    TclStackAlloc(interp, n * sizeof(Tcl_Token));
		    allocedTokens = 1;
		    elemTokenPtr->type = TCL_TOKEN_TEXT;
		    elemTokenPtr->start = elName;
		    elemTokenPtr->size = remainingLen;
		    elemTokenPtr->numComponents = 0;
		    elemTokenCount = n;

		/*
		 * Copy the remaining tokens.
		 */
		    /*
		     * Copy the remaining tokens.
		     */

		memcpy(elemTokenPtr+1, varTokenPtr+2,
			(n-1) * sizeof(Tcl_Token));
	      } else {
		/*
		 * Use the already available tokens.
		 */
		    memcpy(elemTokenPtr + 1, varTokenPtr + 2,
			    (n-1) * sizeof(Tcl_Token));
		} else {
		    /*
		     * Use the already available tokens.
		     */

		elemTokenPtr = &varTokenPtr[2];
		elemTokenCount = n - 1;
	      }
		    elemTokenPtr = &varTokenPtr[2];
		    elemTokenCount = n - 1;
		}
	    }
	}
    }

    if (simpleVarName) {
	/*
	 * See whether name has any namespace separators (::'s).
Changes to generic/tclCompCmdsGR.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

















17
18
19
20
21
22
23
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

-
-
-
-
-
-









+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclCompCmdsGR.c --
 *
 *	This file contains compilation procedures that compile various Tcl
 *	commands (beginning with the letters 'g' through 'r') into a sequence
 *	of instructions ("bytecodes").
 *
 * Copyright © 1997-1998 Sun Microsystems, Inc.
 * Copyright © 2001 Kevin B. Kenny.  All rights reserved.
 * Copyright © 2002 ActiveState Corporation.
 * Copyright © 2004-2013 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclCompCmdsGR.c --
 *
 *	This file contains compilation procedures that compile various Tcl
 *	commands (beginning with the letters 'g' through 'r') into a sequence
 *	of instructions ("bytecodes").
 */

#include "tclInt.h"
#include "tclCompile.h"
#include <assert.h>

/*
 * Prototypes for procedures defined later in this file:
 */
37
38
39
40
41
42
43
44

45
46
47
48
49
50
51
48
49
50
51
52
53
54

55
56
57
58
59
60
61
62







-
+







 *	compile time.
 *
 * Returns:
 *	TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
 *
 * Side effects:
 *	When TCL_OK is returned, the encoded index value is written
 *	to *index.
 *	to *indexPtr.
 *
 *----------------------------------------------------------------------
 */

int
TclGetIndexFromToken(
    Tcl_Token *tokenPtr,
520
521
522
523
524
525
526
527

528
529
530
531
532
533
534
531
532
533
534
535
536
537

538
539
540
541
542
543
544
545







-
+







	haveImmValue = 1;
    }

    /*
     * Emit the instruction to increment the variable.
     */

    if (isScalar) {	/* Simple scalar variable. */
    if (isScalar) {		/* Simple scalar variable. */
	if (localIndex >= 0) {
	    if (haveImmValue) {
		TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex, envPtr);
		TclEmitInt1(immValue, envPtr);
	    } else {
		TclEmitInstInt1(INST_INCR_SCALAR1, localIndex,	envPtr);
	    }
1408
1409
1410
1411
1412
1413
1414







1415
1416
1417
1418
1419
1420
1421
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439







+
+
+
+
+
+
+







    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    int i;

    /* 
     * For now, disable compilation of lreplace.  Figure out later if any
     * compilation can be done given that any Tcl_ObjType may implement
     * lreplace, and should return an object of the same type. 
     */
    return TCL_ERROR;

    if (parsePtr->numWords < 4) {
	return TCL_ERROR;
    }

    /* Push list, first, last onto the stack */
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);
2021
2022
2023
2024
2025
2026
2027
2028

2029
2030
2031
2032
2033
2034
2035
2039
2040
2041
2042
2043
2044
2045

2046
2047
2048
2049
2050
2051
2052
2053







-
+







	 * Attempt to convert pattern to glob.  If successful, push the
	 * converted pattern as a literal.
	 */

	if (TclReToGlob(NULL, varTokenPtr[1].start, len, &ds, &exact, NULL)
		== TCL_OK) {
	    simple = 1;
	    PushLiteral(envPtr, Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
	    PushLiteral(envPtr, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
	    Tcl_DStringFree(&ds);
	}
    }

    if (!simple) {
	CompileWord(envPtr, varTokenPtr, interp, (int)parsePtr->numWords - 2);
    }
2169
2170
2171
2172
2173
2174
2175
2176

2177
2178
2179
2180
2181
2182
2183
2187
2188
2189
2190
2191
2192
2193

2194
2195
2196
2197
2198
2199
2200
2201







-
+







    }

    /*
     * Next, higher-level checks. Is the RE a very simple glob? Is the
     * replacement "simple"?
     */

    bytes = TclGetStringFromObj(patternObj, &len);
    bytes = Tcl_GetStringFromObj(patternObj, &len);
    if (TclReToGlob(NULL, bytes, len, &pattern, &exact, &quantified)
	    != TCL_OK || exact || quantified) {
	goto done;
    }
    bytes = Tcl_DStringValue(&pattern);
    if (*bytes++ != '*') {
	goto done;
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
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







-
+
+











-
+







	    goto done;
	}
	bytes++;
    }
  isSimpleGlob:
    for (bytes = TclGetString(replacementObj); *bytes; bytes++) {
	switch (*bytes) {
	case '\\': case '&':
	case '\\':
	case '&':
	    goto done;
	}
    }

    /*
     * Proved the simplicity constraints! Time to issue the code.
     */

    result = TCL_OK;
    bytes = Tcl_DStringValue(&pattern) + 1;
    PushLiteral(envPtr,	bytes, len);
    bytes = TclGetStringFromObj(replacementObj, &len);
    bytes = Tcl_GetStringFromObj(replacementObj, &len);
    PushLiteral(envPtr,	bytes, len);
    CompileWord(envPtr,	stringTokenPtr, interp, (int)parsePtr->numWords - 2);
    TclEmitOpcode(	INST_STR_MAP,	envPtr);

  done:
    Tcl_DStringFree(&pattern);
    if (patternObj) {
2476
2477
2478
2479
2480
2481
2482
2483

2484
2485
2486
2487
2488
2489
2490
2495
2496
2497
2498
2499
2500
2501

2502
2503
2504
2505
2506
2507
2508
2509







-
+







void
TclCompileSyntaxError(
    Tcl_Interp *interp,
    CompileEnv *envPtr)
{
    Tcl_Obj *msg = Tcl_GetObjResult(interp);
    Tcl_Size numBytes;
    const char *bytes = TclGetStringFromObj(msg, &numBytes);
    const char *bytes = Tcl_GetStringFromObj(msg, &numBytes);

    TclErrorStackResetIf(interp, bytes, numBytes);
    TclEmitPush(TclRegisterLiteral(envPtr, bytes, numBytes, 0), envPtr);
    CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0,
	    TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR)));
    Tcl_ResetResult(interp);
}
2734
2735
2736
2737
2738
2739
2740
2741

2742
2743
2744
2745
2746
2747
2748
2753
2754
2755
2756
2757
2758
2759

2760
2761
2762
2763
2764
2765
2766
2767







-
+







	if (lastTokenPtr->type != TCL_TOKEN_TEXT) {
	    Tcl_DecrRefCount(tailPtr);
	    return -1;
	}
	Tcl_SetStringObj(tailPtr, lastTokenPtr->start, lastTokenPtr->size);
    }

    tailName = TclGetStringFromObj(tailPtr, &len);
    tailName = Tcl_GetStringFromObj(tailPtr, &len);

    if (len) {
	if (*(tailName + len - 1) == ')') {
	    /*
	     * Possible array: bail out
	     */

Changes to generic/tclCompCmdsSZ.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
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

-
-
-
-
-
-
-









+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclCompCmdsSZ.c --
 *
 *	This file contains compilation procedures that compile various Tcl
 *	commands (beginning with the letters 's' through 'z', except for
 *	[upvar] and [variable]) into a sequence of instructions ("bytecodes").
 *	Also includes the operator command compilers.
 *
 * Copyright © 1997-1998 Sun Microsystems, Inc.
 * Copyright © 2001 Kevin B. Kenny.  All rights reserved.
 * Copyright © 2002 ActiveState Corporation.
 * Copyright © 2004-2010 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclCompCmdsSZ.c --
 *
 *	This file contains compilation procedures that compile various Tcl
 *	commands (beginning with the letters 's' through 'z', except for
 *	[upvar] and [variable]) into a sequence of instructions ("bytecodes").
 *	Also includes the operator command compilers.
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tclStringTrim.h"

/*
 * Prototypes for procedures defined later in this file:
 */
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
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







-
+

















-
+







	    } else {
		folded = obj;
	    }
	} else {
	    Tcl_DecrRefCount(obj);
	    if (folded) {
		Tcl_Size len;
		const char *bytes = TclGetStringFromObj(folded, &len);
		const char *bytes = Tcl_GetStringFromObj(folded, &len);

		PushLiteral(envPtr, bytes, len);
		Tcl_DecrRefCount(folded);
		folded = NULL;
		numArgs ++;
	    }
	    CompileWord(envPtr, wordTokenPtr, interp, i);
	    numArgs ++;
	    if (numArgs >= 254) { /* 254 to take care of the possible +1 of "folded" above */
		TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr);
		numArgs = 1;	/* concat pushes 1 obj, the result */
	    }
	}
	wordTokenPtr = TokenAfter(wordTokenPtr);
    }
    if (folded) {
	Tcl_Size len;
	const char *bytes = TclGetStringFromObj(folded, &len);
	const char *bytes = Tcl_GetStringFromObj(folded, &len);

	PushLiteral(envPtr, bytes, len);
	Tcl_DecrRefCount(folded);
	folded = NULL;
	numArgs ++;
    }
    if (numArgs > 1) {
949
950
951
952
953
954
955
956

957
958
959
960
961

962
963
964
965
966
967
968
960
961
962
963
964
965
966

967
968
969
970
971

972
973
974
975
976
977
978
979







-
+




-
+








    /*
     * Now issue the opcodes. Note that in the case that we know that the
     * first word is an empty word, we don't issue the map at all. That is the
     * correct semantics for mapping.
     */

    bytes = TclGetStringFromObj(objv[0], &slen);
    bytes = Tcl_GetStringFromObj(objv[0], &slen);
    if (slen == 0) {
	CompileWord(envPtr, stringTokenPtr, interp, 2);
    } else {
	PushLiteral(envPtr, bytes, slen);
	bytes = TclGetStringFromObj(objv[1], &slen);
	bytes = Tcl_GetStringFromObj(objv[1], &slen);
	PushLiteral(envPtr, bytes, slen);
	CompileWord(envPtr, stringTokenPtr, interp, 2);
	OP(STR_MAP);
    }
    Tcl_DecrRefCount(mapObj);
    return TCL_OK;
}
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
-
-
-
-
-
-
-
-







	    OP(		POP);		/* Pop newString */
	}
	/* Original string argument now on TOS as result */
	return TCL_OK;
    }

    if (parsePtr->numWords == 5) {
    /*
     * When we have a string replacement, we have to take care about
     * not replacing empty substrings that [string replace] promises
     * not to replace
     *
     * The remaining index values might be suitable for conventional
     * string replacement, but only if they cannot possibly meet the
     * conditions described above at runtime. If there's a chance they
     * might, we would have to emit bytecode to check and at that point
     * we're paying more in bytecode execution time than would make
     * things worthwhile. Trouble is we are very limited in
     * how much we can detect that at compile time. After decoding,
     * we need, first:
     *
     *		(first <= end)
     *
     * The encoded indices (first <= TCL_INDEX END) and
     * (first == TCL_INDEX_NONE) always meets this condition, but
     * any other encoded first index has some list for which it fails.
     *
     * We also need, second:
     *
     *		(last >= 0)
     *
     * The encoded index (last >= TCL_INDEX_START) always meet this
     * condition but any other encoded last index has some list for
     * which it fails.
     *
     * Finally we need, third:
     *
     *		(first <= last)
     *
     * Considered in combination with the constraints we already have,
     * we see that we can proceed when (first == TCL_INDEX_NONE).
     * These also permit simplification of the prefix|replace|suffix
     * construction. The other constraints, though, interfere with
     * getting a guarantee that first <= last.
     */
	/*
	 * When we have a string replacement, we have to take care about
	 * not replacing empty substrings that [string replace] promises
	 * not to replace
	 *
	 * The remaining index values might be suitable for conventional
	 * string replacement, but only if they cannot possibly meet the
	 * conditions described above at runtime. If there's a chance they
	 * might, we would have to emit bytecode to check and at that point
	 * we're paying more in bytecode execution time than would make
	 * things worthwhile. Trouble is we are very limited in
	 * how much we can detect that at compile time. After decoding,
	 * we need, first:
	 *
	 *	(first <= end)
	 *
	 * The encoded indices (first <= TCL_INDEX END) and
	 * (first == TCL_INDEX_NONE) always meets this condition, but
	 * any other encoded first index has some list for which it fails.
	 *
	 * We also need, second:
	 *
	 *	(last >= 0)
	 *
	 * The encoded index (last >= TCL_INDEX_START) always meet this
	 * condition but any other encoded last index has some list for
	 * which it fails.
	 *
	 * Finally we need, third:
	 *
	 *	(first <= last)
	 *
	 * Considered in combination with the constraints we already have,
	 * we see that we can proceed when (first == TCL_INDEX_NONE).
	 * These also permit simplification of the prefix|replace|suffix
	 * construction. The other constraints, though, interfere with
	 * getting a guarantee that first <= last.
	 */

    if ((first == (int)TCL_INDEX_START) && (last >= (int)TCL_INDEX_START)) {
	/* empty prefix */
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 4);
	OP4(		REVERSE, 2);
	if (last == INT_MAX) {
	    OP(		POP);		/* Pop  original */
	} else {
	    OP44(	STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END);
	if ((first == (int)TCL_INDEX_START) && (last >= (int)TCL_INDEX_START)) {
	    /* empty prefix */
	    tokenPtr = TokenAfter(tokenPtr);
	    CompileWord(envPtr, tokenPtr, interp, 4);
	    OP4(	REVERSE, 2);
	    if (last == INT_MAX) {
		OP(	POP);		/* Pop  original */
	    } else {
		OP44(	STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END);
		OP1(	STR_CONCAT1, 2);
	    }
	    return TCL_OK;
	}

	if ((last == (int)TCL_INDEX_NONE) && (first <= (int)TCL_INDEX_END)) {
	    OP44(	STR_RANGE_IMM, 0, first-1);
	    tokenPtr = TokenAfter(tokenPtr);
	    CompileWord(envPtr, tokenPtr, interp, 4);
	    OP1(	STR_CONCAT1, 2);
	}
	return TCL_OK;
    }
	    return TCL_OK;
	}

    if ((last == (int)TCL_INDEX_NONE) && (first <= (int)TCL_INDEX_END)) {
	OP44(		STR_RANGE_IMM, 0, first-1);
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 4);
	OP1(		STR_CONCAT1, 2);
	return TCL_OK;
    }

	/* FLOW THROUGH TO genericReplace */

    } else {
	/*
	 * When we have no replacement string to worry about, we may
	 * have more luck, because the forbidden empty string replacements
1470
1471
1472
1473
1474
1475
1476
1477

1478
1479
1480
1481
1482

1483
1484
1485
1486
1487
1488
1489
1481
1482
1483
1484
1485
1486
1487

1488
1489
1490
1491
1492

1493
1494
1495
1496
1497
1498
1499
1500







-
+




-
+







	if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) {
	    objc++;
	    goto cleanup;
	}
	wordTokenPtr = TokenAfter(wordTokenPtr);
    }

/*
#if 0
    if (TclSubstOptions(NULL, numOpts, objv, &flags) == TCL_OK) {
	toSubst = objv[numOpts];
	Tcl_IncrRefCount(toSubst);
    }
*/
#endif

    /* TODO: Figure out expansion to cover WordKnownAtCompileTime
     *	The difficulty is that WKACT makes a copy, and if TclSubstParse
     *	below parses the copy of the original source string, some deep
     *	parts of the compile machinery get upset.  They want all pointers
     *	stored in Tcl_Tokens to point back to the same original string.
     */
2111
2112
2113
2114
2115
2116
2117
2118

2119
2120
2121
2122
2123
2124
2125
2126


2127
2128
2129
2130
2131
2132
2133
2122
2123
2124
2125
2126
2127
2128

2129
2130
2131
2132
2133
2134
2135
2136

2137
2138
2139
2140
2141
2142
2143
2144
2145







-
+







-
+
+







    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int mode,			/* Exact, Glob or Regexp */
    int noCase,			/* Case-insensitivity flag. */
    Tcl_Size numBodyTokens,	/* Number of tokens describing things the
				 * switch can match against and bodies to
				 * execute when the match succeeds. */
    Tcl_Token **bodyToken,	/* Array of pointers to pattern list items. */
    Tcl_Size *bodyLines,		/* Array of line numbers for body list
    Tcl_Size *bodyLines,	/* Array of line numbers for body list
				 * items. */
    Tcl_Size **bodyContLines)	/* Array of continuation line info. */
{
    enum {Switch_Exact, Switch_Glob, Switch_Regexp};
    int foundDefault;		/* Flag to indicate whether a "default" clause
				 * is present. */
    JumpFixup *fixupArray;	/* Array of forward-jump fixup records. */
    unsigned int *fixupTargetArray; /* Array of places for fixups to point at. */
    unsigned int *fixupTargetArray;
				/* Array of places for fixups to point at. */
    int fixupCount;		/* Number of places to fix up. */
    int contFixIndex;		/* Where the first of the jumps due to a group
				 * of continuation bodies starts, or -1 if
				 * there aren't any. */
    int contFixCount;		/* Number of continuation bodies pointing to
				 * the current (or next) real body. */
    int nextArmFixupIndex;
2359
2360
2361
2362
2363
2364
2365
2366

2367
2368
2369
2370
2371
2372
2373
2371
2372
2373
2374
2375
2376
2377

2378
2379
2380
2381
2382
2383
2384
2385







-
+







IssueSwitchJumpTable(
    Tcl_Interp *interp,		/* Context for compiling script bodies. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int numBodyTokens,		/* Number of tokens describing things the
				 * switch can match against and bodies to
				 * execute when the match succeeds. */
    Tcl_Token **bodyToken,	/* Array of pointers to pattern list items. */
    Tcl_Size *bodyLines,		/* Array of line numbers for body list
    Tcl_Size *bodyLines,	/* Array of line numbers for body list
				 * items. */
    Tcl_Size **bodyContLines)	/* Array of continuation line info. */
{
    JumptableInfo *jtPtr;
    int infoIndex, isNew, *finalFixups, numRealBodies = 0, jumpLocation;
    int mustGenerate, foundDefault, jumpToDefault, i;
    Tcl_DString buffer;
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
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







-
+











-
+







	    if (TclListObjGetElements(NULL, tmpObj, &objc, &objv) != TCL_OK
		    || (objc > 2)) {
		TclDecrRefCount(tmpObj);
		goto failedToCompile;
	    }
	    if (objc > 0) {
		Tcl_Size len;
		const char *varname = TclGetStringFromObj(objv[0], &len);
		const char *varname = Tcl_GetStringFromObj(objv[0], &len);

		resultVarIndices[i] = LocalScalar(varname, len, envPtr);
		if (resultVarIndices[i] < 0) {
		    TclDecrRefCount(tmpObj);
		    goto failedToCompile;
		}
	    } else {
		resultVarIndices[i] = -1;
	    }
	    if (objc == 2) {
		Tcl_Size len;
		const char *varname = TclGetStringFromObj(objv[1], &len);
		const char *varname = Tcl_GetStringFromObj(objv[1], &len);

		optionVarIndices[i] = LocalScalar(varname, len, envPtr);
		if (optionVarIndices[i] < 0) {
		    TclDecrRefCount(tmpObj);
		    goto failedToCompile;
		}
	    } else {
3131
3132
3133
3134
3135
3136
3137
3138

3139
3140
3141
3142
3143
3144
3145
3143
3144
3145
3146
3147
3148
3149

3150
3151
3152
3153
3154
3155
3156
3157







-
+







	     */

	    LOAD(			optionsVar);
	    PUSH(			"-errorcode");
	    OP4(			DICT_GET, 1);
	    TclAdjustStackDepth(-1, envPtr);
	    OP44(			LIST_RANGE_IMM, 0, len-1);
	    p = TclGetStringFromObj(matchClauses[i], &slen);
	    p = Tcl_GetStringFromObj(matchClauses[i], &slen);
	    PushLiteral(envPtr, p, slen);
	    OP(				STR_EQ);
	    JUMP4(			JUMP_FALSE, notECJumpSource);
	} else {
	    notECJumpSource = -1;
	}
	OP(				POP);
3343
3344
3345
3346
3347
3348
3349
3350

3351
3352
3353
3354
3355
3356
3357
3355
3356
3357
3358
3359
3360
3361

3362
3363
3364
3365
3366
3367
3368
3369







-
+







	     */

	    LOAD(			optionsVar);
	    PUSH(			"-errorcode");
	    OP4(			DICT_GET, 1);
	    TclAdjustStackDepth(-1, envPtr);
	    OP44(			LIST_RANGE_IMM, 0, len-1);
	    p = TclGetStringFromObj(matchClauses[i], &slen);
	    p = Tcl_GetStringFromObj(matchClauses[i], &slen);
	    PushLiteral(envPtr, p, slen);
	    OP(				STR_EQ);
	    JUMP4(			JUMP_FALSE, notECJumpSource);
	} else {
	    notECJumpSource = -1;
	}
	OP(				POP);
3671
3672
3673
3674
3675
3676
3677
3678

3679
3680
3681
3682
3683
3684
3685
3683
3684
3685
3686
3687
3688
3689

3690
3691
3692
3693
3694
3695
3696
3697







-
+







	    }
	    return TCL_ERROR;
	}
	if (varCount == 0) {
	    const char *bytes;
	    Tcl_Size len;

	    bytes = TclGetStringFromObj(leadingWord, &len);
	    bytes = Tcl_GetStringFromObj(leadingWord, &len);
	    if (i == 1 && len == 11 && !strncmp("-nocomplain", bytes, 11)) {
		flags = 0;
		haveFlags++;
	    } else if (i == (2 - flags) && len == 2 && !strncmp("--", bytes, 2)) {
		haveFlags++;
	    } else {
		varCount++;
Changes to generic/tclCompExpr.c.
















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
-
-







/*
 * Contributions from Don Porter, NIST, 2006-2007. (not subject to US copyright)
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclCompExpr.c --
 *
 *	This file contains the code to parse and compile Tcl expressions and
 *	implementations of the Tcl commands corresponding to expression
 *	operators, such as the command ::tcl::mathop::+ .
 *
 * Contributions from Don Porter, NIST, 2006-2007. (not subject to US copyright)
 *
 * 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"		/* CompileEnv */

/*
 * Expression parsing takes place in the routine ParseExpr(). It takes a
742
743
744
745
746
747
748
749

750
751
752
753
754
755
756
753
754
755
756
757
758
759

760
761
762
763
764
765
766
767







-
+







		     * When we compile the expression we'll need the function
		     * name, and there's no place in the parse tree to store
		     * it, so we keep a separate list of all the function
		     * names we've parsed in the order we found them.
		     */

		    Tcl_ListObjAppendElement(NULL, funcList, literal);
		} else if (Tcl_GetBooleanFromObj(NULL,literal,&b) == TCL_OK) {
		} else if (Tcl_GetBooleanFromObj(NULL, literal, &b) == TCL_OK) {
		    lexeme = BOOLEAN;
		} else {
		    /*
		     * Tricky case: see test expr-62.10
		     */

		    int scanned2 = scanned;
1865
1866
1867
1868
1869
1870
1871
1872
1873


1874
1875
1876
1877
1878
1879
1880
1876
1877
1878
1879
1880
1881
1882


1883
1884
1885
1886
1887
1888
1889
1890
1891







-
-
+
+







				 * first null character. */
    Tcl_Parse *parsePtr)	/* Structure to fill with information about
				 * the parsed expression; any previous
				 * information in the structure is ignored. */
{
    int code;
    OpNode *opTree = NULL;	/* Will point to the tree of operators. */
    Tcl_Obj *litList;	/* List to hold the literals. */
    Tcl_Obj *funcList;	/* List to hold the functon names. */
    Tcl_Obj *litList;		/* List to hold the literals. */
    Tcl_Obj *funcList;		/* List to hold the functon names. */
    Tcl_Parse *exprParsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));
				/* Holds the Tcl_Tokens of substitutions. */

    TclNewObj(litList);
    TclNewObj(funcList);
    if (numBytes < 0) {
	numBytes = (start ? strlen(start) : 0);
2107
2108
2109
2110
2111
2112
2113
2114

2115
2116
2117
2118
2119
2120
2121
2118
2119
2120
2121
2122
2123
2124

2125
2126
2127
2128
2129
2130
2131
2132







-
+







	    /*
	     * We have a number followed directly by bareword characters
	     * (alpha, digit, underscore).  Is this a number followed by
	     * bareword syntax error?  Or should we join into one bareword?
	     * Example: Inf + luence + () becomes a valid function call.
	     * [Bug 3401704]
	     */
	    if (TclHasInternalRep(literal, &tclDoubleType)) {
	    if (TclHasInternalRep(literal, tclDoubleTypePtr)) {
		const char *p = start;

		while (p < end) {
		    if (!TclIsBareword(*p++)) {
			/*
			 * The number has non-bareword characters, so we
			 * must treat it as a number.
2348
2349
2350
2351
2352
2353
2354
2355

2356
2357
2358
2359
2360
2361
2362
2359
2360
2361
2362
2363
2364
2365

2366
2367
2368
2369
2370
2371
2372
2373







-
+







	    case FUNCTION: {
		Tcl_DString cmdName;
		const char *p;
		Tcl_Size length;

		Tcl_DStringInit(&cmdName);
		TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::");
		p = TclGetStringFromObj(*funcObjv, &length);
		p = Tcl_GetStringFromObj(*funcObjv, &length);
		funcObjv++;
		Tcl_DStringAppend(&cmdName, p, length);
		TclEmitPush(TclRegisterLiteral(envPtr,
			Tcl_DStringValue(&cmdName),
			Tcl_DStringLength(&cmdName), LITERAL_CMD_NAME), envPtr);
		Tcl_DStringFree(&cmdName);

2504
2505
2506
2507
2508
2509
2510
2511

2512
2513
2514
2515
2516
2517
2518
2515
2516
2517
2518
2519
2520
2521

2522
2523
2524
2525
2526
2527
2528
2529







-
+







	    break;
	case OT_LITERAL: {
	    Tcl_Obj *const *litObjv = *litObjvPtr;
	    Tcl_Obj *literal = *litObjv;

	    if (optimize) {
		Tcl_Size length;
		const char *bytes = TclGetStringFromObj(literal, &length);
		const char *bytes = Tcl_GetStringFromObj(literal, &length);
		int idx = TclRegisterLiteral(envPtr, bytes, length, 0);
		Tcl_Obj *objPtr = TclFetchLiteral(envPtr, idx);

		if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
		    /*
		     * Would like to do this:
		     *
2564
2565
2566
2567
2568
2569
2570
2571

2572
2573
2574
2575
2576
2577
2578
2575
2576
2577
2578
2579
2580
2581

2582
2583
2584
2585
2586
2587
2588
2589







-
+







		     * already, then use it to share via the literal table.
		     */

		    if (TclHasStringRep(objPtr)) {
			Tcl_Obj *tableValue;
			Tcl_Size numBytes;
			const char *bytes
				= TclGetStringFromObj(objPtr, &numBytes);
				= Tcl_GetStringFromObj(objPtr, &numBytes);

			idx = TclRegisterLiteral(envPtr, bytes, numBytes, 0);
			tableValue = TclFetchLiteral(envPtr, idx);
			if ((tableValue->typePtr == NULL) &&
				(objPtr->typePtr != NULL)) {
			    /*
			     * Same internalrep surgery as for OT_LITERAL.
Changes to generic/tclCompile.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14

















15
16
17
18
19
20
21
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

-
-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclCompile.c --
 *
 *	This file contains procedures that compile Tcl commands or parts of
 *	commands (like quoted strings or nested sub-commands) into a sequence
 *	of instructions ("bytecodes").
 *
 * Copyright © 1996-1998 Sun Microsystems, Inc.
 * Copyright © 2001 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclCompile.c --
 *
 *	This file contains procedures that compile Tcl commands or parts of
 *	commands (like quoted strings or nested sub-commands) into a sequence
 *	of instructions ("bytecodes").
 */

#include "tclInt.h"
#include "tclCompile.h"
#include <assert.h>

/*
 * Variable that controls whether compilation tracing is enabled and, if so,
 * what level of tracing is desired:
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
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







-
+













-
+








const Tcl_ObjType tclByteCodeType = {
    "bytecode",			/* name */
    FreeByteCodeInternalRep,	/* freeIntRepProc */
    DupByteCodeInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    SetByteCodeFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V0
	0
};

/*
 * substCodeType provides the standard type management procedures for the
 * substcode type, which represents substitution within a Tcl value.
 */

static const Tcl_ObjType substCodeType = {
    "substcode",		/* name */
    FreeSubstCodeInternalRep,	/* freeIntRepProc */
    DupByteCodeInternalRep,	/* dupIntRepProc - shared with bytecode */
    NULL,			/* updateStringProc */
    NULL,			/* setFromAnyProc */
    TCL_OBJTYPE_V0
	0
};
#define SubstFlags(objPtr) (objPtr)->internalRep.twoPtrValue.ptr2

/*
 * Helper macros.
 */

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
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







-
+




















-
+








int
TclSetByteCodeFromAny(
    Tcl_Interp *interp,		/* The interpreter for which the code is being
				 * compiled. Must not be NULL. */
    Tcl_Obj *objPtr,		/* The object to make a ByteCode object. */
    CompileHookProc *hookProc,	/* Procedure to invoke after compilation. */
    void *clientData)	/* Hook procedure private data. */
    void *clientData)		/* Hook procedure private data. */
{
    Interp *iPtr = (Interp *) interp;
    CompileEnv compEnv;		/* Compilation environment structure allocated
				 * in frame. */
    Tcl_Size length;
    int result = TCL_OK;
    const char *stringPtr;
    Proc *procPtr = iPtr->compiledProcPtr;
    ContLineLoc *clLocPtr;

#ifdef TCL_COMPILE_DEBUG
    if (!traceInitialized) {
	if (Tcl_LinkVar(interp, "tcl_traceCompile",
		&tclTraceCompile, TCL_LINK_INT) != TCL_OK) {
	    Tcl_Panic("SetByteCodeFromAny: unable to create link for tcl_traceCompile variable");
	}
	traceInitialized = 1;
    }
#endif

    stringPtr = TclGetStringFromObj(objPtr, &length);
    stringPtr = Tcl_GetStringFromObj(objPtr, &length);

    /*
     * TIP #280: Pick up the CmdFrame in which the BC compiler was invoked, and
     * use to initialize the tracking in the compiler. This information was
     * stored by TclCompEvalObj and ProcCompileProc.
     */

987
988
989
990
991
992
993
994

995
996
997
998
999
1000
1001
998
999
1000
1001
1002
1003
1004

1005
1006
1007
1008
1009
1010
1011
1012







-
+







 *	delayed until the last execution of the code completes.
 *
 *----------------------------------------------------------------------
 */

static void
FreeByteCodeInternalRep(
    Tcl_Obj *objPtr)	/* Object whose internal rep to free. */
    Tcl_Obj *objPtr)		/* Object whose internal rep to free. */
{
    ByteCode *codePtr;

    ByteCodeGetInternalRep(objPtr, &tclByteCodeType, codePtr);
    assert(codePtr != NULL);

    TclReleaseByteCode(codePtr);
1037
1038
1039
1040
1041
1042
1043
1044

1045
1046
1047
1048
1049
1050
1051
1048
1049
1050
1051
1052
1053
1054

1055
1056
1057
1058
1059
1060
1061
1062







-
+








    /* Just dropped to refcount==0.  Clean up. */
    CleanupByteCode(codePtr);
}

static void
CleanupByteCode(
    ByteCode *codePtr)	/* Points to the ByteCode to free. */
    ByteCode *codePtr)		/* Points to the ByteCode to free. */
{
    Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle;
    Interp *iPtr = (Interp *) interp;
    int numLitObjects = codePtr->numLitObjects;
    int numAuxDataItems = codePtr->numAuxDataItems;
    Tcl_Obj **objArrayPtr, *objPtr;
    const AuxData *auxDataPtr;
1340
1341
1342
1343
1344
1345
1346
1347

1348
1349
1350
1351
1352
1353
1354
1351
1352
1353
1354
1355
1356
1357

1358
1359
1360
1361
1362
1363
1364
1365







-
+







	    Tcl_StoreInternalRep(objPtr, &substCodeType, NULL);
	    codePtr = NULL;
	}
    }
    if (codePtr == NULL) {
	CompileEnv compEnv;
	Tcl_Size numBytes;
	const char *bytes = TclGetStringFromObj(objPtr, &numBytes);
	const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);

	/* TODO: Check for more TIP 280 */
	TclInitCompileEnv(interp, &compEnv, bytes, numBytes, NULL, 0);

	TclSubstCompile(interp, bytes, numBytes, flags, 1, &compEnv);

	TclEmitOpcode(INST_DONE, &compEnv);
1383
1384
1385
1386
1387
1388
1389
1390

1391
1392
1393
1394
1395
1396
1397
1394
1395
1396
1397
1398
1399
1400

1401
1402
1403
1404
1405
1406
1407
1408







-
+







 *	the cleanup is delayed until the last execution of the code completes.
 *
 *----------------------------------------------------------------------
 */

static void
FreeSubstCodeInternalRep(
    Tcl_Obj *objPtr)	/* Object whose internal rep to free. */
    Tcl_Obj *objPtr)		/* Object whose internal rep to free. */
{
    ByteCode *codePtr;

    ByteCodeGetInternalRep(objPtr, &substCodeType, codePtr);
    assert(codePtr != NULL);

    TclReleaseByteCode(codePtr);
1434
1435
1436
1437
1438
1439
1440
1441

1442
1443
1444
1445
1446
1447
1448
1445
1446
1447
1448
1449
1450
1451

1452
1453
1454
1455
1456
1457
1458
1459







-
+







 *----------------------------------------------------------------------
 */

void
TclInitCompileEnv(
    Tcl_Interp *interp,		/* The interpreter for which a CompileEnv
				 * structure is initialized. */
    CompileEnv *envPtr,/* Points to the CompileEnv structure to
    CompileEnv *envPtr,		/* Points to the CompileEnv structure to
				 * initialize. */
    const char *stringPtr,	/* The source string to be compiled. */
    size_t numBytes,		/* Number of bytes in source string. */
    const CmdFrame *invoker,	/* Location context invoking the bcc */
    int word)			/* Index of the word in that context getting
				 * compiled */
{
1825
1826
1827
1828
1829
1830
1831
1832

1833
1834
1835
1836
1837
1838
1839
1836
1837
1838
1839
1840
1841
1842

1843
1844
1845
1846
1847
1848
1849
1850







-
+







    Tcl_Size length;

    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
    if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) {
	extraLiteralFlags |= LITERAL_UNSHARED;
    }

    bytes = TclGetStringFromObj(cmdObj, &length);
    bytes = Tcl_GetStringFromObj(cmdObj, &length);
    cmdLitIdx = TclRegisterLiteral(envPtr, bytes, length, extraLiteralFlags);

    if (cmdPtr && TclRoutineHasName(cmdPtr)) {
	TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr);
    }
    TclEmitPush(cmdLitIdx, envPtr);
}
2635
2636
2637
2638
2639
2640
2641
2642

2643
2644
2645
2646
2647
2648
2649
2646
2647
2648
2649
2650
2651
2652

2653
2654
2655
2656
2657
2658
2659
2660







-
+







 */

void
TclCompileCmdWord(
    Tcl_Interp *interp,		/* Used for error and status reporting. */
    Tcl_Token *tokenPtr,	/* Pointer to first in an array of tokens for
				 * a command word to compile inline. */
    size_t count1,			/* Number of tokens to consider at tokenPtr.
    size_t count1,		/* Number of tokens to consider at tokenPtr.
				 * Must be at least 1. */
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    int count = count1;

    if ((count == 1) && (tokenPtr->type == TCL_TOKEN_TEXT)) {
	/*
2817
2818
2819
2820
2821
2822
2823
2824

2825
2826
2827
2828
2829
2830
2831
2828
2829
2830
2831
2832
2833
2834

2835
2836
2837
2838
2839
2840
2841
2842







-
+







	     *
	     * NOTE:  [Bugs 3392070, 3389764] We make a copy based completely
	     * on the string value, and do not call Tcl_DuplicateObj() so we
	     * can be sure we do not have any lingering cycles hiding in
	     * the internalrep.
	     */
	    Tcl_Size numBytes;
	    const char *bytes = TclGetStringFromObj(objPtr, &numBytes);
	    const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);
	    Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes);

	    Tcl_IncrRefCount(copyPtr);
	    TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, objPtr);

	    envPtr->literalArrayPtr[i].objPtr = copyPtr;
	}
3020
3021
3022
3023
3024
3025
3026
3027

3028
3029
3030
3031
3032
3033
3034
3031
3032
3033
3034
3035
3036
3037

3038
3039
3040
3041
3042
3043
3044
3045







-
+







 *	variable is unknown, or if the name is NULL.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
TclFindCompiledLocal(
    const char *name,	/* Points to first character of the name of a
    const char *name,		/* Points to first character of the name of a
				 * scalar or array variable. If NULL, a
				 * temporary var should be created. */
    Tcl_Size nameBytes,		/* Number of bytes in the name. */
    int create,			/* If 1, allocate a local frame entry for the
				 * variable if it is new. */
    CompileEnv *envPtr)		/* Points to the current compile environment*/
{
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
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







-
+

















-
+







	if (!cachePtr || !name) {
	    return TCL_INDEX_NONE;
	}

	varNamePtr = &cachePtr->varName0;
	for (i=0; i < cachePtr->numVars; varNamePtr++, i++) {
	    if (*varNamePtr) {
		localName = TclGetStringFromObj(*varNamePtr, &len);
		localName = Tcl_GetStringFromObj(*varNamePtr, &len);
		if ((len == nameBytes) && !strncmp(name, localName, len)) {
		    return i;
		}
	    }
	}
	return TCL_INDEX_NONE;
    }

    if (name != NULL) {
	Tcl_Size localCt = procPtr->numCompiledLocals;

	localPtr = procPtr->firstLocalPtr;
	for (i = 0;  i < localCt;  i++) {
	    if (!TclIsVarTemporary(localPtr)) {
		char *localName = localPtr->name;

		if ((nameBytes == localPtr->nameLength) &&
			(strncmp(name,localName,nameBytes) == 0)) {
			(strncmp(name, localName, nameBytes) == 0)) {
		    return i;
		}
	    }
	    localPtr = localPtr->nextPtr;
	}
    }

3199
3200
3201
3202
3203
3204
3205
3206

3207
3208
3209
3210
3211
3212
3213
3210
3211
3212
3213
3214
3215
3216

3217
3218
3219
3220
3221
3222
3223
3224







-
+







EnterCmdStartData(
    CompileEnv *envPtr,		/* Points to the compilation environment
				 * structure in which to enter command
				 * location information. */
    Tcl_Size cmdIndex,		/* Index of the command whose start data is
				 * being set. */
    Tcl_Size srcOffset,		/* Offset of first char of the command. */
    Tcl_Size codeOffset)		/* Offset of first byte of command code. */
    Tcl_Size codeOffset)	/* Offset of first byte of command code. */
{
    CmdLocation *cmdLocPtr;

    if (cmdIndex < 0 || cmdIndex >= envPtr->numCommands) {
	Tcl_Panic("EnterCmdStartData: bad command index %" TCL_Z_MODIFIER "u", cmdIndex);
    }

3277
3278
3279
3280
3281
3282
3283
3284
3285


3286
3287
3288
3289
3290
3291
3292
3288
3289
3290
3291
3292
3293
3294


3295
3296
3297
3298
3299
3300
3301
3302
3303







-
-
+
+







static void
EnterCmdExtentData(
    CompileEnv *envPtr,		/* Points to the compilation environment
				 * structure in which to enter command
				 * location information. */
    Tcl_Size cmdIndex,		/* Index of the command whose source and code
				 * length data is being set. */
    Tcl_Size numSrcBytes,		/* Number of command source chars. */
    Tcl_Size numCodeBytes)		/* Offset of last byte of command code. */
    Tcl_Size numSrcBytes,	/* Number of command source chars. */
    Tcl_Size numCodeBytes)	/* Offset of last byte of command code. */
{
    CmdLocation *cmdLocPtr;

    if (cmdIndex < 0 || cmdIndex >= envPtr->numCommands) {
	Tcl_Panic("EnterCmdExtentData: bad command index %" TCL_Z_MODIFIER "u", cmdIndex);
    }

3761
3762
3763
3764
3765
3766
3767
3768

3769
3770
3771
3772

3773
3774
3775
3776
3777

3778
3779
3780
3781
3782
3783
3784
3772
3773
3774
3775
3776
3777
3778

3779
3780
3781
3782

3783
3784
3785
3786


3787
3788
3789
3790
3791
3792
3793
3794







-
+



-
+



-
-
+







 *	If there is not enough room in the CompileEnv's AuxData array, its size
 *	is doubled.
 *----------------------------------------------------------------------
 */

Tcl_Size
TclCreateAuxData(
    void *clientData,	/* The compilation auxiliary data to store in
    void *clientData,		/* The compilation auxiliary data to store in
				 * the new aux data record. */
    const AuxDataType *typePtr,	/* Pointer to the type to attach to this
				 * AuxData */
    CompileEnv *envPtr)/* Points to the CompileEnv for which a new
    CompileEnv *envPtr)		/* Points to the CompileEnv for which a new
				 * aux data structure is to be allocated. */
{
    Tcl_Size index;		/* Index for the new AuxData structure. */
    AuxData *auxDataPtr;
				/* Points to the new AuxData structure */
    AuxData *auxDataPtr;	/* Points to the new AuxData structure */

    index = envPtr->auxDataArrayNext;
    if (index >= envPtr->auxDataArrayEnd) {
	/*
	 * Expand the AuxData array. The currently allocated entries are
	 * stored between elements 0 and (envPtr->auxDataArrayNext - 1)
	 * [inclusive].
Changes to generic/tclCompile.h.
1
2
3
4
5
6
7
8
9
10
11
12














13
14
15
16
17
18
19
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

-
-









+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclCompile.h --
 *
 * Copyright (c) 1996-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 by Scriptics Corporation.
 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
 * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclCompile.h --
 *
 */

#ifndef _TCLCOMPILATION
#define _TCLCOMPILATION 1

#include "tclInt.h"

struct ByteCode;		/* Forward declaration. */

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
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







-


-















-
-
-












-


-






-
-
-







				 * duplicate objects. */
    unsigned char *codeStart;	/* Points to the first byte of the code. */
    unsigned char *codeNext;	/* Points to next code array byte to use. */
    unsigned char *codeEnd;	/* Points just after the last allocated code
				 * array byte. */
    int mallocedCodeArray;	/* Set 1 if code array was expanded and
				 * codeStart points into the heap.*/
#if TCL_MAJOR_VERSION > 8
    int mallocedExceptArray;	/* 1 if ExceptionRange array was expanded and
				 * exceptArrayPtr points in heap, else 0. */
#endif
    LiteralEntry *literalArrayPtr;
				/* Points to start of LiteralEntry array. */
    Tcl_Size literalArrayNext;	/* Index of next free object array entry. */
    Tcl_Size literalArrayEnd;	/* Index just after last obj array entry. */
    int mallocedLiteralArray;	/* 1 if object array was expanded and objArray
				 * points into the heap, else 0. */
    ExceptionRange *exceptArrayPtr;
				/* Points to start of the ExceptionRange
				 * array. */
    Tcl_Size exceptArrayNext;	/* Next free ExceptionRange array index.
				 * exceptArrayNext is the number of ranges and
				 * (exceptArrayNext-1) is the index of the
				 * current range's array entry. */
    Tcl_Size exceptArrayEnd;	/* Index after the last ExceptionRange array
				 * entry. */
#if TCL_MAJOR_VERSION < 9
    int mallocedExceptArray;
#endif
    ExceptionAux *exceptAuxArrayPtr;
				/* Array of information used to restore the
				 * state when processing BREAK/CONTINUE
				 * exceptions. Must be the same size as the
				 * exceptArrayPtr. */
    CmdLocation *cmdMapPtr;	/* Points to start of CmdLocation array.
				 * numCommands is the index of the next entry
				 * to use; (numCommands-1) is the entry index
				 * for the last command. */
    Tcl_Size cmdMapEnd;		/* Index after last CmdLocation entry. */
    int mallocedCmdMap;		/* 1 if command map array was expanded and
				 * cmdMapPtr points in the heap, else 0. */
#if TCL_MAJOR_VERSION > 8
    int mallocedAuxDataArray;	/* 1 if aux data array was expanded and
				 * auxDataArrayPtr points in heap else 0. */
#endif
    AuxData *auxDataArrayPtr;	/* Points to auxiliary data array start. */
    Tcl_Size auxDataArrayNext;	/* Next free compile aux data array index.
				 * auxDataArrayNext is the number of aux data
				 * items and (auxDataArrayNext-1) is index of
				 * current aux data array entry. */
    Tcl_Size auxDataArrayEnd;	/* Index after last aux data array entry. */
#if TCL_MAJOR_VERSION < 9
    int mallocedAuxDataArray;
#endif
    unsigned char staticCodeSpace[COMPILEENV_INIT_CODE_BYTES];
				/* Initial storage for code. */
    LiteralEntry staticLiteralSpace[COMPILEENV_INIT_NUM_OBJECTS];
				/* Initial storage of LiteralEntry array. */
    ExceptionRange staticExceptArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
				/* Initial ExceptionRange array storage. */
    ExceptionAux staticExAuxArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
855
856
857
858
859
860
861
862

863
864
865
866
867
868
869
857
858
859
860
861
862
863

864
865
866
867
868
869
870
871







-
+







 * are used for indexes or for, e.g., the count of objects to push in a "push"
 * instruction.
 */

#define MAX_INSTRUCTION_OPERANDS 2

typedef enum InstOperandType {
    OPERAND_NONE,
    OPERAND_NONE,		/* No operand. */
    OPERAND_INT1,		/* One byte signed integer. */
    OPERAND_INT4,		/* Four byte signed integer. */
    OPERAND_UINT1,		/* One byte unsigned integer. */
    OPERAND_UINT4,		/* Four byte unsigned integer. */
    OPERAND_IDX4,		/* Four byte signed index (actually an
				 * integer, but displayed differently.) */
    OPERAND_LVT1,		/* One byte unsigned index into the local
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1070
1071
1072
1073
1074
1075
1076

1077
1078
1079
1080
1081
1082
1083







-








/*
 *----------------------------------------------------------------
 * Procedures exported by tclBasic.c to be used within the engine.
 *----------------------------------------------------------------
 */

#if TCL_MAJOR_VERSION > 8
MODULE_SCOPE Tcl_ObjCmdProc	TclNRInterpCoroutine;

/*
 *----------------------------------------------------------------
 * Procedures exported by the engine to be used by tclBasic.c
 *----------------------------------------------------------------
 */
1208
1209
1210
1211
1212
1213
1214
1215

1216
1217
1218
1219
1220
1221
1222
1209
1210
1211
1212
1213
1214
1215

1216
1217
1218
1219
1220
1221
1222
1223







-
+







			    Tcl_Obj **tosPtr);
MODULE_SCOPE Tcl_Obj *	TclGetInnerContext(Tcl_Interp *interp,
			    const unsigned char *pc, Tcl_Obj **tosPtr);
MODULE_SCOPE Tcl_Obj *	TclNewInstNameObj(unsigned char inst);
MODULE_SCOPE int	TclPushProcCallFrame(void *clientData,
			    Tcl_Interp *interp, Tcl_Size objc,
			    Tcl_Obj *const objv[], int isLambda);
#endif /* TCL_MAJOR_VERSION > 8 */


/*
 *----------------------------------------------------------------
 * Macros and flag values used by Tcl bytecode compilation and execution
 * modules inside the Tcl core but not used outside.
 *----------------------------------------------------------------
 */
1838
1839
1840
1841
1842
1843
1844
1845



1846
1847

1848
1849
1850
1851

1852
1853
1854
1855
1856
1857
1858
1839
1840
1841
1842
1843
1844
1845

1846
1847
1848
1849

1850
1851
1852
1853

1854
1855
1856
1857
1858
1859
1860
1861







-
+
+
+

-
+



-
+







	tclDTraceDebugLog = fopen(n, "a");				\
    }

#define TclDTraceDbgMsg(p, m, ...) \
    do {								\
	if (tclDTraceDebugEnabled) {					\
	    int _l, _t = 0;						\
	    if (!tclDTraceDebugLog) { TclDTraceOpenDebugLog(); }	\
	    if (!tclDTraceDebugLog) {					\
		TclDTraceOpenDebugLog();				\
	    }								\
	    fprintf(tclDTraceDebugLog, "%.12s:%.4d:%n",			\
		    strrchr(__FILE__, '/')+1, __LINE__, &_l); _t += _l; \
		    strrchr(__FILE__, '/')+1, __LINE__, &_l); _t += _l;	\
	    fprintf(tclDTraceDebugLog, " %.*s():%n",			\
		    (_t < 18 ? 18 - _t : 0) + 18, __func__, &_l); _t += _l; \
	    fprintf(tclDTraceDebugLog, "%*s" p "%n",			\
		    (_t < 40 ? 40 - _t : 0) + 2 * tclDTraceDebugIndent, \
		    (_t < 40 ? 40 - _t : 0) + 2 * tclDTraceDebugIndent,	\
		    "", &_l); _t += _l;					\
	    fprintf(tclDTraceDebugLog, "%*s" m "\n",			\
		    (_t < 64 ? 64 - _t : 1), "", ##__VA_ARGS__);	\
	    fflush(tclDTraceDebugLog);					\
	}								\
    } while (0)

Changes to generic/tclConfig.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclConfig.c --
 *
 *	This file provides the facilities which allow Tcl and other packages
 *	to embed configuration information into their binary libraries.
 *
 * Copyright © 2002 Andreas Kupries <andreas_kupries@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclConfig.c --
 *
 *	This file provides the facilities which allow Tcl and other packages
 *	to embed configuration information into their binary libraries.
 */

#include "tclInt.h"

/*
 * Internal structure to hold embedded configuration information.
 *
 * Our structure is a two-level dictionary associated with the 'interp'. The
 * first level is keyed with the package name and maps to the dictionary for
387
388
389
390
391
392
393
394

395
396
397
398
399
400
401
402
403
404
405
406
398
399
400
401
402
403
404

405
406
407
408
409
410
411
412
413
414
415
416
417







-
+












 *	The package metadata database is freed.
 *
 *----------------------------------------------------------------------
 */

static void
ConfigDictDeleteProc(
    void *clientData,	/* Pointer to Tcl_Obj. */
    void *clientData,		/* Pointer to Tcl_Obj. */
    TCL_UNUSED(Tcl_Interp *))
{
    Tcl_DecrRefCount((Tcl_Obj *)clientData);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclDTrace.d.
1
2
3
4
5
6
7
8
9
10
11




12




13







14

15
16
17
18
19
20
21
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

-
-
-
-






+
+
+
+
-
+
+
+
+

+
+
+
+
+
+
+

+







/*
 * tclDTrace.d --
 *
 *	Tcl DTrace provider.
 *
 * Copyright (c) 2007-2008 Daniel A. Steffen <das@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.
typedef struct Tcl_Obj Tcl_Obj;

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclDTrace.d --
 *
 *	Tcl DTrace provider.
 */

typedef struct Tcl_Obj Tcl_Obj;
typedef ptrdiff_t Tcl_Size;


/*
 * Tcl DTrace probes
 */

provider tcl {
    /***************************** proc probes *****************************/
Changes to generic/tclDate.c.
245
246
247
248
249
250
251
252

253
254
255
256
257
258
259
245
246
247
248
249
250
251

252
253
254
255
256
257
258
259







-
+







# define YYLTYPE_IS_DECLARED 1
# define YYLTYPE_IS_TRIVIAL 1
#endif




int TclDateparse (DateInfo* info);
static int TclDateparse (DateInfo* info);



/* Symbol kind.  */
enum yysymbol_kind_t
{
  YYSYMBOL_YYEMPTY = -2,
Deleted 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
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





















































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * 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!) */

enum DateInfoFlags {
    CLF_OPTIONAL = 1 << 0,	/* token is non mandatory */
    CLF_POSIXSEC = 1 << 1,
    CLF_LOCALSEC = 1 << 2,
    CLF_JULIANDAY = 1 << 3,
    CLF_TIME = 1 << 4,
    CLF_ZONE = 1 << 5,
    CLF_CENTURY = 1 << 6,
    CLF_DAYOFMONTH = 1 << 7,
    CLF_DAYOFYEAR = 1 << 8,
    CLF_MONTH = 1 << 9,
    CLF_YEAR = 1 << 10,
    CLF_DAYOFWEEK = 1 << 11,
    CLF_ISO8601YEAR = 1 << 12,
    CLF_ISO8601WEEK = 1 << 13,
    CLF_ISO8601CENTURY = 1 << 14,

    CLF_SIGNED = 1 << 15,

    /* Compounds */

    CLF_HAVEDATE = (CLF_DAYOFMONTH | CLF_MONTH | CLF_YEAR),
    CLF_DATE = (CLF_JULIANDAY | CLF_DAYOFMONTH | CLF_DAYOFYEAR
	    | CLF_MONTH | CLF_YEAR | CLF_ISO8601YEAR
	    | CLF_DAYOFWEEK | CLF_ISO8601WEEK),

    /*
     * Extra flags used outside of scan/format-tokens too (int, not a short).
     */

    CLF_RELCONV = 1 << 17,
    CLF_ORDINALMONTH = 1 << 18,

    /* On demand (lazy) assemble flags */

    CLF_ASSEMBLE_DATE = 1 << 28,/* assemble year, month, etc. using julianDay */
    CLF_ASSEMBLE_JULIANDAY = 1 << 29,
				/* assemble julianDay using year, month, etc. */
    CLF_ASSEMBLE_SECONDS = 1 << 30
				/* assemble localSeconds (and seconds at end) */
};

#define TCL_MIN_SECONDS		-0x00F0000000000000LL
#define TCL_MAX_SECONDS		 0x00F0000000000000LL
#define TCL_INV_SECONDS		(TCL_MIN_SECONDS - 1)

/*
 * 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]
 */

enum TclDateFieldsFlags {
    CLF_CTZ = (1 << 4)
};

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 */
    Tcl_WideInt julianDay;	/* Julian Day Number in local time zone */
    int isBce;			/* 1 if BCE */
    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 hour (in-between time only calculation) */
    Tcl_WideInt secondOfMin;	/* Seconds of minute (in-between time only calculation) */
    Tcl_WideInt secondOfDay;	/* Seconds of day (in-between time only calculation) */

    int flags;			/* 0 or CLF_CTZ */

    /* Non cacheable fields:	 */

    Tcl_Obj *tzName;		/* Name (or corresponding DST-abbreviation) of the
				 * time zone, if set the refCount is incremented */
} TclDateFields;

#define ClockCacheableDateFieldsSize \
    offsetof(TclDateFields, tzName)

/*
 * Meridian: am, pm, or 24-hour style.
 */

typedef enum _MERIDIAN {
    MERam, MERpm, MER24
} MERIDIAN;

/*
 * Structure contains return parsed fields.
 */

typedef struct DateInfo {
    const char *dateStart;
    const char *dateInput;
    const char *dateEnd;

    TclDateFields date;

    int flags;			/* Signals parts of date/time get found */
    int errFlags;		/* Signals error (part of date/time found twice) */

    MERIDIAN dateMeridian;

    int dateTimezone;
    int dateDSTmode;

    Tcl_WideInt dateRelMonth;
    Tcl_WideInt dateRelDay;
    Tcl_WideInt dateRelSeconds;

    int dateMonthOrdinalIncr;
    int dateMonthOrdinal;

    int dateDayOrdinal;

    Tcl_WideInt *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.secondOfMin)
#define yySecondOfDay (info->date.secondOfDay)

#define yyDSTmode   (info->dateDSTmode)
#define yyDayOrdinal	(info->dateDayOrdinal)
#define yyDayOfWeek (info->date.dayOfWeek)
#define yyMonthOrdinalIncr  (info->dateMonthOrdinalIncr)
#define yyMonthOrdinal	(info->dateMonthOrdinal)
#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]
 */

enum ClockFmtScnCmdArgsFlags {
    CLF_VALIDATE_S1 = (1 << 0),
    CLF_VALIDATE_S2 = (1 << 1),
    CLF_VALIDATE = (CLF_VALIDATE_S1|CLF_VALIDATE_S2),
    CLF_EXTENDED = (1 << 4),
    CLF_STRICT = (1 << 8),
    CLF_LOCALE_USED = (1 << 15)
};

typedef struct ClockClientData ClockClientData;

typedef struct ClockFmtScnCmdArgs {
    ClockClientData *dataPtr;	/* 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;

/* Last-period cache for fast UTC to local and backwards conversion */
typedef struct ClockLastTZOffs {
    /* keys */
    Tcl_Obj *timezoneObj;
    int changeover;
    Tcl_WideInt localSeconds;
    Tcl_WideInt rangesVal[2];   /* Bounds for cached time zone offset */
    /* values */
    int tzOffset;
    Tcl_Obj *tzName;		/* Name (abbreviation) of this area in TZ */
} ClockLastTZOffs;

/*
 * 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 */
    Tcl_Obj *mcDicts;		/* Msgcat collection, contains weak pointers to locale
				 * catalogs, and owns it references (onetime referenced) */

    /* Cache for current clock parameters, imparted via "configure" */
    size_t lastTZEpoch;
    int currentYearCentury;
    int yearOfCenturySwitch;
    int validMinYear;
    int validMaxYear;
    double maxJDN;

    Tcl_Obj *systemTimeZone;
    Tcl_Obj *systemSetupTZData;
    Tcl_Obj *gmtSetupTimeZoneUnnorm;
    Tcl_Obj *gmtSetupTimeZone;
    Tcl_Obj *gmtSetupTZData;
    Tcl_Obj *gmtTZName;
    Tcl_Obj *lastSetupTimeZoneUnnorm;
    Tcl_Obj *lastSetupTimeZone;
    Tcl_Obj *lastSetupTZData;
    Tcl_Obj *prevSetupTimeZoneUnnorm;
    Tcl_Obj *prevSetupTimeZone;
    Tcl_Obj *prevSetupTZData;

    Tcl_Obj *defaultLocale;
    Tcl_Obj *defaultLocaleDict;
    Tcl_Obj *currentLocale;
    Tcl_Obj *currentLocaleDict;
    Tcl_Obj *lastUsedLocaleUnnorm;
    Tcl_Obj *lastUsedLocale;
    Tcl_Obj *lastUsedLocaleDict;
    Tcl_Obj *prevUsedLocaleUnnorm;
    Tcl_Obj *prevUsedLocale;
    Tcl_Obj *prevUsedLocaleDict;

    /* Cache for last base (last-second fast convert if base/tz not changed) */
    struct {
	Tcl_Obj *timezoneObj;
	TclDateFields date;
    } lastBase;

    /* Last-period cache for fast UTC to Local and backwards conversion */
    ClockLastTZOffs lastTZOffsCache[2];

    int defFlags;		    /* Default flags (from configure), ATM
				     * only CLF_VALIDATE supported */
} ClockClientData;

#define ClockDefaultYearCentury 2000
#define ClockDefaultCenturySwitch 38

/*
 * Clock scan and format facilities.
 */

#ifndef TCL_MEM_DEBUG
# define CLOCK_FMT_SCN_STORAGE_GC_SIZE 32
#else
# define CLOCK_FMT_SCN_STORAGE_GC_SIZE 0
#endif

#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_INT = 1, CTOKT_WIDE, CTOKT_PARSER, CTOKT_SPACE, CTOKT_WORD, CTOKT_CHAR,
   CFMTT_PROC
} CLCKTOK_TYPE;

typedef struct ClockScanTokenMap {
    unsigned short type;
    unsigned short flags;
    unsigned short clearFlags;
    unsigned short minSize;
    unsigned short maxSize;
    unsigned short offs;
    ClockScanTokenProc *parser;
    const void *data;
} ClockScanTokenMap;

struct ClockScanToken {
    const ClockScanTokenMap *map;
    struct {
	const char *start;
	const char *end;
    } tokWord;
    unsigned short endDistance;
    unsigned short lookAhMin;
    unsigned short lookAhMax;
    unsigned short lookAhTok;
};

#define MIN_FMT_RESULT_BLOCK_ALLOC 80
#define MIN_FMT_RESULT_BLOCK_DELTA 0
/* Maximal permitted threshold (buffer size > result size) in percent,
 * to directly return the buffer without reallocate */
#define MAX_FMT_RESULT_THRESHOLD   2

typedef struct DateFormat {
    char *resMem;
    char *resEnd;
    char *output;
    TclDateFields date;
    Tcl_Obj *localeEra;
} DateFormat;

enum ClockFormatTokenMapFlags {
    CLFMT_INCR = (1 << 3),
    CLFMT_DECR = (1 << 4),
    CLFMT_CALC = (1 << 5),
    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 type;
    const char *tostr;
    unsigned short width;
    unsigned short flags;
    unsigned short divider;
    unsigned short divmod;
    unsigned short offs;
    ClockFormatTokenProc *fmtproc;
    void *data;
} ClockFormatTokenMap;

struct ClockFormatToken {
    const ClockFormatTokenMap *map;
    struct {
	const char *start;
	const char *end;
    } tokWord;
};

typedef struct ClockFmtScnStorage ClockFmtScnStorage;

struct ClockFmtScnStorage {
    int objRefCount;		/* Reference count shared across threads */
    ClockScanToken *scnTok;
    unsigned scnTokC;
    unsigned scnSpaceCount;	/* Count of mandatory spaces used in format */
    ClockFormatToken *fmtTok;
    unsigned fmtTokC;
#if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0
    ClockFmtScnStorage *nextPtr;
    ClockFmtScnStorage *prevPtr;
#endif
    size_t fmtMinAlloc;
#if 0
    Tcl_HashEntry hashEntry		/* ClockFmtScnStorage is a derivate of Tcl_HashEntry,
					 * stored by offset +sizeof(self) */
#endif
};

/*
 * Clock macros.
 */

/*
 * Extracts Julian day and seconds of the day from posix seconds (tm).
 */
#define ClockExtractJDAndSODFromSeconds(jd, sod, tm) \
    do {								\
	jd = (tm + JULIAN_SEC_POSIX_EPOCH);				\
	if (jd >= SECONDS_PER_DAY || jd <= -SECONDS_PER_DAY) {		\
	    jd /= SECONDS_PER_DAY;					\
	    sod = (int)(tm % SECONDS_PER_DAY);				\
	} else {							\
	    sod = (int)jd, jd = 0;					\
	}								\
	if (sod < 0) {							\
	    sod += SECONDS_PER_DAY;					\
	    /* JD is affected, if switched into negative (avoid 24 hours difference) */ \
	    if (jd <= 0) {						\
		jd--;							\
	    }								\
	}								\
    } while(0)

/*
 * 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(ClockClientData *dataPtr, Tcl_Interp *,
			    TclDateFields *, Tcl_Obj *timezoneObj, int);
MODULE_SCOPE Tcl_Obj *	LookupLastTransition(Tcl_Interp *, Tcl_WideInt,
			    Tcl_Size, Tcl_Obj *const *, Tcl_WideInt *rangesVal);
MODULE_SCOPE int	TclClockFreeScan(Tcl_Interp *interp, DateInfo *info);

/* tclClock.c module declarations */

MODULE_SCOPE Tcl_Obj *	ClockSetupTimeZone(ClockClientData *dataPtr,
			    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 char *	TclItoAw(char *buf, int val, char padchar, unsigned short width);
MODULE_SCOPE int	TclAtoWIe(Tcl_WideInt *out, const char *p, const char *e, int sign);

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(DateInfo *info, Tcl_Obj *strObj,
			    ClockFmtScnCmdArgs *opts);
MODULE_SCOPE int	ClockFormat(DateFormat *dateFmt,
			    ClockFmtScnCmdArgs *opts);
MODULE_SCOPE void	ClockFrmScnClearCaches(void);
MODULE_SCOPE void	ClockFrmScnFinalize();

#endif /* _TCLCLOCK_H */
Added generic/tclDateClassic.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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/* A Bison parser, made by GNU Bison 3.8.2.  */

/* Bison implementation for Yacc-like parsers in C

   Copyright (C) 1984, 1989-1990, 2000-2015, 2018-2021 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 <https://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
   special exception, which will cause the skeleton and the resulting
   Bison output files to be licensed under the GNU General Public
   License without this special exception.

   This special exception was added by the Free Software Foundation in
   version 2.2 of Bison.  */

/* C LALR(1) parser skeleton written by Richard Stallman, by
   simplifying the original so-called "semantic" parser.  */

/* DO NOT RELY ON FEATURES THAT ARE NOT DOCUMENTED in the manual,
   especially those whose name start with YY_ or yy_.  They are
   private implementation details that can be changed or removed.  */

/* All symbols defined below should begin with yy or YY, to avoid
   infringing on user name space.  This should be done even for local
   variables, as they might otherwise be expanded by user macros.
   There are some unavoidable exceptions within include files to
   define necessary library symbols; they are noted "INFRINGES ON
   USER NAME SPACE" below.  */

/* Identify Bison output, and Bison version.  */
#define YYBISON 30802

/* Bison version string.  */
#define YYBISON_VERSION "3.8.2"

/* Skeleton name.  */
#define YYSKELETON_NAME "yacc.c"

/* Pure parsers.  */
#define YYPURE 1

/* Push parsers.  */
#define YYPUSH 0

/* Pull parsers.  */
#define YYPULL 1


/* Substitute the variable and function names.  */
#define yyparse         TclDateparse
#define yylex           TclDatelex
#define yyerror         TclDateerror
#define yydebug         TclDatedebug

/* First part of user prologue.  */

/*
 * 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 & 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 */

/*
 * Meridian: am, pm, or 24-hour style.
 */

typedef enum _MERIDIAN {
    MERam, MERpm, MER24
} MERIDIAN;

/*
 * yyparse will accept a 'struct DateInfo' as its parameter; that's where the
 * parsed fields will be returned.
 */

typedef struct DateInfo {

    Tcl_Obj* messages;		/* Error messages */
    const char* separatrix;	/* String separating messages */

    time_t dateYear;
    time_t dateMonth;
    time_t dateDay;
    int dateHaveDate;

    time_t dateHour;
    time_t dateMinutes;
    time_t dateSeconds;
    MERIDIAN dateMeridian;
    int dateHaveTime;

    time_t dateTimezone;
    int dateDSTmode;
    int dateHaveZone;

    time_t dateRelMonth;
    time_t dateRelDay;
    time_t dateRelSeconds;
    int dateHaveRel;

    time_t dateMonthOrdinal;
    int dateHaveOrdinalMonth;

    time_t dateDayOrdinal;
    time_t dateDayNumber;
    int dateHaveDay;

    const char *dateStart;
    const char *dateInput;
    time_t *dateRelPointer;

    int dateDigitCount;
} DateInfo;

#define YYMALLOC	Tcl_Alloc
#define YYFREE(x)	(Tcl_Free((void*) (x)))

#define yyDSTmode	(info->dateDSTmode)
#define yyDayOrdinal	(info->dateDayOrdinal)
#define yyDayNumber	(info->dateDayNumber)
#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 yyDay		(info->dateDay)
#define yyMonth		(info->dateMonth)
#define yyYear		(info->dateYear)
#define yyHour		(info->dateHour)
#define yyMinutes	(info->dateMinutes)
#define yySeconds	(info->dateSeconds)
#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 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.
 */

#define TM_YEAR_BASE	1900

#define HOUR(x)		((int) (60 * (x)))
#define SECSPERDAY	(24L * 60L * 60L)
#define IsLeapYear(x)	(((x) % 4 == 0) && ((x) % 100 != 0 || (x) % 400 == 0))

/*
 * An entry in the lexical lookup table.
 */

typedef struct _TABLE {
    const char *name;
    int type;
    time_t value;
} TABLE;

/*
 * Daylight-savings mode: on, off, or not yet known.
 */

typedef enum _DSTMODE {
    DSTon, DSToff, DSTmaybe
} DSTMODE;



# ifndef YY_CAST
#  ifdef __cplusplus
#   define YY_CAST(Type, Val) static_cast<Type> (Val)
#   define YY_REINTERPRET_CAST(Type, Val) reinterpret_cast<Type> (Val)
#  else
#   define YY_CAST(Type, Val) ((Type) (Val))
#   define YY_REINTERPRET_CAST(Type, Val) ((Type) (Val))
#  endif
# endif
# ifndef YY_NULLPTR
#  if defined __cplusplus
#   if 201103L <= __cplusplus
#    define YY_NULLPTR nullptr
#   else
#    define YY_NULLPTR 0
#   endif
#  else
#   define YY_NULLPTR ((void*)0)
#  endif
# endif


/* Debug traces.  */
#ifndef YYDEBUG
# define YYDEBUG 0
#endif
#if YYDEBUG
extern int TclDatedebug;
#endif

/* Token kinds.  */
#ifndef YYTOKENTYPE
# define YYTOKENTYPE
  enum yytokentype
  {
    YYEMPTY = -2,
    YYEOF = 0,                     /* "end of file"  */
    YYerror = 256,                 /* error  */
    YYUNDEF = 257,                 /* "invalid token"  */
    tAGO = 258,                    /* tAGO  */
    tDAY = 259,                    /* tDAY  */
    tDAYZONE = 260,                /* tDAYZONE  */
    tID = 261,                     /* tID  */
    tMERIDIAN = 262,               /* tMERIDIAN  */
    tMONTH = 263,                  /* tMONTH  */
    tMONTH_UNIT = 264,             /* tMONTH_UNIT  */
    tSTARDATE = 265,               /* tSTARDATE  */
    tSEC_UNIT = 266,               /* tSEC_UNIT  */
    tSNUMBER = 267,                /* tSNUMBER  */
    tUNUMBER = 268,                /* tUNUMBER  */
    tZONE = 269,                   /* tZONE  */
    tEPOCH = 270,                  /* tEPOCH  */
    tDST = 271,                    /* tDST  */
    tISOBASE = 272,                /* tISOBASE  */
    tDAY_UNIT = 273,               /* tDAY_UNIT  */
    tNEXT = 274                    /* tNEXT  */
  };
  typedef enum yytokentype yytoken_kind_t;
#endif

/* Value type.  */
#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED
union YYSTYPE
{

    time_t Number;
    enum _MERIDIAN Meridian;


};
typedef union YYSTYPE YYSTYPE;
# define YYSTYPE_IS_TRIVIAL 1
# define YYSTYPE_IS_DECLARED 1
#endif

/* Location type.  */
#if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED
typedef struct YYLTYPE YYLTYPE;
struct YYLTYPE
{
  int first_line;
  int first_column;
  int last_line;
  int last_column;
};
# define YYLTYPE_IS_DECLARED 1
# define YYLTYPE_IS_TRIVIAL 1
#endif




int TclDateparse (DateInfo* info);



/* Symbol kind.  */
enum yysymbol_kind_t
{
  YYSYMBOL_YYEMPTY = -2,
  YYSYMBOL_YYEOF = 0,                      /* "end of file"  */
  YYSYMBOL_YYerror = 1,                    /* error  */
  YYSYMBOL_YYUNDEF = 2,                    /* "invalid token"  */
  YYSYMBOL_tAGO = 3,                       /* tAGO  */
  YYSYMBOL_tDAY = 4,                       /* tDAY  */
  YYSYMBOL_tDAYZONE = 5,                   /* tDAYZONE  */
  YYSYMBOL_tID = 6,                        /* tID  */
  YYSYMBOL_tMERIDIAN = 7,                  /* tMERIDIAN  */
  YYSYMBOL_tMONTH = 8,                     /* tMONTH  */
  YYSYMBOL_tMONTH_UNIT = 9,                /* tMONTH_UNIT  */
  YYSYMBOL_tSTARDATE = 10,                 /* tSTARDATE  */
  YYSYMBOL_tSEC_UNIT = 11,                 /* tSEC_UNIT  */
  YYSYMBOL_tSNUMBER = 12,                  /* tSNUMBER  */
  YYSYMBOL_tUNUMBER = 13,                  /* tUNUMBER  */
  YYSYMBOL_tZONE = 14,                     /* tZONE  */
  YYSYMBOL_tEPOCH = 15,                    /* tEPOCH  */
  YYSYMBOL_tDST = 16,                      /* tDST  */
  YYSYMBOL_tISOBASE = 17,                  /* tISOBASE  */
  YYSYMBOL_tDAY_UNIT = 18,                 /* tDAY_UNIT  */
  YYSYMBOL_tNEXT = 19,                     /* tNEXT  */
  YYSYMBOL_20_ = 20,                       /* ':'  */
  YYSYMBOL_21_ = 21,                       /* ','  */
  YYSYMBOL_22_ = 22,                       /* '/'  */
  YYSYMBOL_23_ = 23,                       /* '-'  */
  YYSYMBOL_24_ = 24,                       /* '.'  */
  YYSYMBOL_25_ = 25,                       /* '+'  */
  YYSYMBOL_YYACCEPT = 26,                  /* $accept  */
  YYSYMBOL_spec = 27,                      /* spec  */
  YYSYMBOL_item = 28,                      /* item  */
  YYSYMBOL_time = 29,                      /* time  */
  YYSYMBOL_zone = 30,                      /* zone  */
  YYSYMBOL_day = 31,                       /* day  */
  YYSYMBOL_date = 32,                      /* date  */
  YYSYMBOL_ordMonth = 33,                  /* ordMonth  */
  YYSYMBOL_iso = 34,                       /* iso  */
  YYSYMBOL_trek = 35,                      /* trek  */
  YYSYMBOL_relspec = 36,                   /* relspec  */
  YYSYMBOL_relunits = 37,                  /* relunits  */
  YYSYMBOL_sign = 38,                      /* sign  */
  YYSYMBOL_unit = 39,                      /* unit  */
  YYSYMBOL_number = 40,                    /* number  */
  YYSYMBOL_o_merid = 41                    /* o_merid  */
};
typedef enum yysymbol_kind_t yysymbol_kind_t;


/* Second part of user prologue.  */


/*
 * 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);
static time_t		ToSeconds(time_t Hours, time_t Minutes,
			    time_t Seconds, MERIDIAN Meridian);
MODULE_SCOPE int	yyparse(DateInfo*);




#ifdef short
# undef short
#endif

/* On compilers that do not define __PTRDIFF_MAX__ etc., make sure
   <limits.h> and (if available) <stdint.h> are included
   so that the code can choose integer types of a good width.  */

#ifndef __PTRDIFF_MAX__
# include <limits.h> /* INFRINGES ON USER NAME SPACE */
# if defined __STDC_VERSION__ && 199901 <= __STDC_VERSION__
#  include <stdint.h> /* INFRINGES ON USER NAME SPACE */
#  define YY_STDINT_H
# endif
#endif

/* Narrow types that promote to a signed type and that can represent a
   signed or unsigned integer of at least N bits.  In tables they can
   save space and decrease cache pressure.  Promoting to a signed type
   helps avoid bugs in integer arithmetic.  */

#ifdef __INT_LEAST8_MAX__
typedef __INT_LEAST8_TYPE__ yytype_int8;
#elif defined YY_STDINT_H
typedef int_least8_t yytype_int8;
#else
typedef signed char yytype_int8;
#endif

#ifdef __INT_LEAST16_MAX__
typedef __INT_LEAST16_TYPE__ yytype_int16;
#elif defined YY_STDINT_H
typedef int_least16_t yytype_int16;
#else
typedef short yytype_int16;
#endif

/* Work around bug in HP-UX 11.23, which defines these macros
   incorrectly for preprocessor constants.  This workaround can likely
   be removed in 2023, as HPE has promised support for HP-UX 11.23
   (aka HP-UX 11i v2) only through the end of 2022; see Table 2 of
   <https://h20195.www2.hpe.com/V2/getpdf.aspx/4AA4-7673ENW.pdf>.  */
#ifdef __hpux
# undef UINT_LEAST8_MAX
# undef UINT_LEAST16_MAX
# define UINT_LEAST8_MAX 255
# define UINT_LEAST16_MAX 65535
#endif

#if defined __UINT_LEAST8_MAX__ && __UINT_LEAST8_MAX__ <= __INT_MAX__
typedef __UINT_LEAST8_TYPE__ yytype_uint8;
#elif (!defined __UINT_LEAST8_MAX__ && defined YY_STDINT_H \
       && UINT_LEAST8_MAX <= INT_MAX)
typedef uint_least8_t yytype_uint8;
#elif !defined __UINT_LEAST8_MAX__ && UCHAR_MAX <= INT_MAX
typedef unsigned char yytype_uint8;
#else
typedef short yytype_uint8;
#endif

#if defined __UINT_LEAST16_MAX__ && __UINT_LEAST16_MAX__ <= __INT_MAX__
typedef __UINT_LEAST16_TYPE__ yytype_uint16;
#elif (!defined __UINT_LEAST16_MAX__ && defined YY_STDINT_H \
       && UINT_LEAST16_MAX <= INT_MAX)
typedef uint_least16_t yytype_uint16;
#elif !defined __UINT_LEAST16_MAX__ && USHRT_MAX <= INT_MAX
typedef unsigned short yytype_uint16;
#else
typedef int yytype_uint16;
#endif

#ifndef YYPTRDIFF_T
# if defined __PTRDIFF_TYPE__ && defined __PTRDIFF_MAX__
#  define YYPTRDIFF_T __PTRDIFF_TYPE__
#  define YYPTRDIFF_MAXIMUM __PTRDIFF_MAX__
# elif defined PTRDIFF_MAX
#  ifndef ptrdiff_t
#   include <stddef.h> /* INFRINGES ON USER NAME SPACE */
#  endif
#  define YYPTRDIFF_T ptrdiff_t
#  define YYPTRDIFF_MAXIMUM PTRDIFF_MAX
# else
#  define YYPTRDIFF_T long
#  define YYPTRDIFF_MAXIMUM LONG_MAX
# endif
#endif

#ifndef YYSIZE_T
# ifdef __SIZE_TYPE__
#  define YYSIZE_T __SIZE_TYPE__
# elif defined size_t
#  define YYSIZE_T size_t
# elif defined __STDC_VERSION__ && 199901 <= __STDC_VERSION__
#  include <stddef.h> /* INFRINGES ON USER NAME SPACE */
#  define YYSIZE_T size_t
# else
#  define YYSIZE_T unsigned
# endif
#endif

#define YYSIZE_MAXIMUM                                  \
  YY_CAST (YYPTRDIFF_T,                                 \
           (YYPTRDIFF_MAXIMUM < YY_CAST (YYSIZE_T, -1)  \
            ? YYPTRDIFF_MAXIMUM                         \
            : YY_CAST (YYSIZE_T, -1)))

#define YYSIZEOF(X) YY_CAST (YYPTRDIFF_T, sizeof (X))


/* Stored state numbers (used for stacks). */
typedef yytype_int8 yy_state_t;

/* State numbers in computations.  */
typedef int yy_state_fast_t;

#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
# endif
#endif


#ifndef YY_ATTRIBUTE_PURE
# if defined __GNUC__ && 2 < __GNUC__ + (96 <= __GNUC_MINOR__)
#  define YY_ATTRIBUTE_PURE __attribute__ ((__pure__))
# else
#  define YY_ATTRIBUTE_PURE
# endif
#endif

#ifndef YY_ATTRIBUTE_UNUSED
# if defined __GNUC__ && 2 < __GNUC__ + (7 <= __GNUC_MINOR__)
#  define YY_ATTRIBUTE_UNUSED __attribute__ ((__unused__))
# else
#  define YY_ATTRIBUTE_UNUSED
# endif
#endif

/* Suppress unused-variable warnings by "using" E.  */
#if ! defined lint || defined __GNUC__
# define YY_USE(E) ((void) (E))
#else
# define YY_USE(E) /* empty */
#endif

/* Suppress an incorrect diagnostic about yylval being uninitialized.  */
#if defined __GNUC__ && ! defined __ICC && 406 <= __GNUC__ * 100 + __GNUC_MINOR__
# if __GNUC__ * 100 + __GNUC_MINOR__ < 407
#  define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN                           \
    _Pragma ("GCC diagnostic push")                                     \
    _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"")
# else
#  define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN                           \
    _Pragma ("GCC diagnostic push")                                     \
    _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"")              \
    _Pragma ("GCC diagnostic ignored \"-Wmaybe-uninitialized\"")
# endif
# define YY_IGNORE_MAYBE_UNINITIALIZED_END      \
    _Pragma ("GCC diagnostic pop")
#else
# define YY_INITIAL_VALUE(Value) Value
#endif
#ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
# define YY_IGNORE_MAYBE_UNINITIALIZED_END
#endif
#ifndef YY_INITIAL_VALUE
# define YY_INITIAL_VALUE(Value) /* Nothing. */
#endif

#if defined __cplusplus && defined __GNUC__ && ! defined __ICC && 6 <= __GNUC__
# define YY_IGNORE_USELESS_CAST_BEGIN                          \
    _Pragma ("GCC diagnostic push")                            \
    _Pragma ("GCC diagnostic ignored \"-Wuseless-cast\"")
# define YY_IGNORE_USELESS_CAST_END            \
    _Pragma ("GCC diagnostic pop")
#endif
#ifndef YY_IGNORE_USELESS_CAST_BEGIN
# define YY_IGNORE_USELESS_CAST_BEGIN
# define YY_IGNORE_USELESS_CAST_END
#endif


#define YY_ASSERT(E) ((void) (0 && (E)))

#if !defined yyoverflow

/* The parser invokes alloca or malloc; define the necessary symbols.  */

# ifdef YYSTACK_USE_ALLOCA
#  if YYSTACK_USE_ALLOCA
#   ifdef __GNUC__
#    define YYSTACK_ALLOC __builtin_alloca
#   elif defined __BUILTIN_VA_ARG_INCR
#    include <alloca.h> /* INFRINGES ON USER NAME SPACE */
#   elif defined _AIX
#    define YYSTACK_ALLOC __alloca
#   elif defined _MSC_VER
#    include <malloc.h> /* INFRINGES ON USER NAME SPACE */
#    define alloca _alloca
#   else
#    define YYSTACK_ALLOC alloca
#    if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS
#     include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
      /* Use EXIT_SUCCESS as a witness for stdlib.h.  */
#     ifndef EXIT_SUCCESS
#      define EXIT_SUCCESS 0
#     endif
#    endif
#   endif
#  endif
# endif

# ifdef YYSTACK_ALLOC
   /* Pacify GCC's 'empty if-body' warning.  */
#  define YYSTACK_FREE(Ptr) do { /* empty */; } while (0)
#  ifndef YYSTACK_ALLOC_MAXIMUM
    /* The OS might guarantee only one guard page at the bottom of the stack,
       and a page size can be as small as 4096 bytes.  So we cannot safely
       invoke alloca (N) if N exceeds 4096.  Use a slightly smaller number
       to allow for a few compiler-allocated temporary stack slots.  */
#   define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */
#  endif
# else
#  define YYSTACK_ALLOC YYMALLOC
#  define YYSTACK_FREE YYFREE
#  ifndef YYSTACK_ALLOC_MAXIMUM
#   define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM
#  endif
#  if (defined __cplusplus && ! defined EXIT_SUCCESS \
       && ! ((defined YYMALLOC || defined malloc) \
             && (defined YYFREE || defined free)))
#   include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
#   ifndef EXIT_SUCCESS
#    define EXIT_SUCCESS 0
#   endif
#  endif
#  ifndef YYMALLOC
#   define YYMALLOC malloc
#   if ! defined malloc && ! defined EXIT_SUCCESS
void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */
#   endif
#  endif
#  ifndef YYFREE
#   define YYFREE free
#   if ! defined free && ! defined EXIT_SUCCESS
void free (void *); /* INFRINGES ON USER NAME SPACE */
#   endif
#  endif
# endif
#endif /* !defined yyoverflow */

#if (! defined yyoverflow \
     && (! 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
{
  yy_state_t 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 (YYSIZEOF (union yyalloc) - 1)

/* The size of an array large to enough to hold all stacks, each with
   N elements.  */
# define YYSTACK_BYTES(N) \
     ((N) * (YYSIZEOF (yy_state_t) + YYSIZEOF (YYSTYPE) \
             + YYSIZEOF (YYLTYPE)) \
      + 2 * YYSTACK_GAP_MAXIMUM)

# define YYCOPY_NEEDED 1

/* 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                                                                  \
      {                                                                 \
        YYPTRDIFF_T yynewbytes;                                         \
        YYCOPY (&yyptr->Stack_alloc, Stack, yysize);                    \
        Stack = &yyptr->Stack_alloc;                                    \
        yynewbytes = yystacksize * YYSIZEOF (*Stack) + YYSTACK_GAP_MAXIMUM; \
        yyptr += yynewbytes / YYSIZEOF (*yyptr);                        \
      }                                                                 \
    while (0)

#endif

#if defined YYCOPY_NEEDED && YYCOPY_NEEDED
/* Copy COUNT objects from SRC to DST.  The source and destination do
   not overlap.  */
# ifndef YYCOPY
#  if defined __GNUC__ && 1 < __GNUC__
#   define YYCOPY(Dst, Src, Count) \
      __builtin_memcpy (Dst, Src, YY_CAST (YYSIZE_T, (Count)) * sizeof (*(Src)))
#  else
#   define YYCOPY(Dst, Src, Count)              \
      do                                        \
        {                                       \
          YYPTRDIFF_T yyi;                      \
          for (yyi = 0; yyi < (Count); yyi++)   \
            (Dst)[yyi] = (Src)[yyi];            \
        }                                       \
      while (0)
#  endif
# endif
#endif /* !YYCOPY_NEEDED */

/* YYFINAL -- State number of the termination state.  */
#define YYFINAL  2
/* YYLAST -- Last index in YYTABLE.  */
#define YYLAST   81

/* YYNTOKENS -- Number of terminals.  */
#define YYNTOKENS  26
/* YYNNTS -- Number of nonterminals.  */
#define YYNNTS  16
/* YYNRULES -- Number of rules.  */
#define YYNRULES  56
/* YYNSTATES -- Number of states.  */
#define YYNSTATES  85

/* YYMAXUTOK -- Last valid token kind.  */
#define YYMAXUTOK   274


/* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM
   as returned by yylex, with out-of-bounds checking.  */
#define YYTRANSLATE(YYX)                                \
  (0 <= (YYX) && (YYX) <= YYMAXUTOK                     \
   ? YY_CAST (yysymbol_kind_t, yytranslate[YYX])        \
   : YYSYMBOL_YYUNDEF)

/* YYTRANSLATE[TOKEN-NUM] -- Symbol number corresponding to TOKEN-NUM
   as returned by yylex.  */
static const yytype_int8 yytranslate[] =
{
       0,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,    25,    21,    23,    24,    22,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,    20,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     1,     2,     3,     4,
       5,     6,     7,     8,     9,    10,    11,    12,    13,    14,
      15,    16,    17,    18,    19
};

#if YYDEBUG
/* YYRLINE[YYN] -- Source line where rule number YYN was defined.  */
static const yytype_int16 yyrline[] =
{
       0,   223,   223,   224,   227,   230,   233,   236,   239,   242,
     245,   249,   254,   257,   263,   269,   277,   282,   287,   291,
     297,   301,   305,   309,   313,   319,   323,   328,   333,   338,
     343,   347,   352,   356,   361,   368,   372,   378,   388,   397,
     406,   416,   430,   435,   438,   441,   444,   447,   450,   455,
     458,   463,   467,   471,   477,   495,   498
};
#endif

/** Accessing symbol of state STATE.  */
#define YY_ACCESSING_SYMBOL(State) YY_CAST (yysymbol_kind_t, yystos[State])

#if YYDEBUG || 0
/* The user-facing name of the symbol whose (internal) number is
   YYSYMBOL.  No bounds checking.  */
static const char *yysymbol_name (yysymbol_kind_t yysymbol) YY_ATTRIBUTE_UNUSED;

/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
   First, the terminals, then, starting at YYNTOKENS, nonterminals.  */
static const char *const yytname[] =
{
  "\"end of file\"", "error", "\"invalid token\"", "tAGO", "tDAY",
  "tDAYZONE", "tID", "tMERIDIAN", "tMONTH", "tMONTH_UNIT", "tSTARDATE",
  "tSEC_UNIT", "tSNUMBER", "tUNUMBER", "tZONE", "tEPOCH", "tDST",
  "tISOBASE", "tDAY_UNIT", "tNEXT", "':'", "','", "'/'", "'-'", "'.'",
  "'+'", "$accept", "spec", "item", "time", "zone", "day", "date",
  "ordMonth", "iso", "trek", "relspec", "relunits", "sign", "unit",
  "number", "o_merid", YY_NULLPTR
};

static const char *
yysymbol_name (yysymbol_kind_t yysymbol)
{
  return yytname[yysymbol];
}
#endif

#define YYPACT_NINF (-18)

#define yypact_value_is_default(Yyn) \
  ((Yyn) == YYPACT_NINF)

#define YYTABLE_NINF (-1)

#define yytable_value_is_error(Yyn) \
  0

/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
   STATE-NUM.  */
static const yytype_int8 yypact[] =
{
     -18,     2,   -18,   -17,   -18,    -4,   -18,    10,   -18,    22,
       8,   -18,    18,   -18,    39,   -18,   -18,   -18,   -18,   -18,
     -18,   -18,   -18,   -18,   -18,   -18,    25,    21,   -18,   -18,
     -18,    16,    14,   -18,   -18,    28,    36,    41,    -5,   -18,
     -18,     5,   -18,   -18,   -18,    47,   -18,   -18,    42,    46,
      48,   -18,    -6,    40,    43,    44,    49,   -18,   -18,   -18,
     -18,   -18,   -18,   -18,   -18,    50,   -18,    51,    55,    57,
      58,    65,   -18,   -18,    59,    54,   -18,    62,    63,    60,
     -18,    64,    61,    66,   -18
};

/* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM.
   Performed when YYTABLE does not specify something else to do.  Zero
   means the default is an error.  */
static const yytype_int8 yydefact[] =
{
       2,     0,     1,    20,    18,     0,    53,     0,    51,    54,
      17,    33,    27,    52,     0,    49,    50,     3,     4,     5,
       8,     6,     7,    10,    11,     9,    43,     0,    48,    12,
      21,    30,     0,    22,    13,    32,     0,     0,     0,    45,
      16,     0,    40,    24,    35,     0,    46,    42,    19,     0,
       0,    34,    55,    25,     0,     0,     0,    38,    36,    47,
      23,    44,    31,    41,    56,     0,    14,     0,     0,     0,
       0,    55,    26,    28,    29,     0,    15,     0,     0,     0,
      39,     0,     0,     0,    37
};

/* YYPGOTO[NTERM-NUM].  */
static const yytype_int8 yypgoto[] =
{
     -18,   -18,   -18,   -18,   -18,   -18,   -18,   -18,   -18,   -18,
     -18,   -18,   -18,    -9,   -18,     7
};

/* YYDEFGOTO[NTERM-NUM].  */
static const yytype_int8 yydefgoto[] =
{
       0,     1,    17,    18,    19,    20,    21,    22,    23,    24,
      25,    26,    27,    28,    29,    66
};

/* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM.  If
   positive, shift that token.  If negative, reduce the rule whose
   number is the opposite.  If YYTABLE_NINF, syntax error.  */
static const yytype_int8 yytable[] =
{
      39,    64,     2,    54,    30,    46,     3,     4,    55,    31,
       5,     6,     7,     8,    65,     9,    10,    11,    56,    12,
      13,    14,    57,    32,    40,    15,    33,    16,    47,    34,
      35,     6,    41,     8,    48,    42,    59,    49,    50,    61,
      13,    51,    36,    43,    37,    38,    60,    44,     6,    52,
       8,     6,    45,     8,    53,    58,     6,    13,     8,    62,
      13,    63,    67,    71,    72,    13,    68,    69,    73,    70,
      74,    75,    64,    77,    78,    79,    80,    82,    76,    84,
      81,    83
};

static const yytype_int8 yycheck[] =
{
       9,     7,     0,     8,    21,    14,     4,     5,    13,    13,
       8,     9,    10,    11,    20,    13,    14,    15,    13,    17,
      18,    19,    17,    13,    16,    23,     4,    25,     3,     7,
       8,     9,    14,    11,    13,    17,    45,    21,    24,    48,
      18,    13,    20,     4,    22,    23,     4,     8,     9,    13,
      11,     9,    13,    11,    13,     8,     9,    18,    11,    13,
      18,    13,    22,    13,    13,    18,    23,    23,    13,    20,
      13,    13,     7,    14,    20,    13,    13,    13,    71,    13,
      20,    20
};

/* YYSTOS[STATE-NUM] -- The symbol kind of the accessing symbol of
   state STATE-NUM.  */
static const yytype_int8 yystos[] =
{
       0,    27,     0,     4,     5,     8,     9,    10,    11,    13,
      14,    15,    17,    18,    19,    23,    25,    28,    29,    30,
      31,    32,    33,    34,    35,    36,    37,    38,    39,    40,
      21,    13,    13,     4,     7,     8,    20,    22,    23,    39,
      16,    14,    17,     4,     8,    13,    39,     3,    13,    21,
      24,    13,    13,    13,     8,    13,    13,    17,     8,    39,
       4,    39,    13,    13,     7,    20,    41,    22,    23,    23,
      20,    13,    13,    13,    13,    13,    41,    14,    20,    13,
      13,    20,    13,    20,    13
};

/* YYR1[RULE-NUM] -- Symbol kind of the left-hand side of rule RULE-NUM.  */
static const yytype_int8 yyr1[] =
{
       0,    26,    27,    27,    28,    28,    28,    28,    28,    28,
      28,    28,    28,    29,    29,    29,    30,    30,    30,    30,
      31,    31,    31,    31,    31,    32,    32,    32,    32,    32,
      32,    32,    32,    32,    32,    33,    33,    34,    34,    34,
      34,    35,    36,    36,    37,    37,    37,    37,    37,    38,
      38,    39,    39,    39,    40,    41,    41
};

/* YYR2[RULE-NUM] -- Number of symbols on the right-hand side of rule RULE-NUM.  */
static const yytype_int8 yyr2[] =
{
       0,     2,     0,     2,     1,     1,     1,     1,     1,     1,
       1,     1,     1,     2,     4,     6,     2,     1,     1,     2,
       1,     2,     2,     3,     2,     3,     5,     1,     5,     5,
       2,     4,     2,     1,     3,     2,     3,    11,     3,     7,
       2,     4,     2,     1,     3,     2,     2,     3,     1,     1,
       1,     1,     1,     1,     1,     0,     1
};


enum { YYENOMEM = -2 };

#define yyerrok         (yyerrstatus = 0)
#define yyclearin       (yychar = YYEMPTY)

#define YYACCEPT        goto yyacceptlab
#define YYABORT         goto yyabortlab
#define YYERROR         goto yyerrorlab
#define YYNOMEM         goto yyexhaustedlab


#define YYRECOVERING()  (!!yyerrstatus)

#define YYBACKUP(Token, Value)                                    \
  do                                                              \
    if (yychar == YYEMPTY)                                        \
      {                                                           \
        yychar = (Token);                                         \
        yylval = (Value);                                         \
        YYPOPSTACK (yylen);                                       \
        yystate = *yyssp;                                         \
        goto yybackup;                                            \
      }                                                           \
    else                                                          \
      {                                                           \
        yyerror (&yylloc, info, YY_("syntax error: cannot back up")); \
        YYERROR;                                                  \
      }                                                           \
  while (0)

/* Backward compatibility with an undocumented macro.
   Use YYerror or YYUNDEF. */
#define YYERRCODE YYUNDEF

/* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N].
   If N is 0, then set CURRENT to the empty location which ends
   the previous symbol: RHS[0] (always defined).  */

#ifndef YYLLOC_DEFAULT
# define YYLLOC_DEFAULT(Current, Rhs, N)                                \
    do                                                                  \
      if (N)                                                            \
        {                                                               \
          (Current).first_line   = YYRHSLOC (Rhs, 1).first_line;        \
          (Current).first_column = YYRHSLOC (Rhs, 1).first_column;      \
          (Current).last_line    = YYRHSLOC (Rhs, N).last_line;         \
          (Current).last_column  = YYRHSLOC (Rhs, N).last_column;       \
        }                                                               \
      else                                                              \
        {                                                               \
          (Current).first_line   = (Current).last_line   =              \
            YYRHSLOC (Rhs, 0).last_line;                                \
          (Current).first_column = (Current).last_column =              \
            YYRHSLOC (Rhs, 0).last_column;                              \
        }                                                               \
    while (0)
#endif

#define YYRHSLOC(Rhs, K) ((Rhs)[K])


/* Enable debugging if requested.  */
#if YYDEBUG

# ifndef YYFPRINTF
#  include <stdio.h> /* INFRINGES ON USER NAME SPACE */
#  define YYFPRINTF fprintf
# endif

# define YYDPRINTF(Args)                        \
do {                                            \
  if (yydebug)                                  \
    YYFPRINTF Args;                             \
} while (0)


/* YYLOCATION_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 YYLOCATION_PRINT

#  if defined YY_LOCATION_PRINT

   /* Temporary convenience wrapper in case some people defined the
      undocumented and private YY_LOCATION_PRINT macros.  */
#   define YYLOCATION_PRINT(File, Loc)  YY_LOCATION_PRINT(File, *(Loc))

#  elif defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL

/* Print *YYLOCP on YYO.  Private, do not rely on its existence. */

YY_ATTRIBUTE_UNUSED
static int
yy_location_print_ (FILE *yyo, YYLTYPE const * const yylocp)
{
  int res = 0;
  int end_col = 0 != yylocp->last_column ? yylocp->last_column - 1 : 0;
  if (0 <= yylocp->first_line)
    {
      res += YYFPRINTF (yyo, "%d", yylocp->first_line);
      if (0 <= yylocp->first_column)
        res += YYFPRINTF (yyo, ".%d", yylocp->first_column);
    }
  if (0 <= yylocp->last_line)
    {
      if (yylocp->first_line < yylocp->last_line)
        {
          res += YYFPRINTF (yyo, "-%d", yylocp->last_line);
          if (0 <= end_col)
            res += YYFPRINTF (yyo, ".%d", end_col);
        }
      else if (0 <= end_col && yylocp->first_column < end_col)
        res += YYFPRINTF (yyo, "-%d", end_col);
    }
  return res;
}

#   define YYLOCATION_PRINT  yy_location_print_

    /* Temporary convenience wrapper in case some people defined the
       undocumented and private YY_LOCATION_PRINT macros.  */
#   define YY_LOCATION_PRINT(File, Loc)  YYLOCATION_PRINT(File, &(Loc))

#  else

#   define YYLOCATION_PRINT(File, Loc) ((void) 0)
    /* Temporary convenience wrapper in case some people defined the
       undocumented and private YY_LOCATION_PRINT macros.  */
#   define YY_LOCATION_PRINT  YYLOCATION_PRINT

#  endif
# endif /* !defined YYLOCATION_PRINT */


# define YY_SYMBOL_PRINT(Title, Kind, Value, Location)                    \
do {                                                                      \
  if (yydebug)                                                            \
    {                                                                     \
      YYFPRINTF (stderr, "%s ", Title);                                   \
      yy_symbol_print (stderr,                                            \
                  Kind, Value, Location, info); \
      YYFPRINTF (stderr, "\n");                                           \
    }                                                                     \
} while (0)


/*-----------------------------------.
| Print this symbol's value on YYO.  |
`-----------------------------------*/

static void
yy_symbol_value_print (FILE *yyo,
                       yysymbol_kind_t yykind, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info)
{
  FILE *yyoutput = yyo;
  YY_USE (yyoutput);
  YY_USE (yylocationp);
  YY_USE (info);
  if (!yyvaluep)
    return;
  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
  YY_USE (yykind);
  YY_IGNORE_MAYBE_UNINITIALIZED_END
}


/*---------------------------.
| Print this symbol on YYO.  |
`---------------------------*/

static void
yy_symbol_print (FILE *yyo,
                 yysymbol_kind_t yykind, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info)
{
  YYFPRINTF (yyo, "%s %s (",
             yykind < YYNTOKENS ? "token" : "nterm", yysymbol_name (yykind));

  YYLOCATION_PRINT (yyo, yylocationp);
  YYFPRINTF (yyo, ": ");
  yy_symbol_value_print (yyo, yykind, yyvaluep, yylocationp, info);
  YYFPRINTF (yyo, ")");
}

/*------------------------------------------------------------------.
| yy_stack_print -- Print the state stack from its BOTTOM up to its |
| TOP (included).                                                   |
`------------------------------------------------------------------*/

static void
yy_stack_print (yy_state_t *yybottom, yy_state_t *yytop)
{
  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));                           \
} while (0)


/*------------------------------------------------.
| Report that the YYRULE is going to be reduced.  |
`------------------------------------------------*/

static void
yy_reduce_print (yy_state_t *yyssp, YYSTYPE *yyvsp, YYLTYPE *yylsp,
                 int yyrule, DateInfo* info)
{
  int yylno = yyrline[yyrule];
  int yynrhs = yyr2[yyrule];
  int yyi;
  YYFPRINTF (stderr, "Reducing stack by rule %d (line %d):\n",
             yyrule - 1, yylno);
  /* The symbols being reduced.  */
  for (yyi = 0; yyi < yynrhs; yyi++)
    {
      YYFPRINTF (stderr, "   $%d = ", yyi + 1);
      yy_symbol_print (stderr,
                       YY_ACCESSING_SYMBOL (+yyssp[yyi + 1 - yynrhs]),
                       &yyvsp[(yyi + 1) - (yynrhs)],
                       &(yylsp[(yyi + 1) - (yynrhs)]), info);
      YYFPRINTF (stderr, "\n");
    }
}

# define YY_REDUCE_PRINT(Rule)          \
do {                                    \
  if (yydebug)                          \
    yy_reduce_print (yyssp, yyvsp, yylsp, Rule, info); \
} while (0)

/* Nonzero means print parse trace.  It is left uninitialized so that
   multiple parsers can coexist.  */
int yydebug;
#else /* !YYDEBUG */
# define YYDPRINTF(Args) ((void) 0)
# define YY_SYMBOL_PRINT(Title, Kind, Value, Location)
# define YY_STACK_PRINT(Bottom, Top)
# define YY_REDUCE_PRINT(Rule)
#endif /* !YYDEBUG */


/* YYINITDEPTH -- initial size of the parser's stacks.  */
#ifndef YYINITDEPTH
# define YYINITDEPTH 200
#endif

/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only
   if the built-in stack extension method is used).

   Do not make this value too large; the results are undefined if
   YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH)
   evaluated with infinite-precision integer arithmetic.  */

#ifndef YYMAXDEPTH
# define YYMAXDEPTH 10000
#endif






/*-----------------------------------------------.
| Release the memory associated to this symbol.  |
`-----------------------------------------------*/

static void
yydestruct (const char *yymsg,
            yysymbol_kind_t yykind, YYSTYPE *yyvaluep, YYLTYPE *yylocationp, DateInfo* info)
{
  YY_USE (yyvaluep);
  YY_USE (yylocationp);
  YY_USE (info);
  if (!yymsg)
    yymsg = "Deleting";
  YY_SYMBOL_PRINT (yymsg, yykind, yyvaluep, yylocationp);

  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
  YY_USE (yykind);
  YY_IGNORE_MAYBE_UNINITIALIZED_END
}






/*----------.
| yyparse.  |
`----------*/

int
yyparse (DateInfo* info)
{
/* Lookahead token kind.  */
int yychar;


/* The semantic value of the lookahead symbol.  */
/* Default value used for initialization, for pacifying older GCCs
   or non-GCC compilers.  */
YY_INITIAL_VALUE (static YYSTYPE yyval_default;)
YYSTYPE yylval YY_INITIAL_VALUE (= yyval_default);

/* Location data for the lookahead symbol.  */
static YYLTYPE yyloc_default
# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL
  = { 1, 1, 1, 1 }
# endif
;
YYLTYPE yylloc = yyloc_default;

    yy_state_fast_t yystate = 0;
    /* Number of tokens to shift before error messages enabled.  */
    int yyerrstatus = 0;

    /* Refer to the stacks through separate pointers, to allow yyoverflow
       to reallocate them elsewhere.  */

    /* Their size.  */
    YYPTRDIFF_T yystacksize = YYINITDEPTH;

    /* The state stack: array, bottom, top.  */
    yy_state_t yyssa[YYINITDEPTH];
    yy_state_t *yyss = yyssa;
    yy_state_t *yyssp = yyss;

    /* The semantic value stack: array, bottom, top.  */
    YYSTYPE yyvsa[YYINITDEPTH];
    YYSTYPE *yyvs = yyvsa;
    YYSTYPE *yyvsp = yyvs;

    /* The location stack: array, bottom, top.  */
    YYLTYPE yylsa[YYINITDEPTH];
    YYLTYPE *yyls = yylsa;
    YYLTYPE *yylsp = yyls;

  int yyn;
  /* The return value of yyparse.  */
  int yyresult;
  /* Lookahead symbol kind.  */
  yysymbol_kind_t yytoken = YYSYMBOL_YYEMPTY;
  /* The variables used to return semantic value and location from the
     action routines.  */
  YYSTYPE yyval;
  YYLTYPE yyloc;

  /* The locations where the error started and ended.  */
  YYLTYPE yyerror_range[3];



#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;

  YYDPRINTF ((stderr, "Starting parse\n"));

  yychar = YYEMPTY; /* Cause a token to be read.  */

  yylsp[0] = yylloc;
  goto yysetstate;


/*------------------------------------------------------------.
| yynewstate -- push a new state, which is found in yystate.  |
`------------------------------------------------------------*/
yynewstate:
  /* In all cases, when you get here, the value and location stacks
     have just been pushed.  So pushing a state here evens the stacks.  */
  yyssp++;


/*--------------------------------------------------------------------.
| yysetstate -- set current state (the top of the stack) to yystate.  |
`--------------------------------------------------------------------*/
yysetstate:
  YYDPRINTF ((stderr, "Entering state %d\n", yystate));
  YY_ASSERT (0 <= yystate && yystate < YYNSTATES);
  YY_IGNORE_USELESS_CAST_BEGIN
  *yyssp = YY_CAST (yy_state_t, yystate);
  YY_IGNORE_USELESS_CAST_END
  YY_STACK_PRINT (yyss, yyssp);

  if (yyss + yystacksize - 1 <= yyssp)
#if !defined yyoverflow && !defined YYSTACK_RELOCATE
    YYNOMEM;
#else
    {
      /* Get the current used size of the three stacks, in elements.  */
      YYPTRDIFF_T yysize = yyssp - yyss + 1;

# if defined yyoverflow
      {
        /* Give user a chance to reallocate the stack.  Use copies of
           these so that the &'s don't force the real ones into
           memory.  */
        yy_state_t *yyss1 = yyss;
        YYSTYPE *yyvs1 = yyvs;
        YYLTYPE *yyls1 = yyls;

        /* Each stack pointer address is followed by the size of the
           data in use in that stack, in bytes.  This used to be a
           conditional around just the two extra args, but that might
           be undefined if yyoverflow is a macro.  */
        yyoverflow (YY_("memory exhausted"),
                    &yyss1, yysize * YYSIZEOF (*yyssp),
                    &yyvs1, yysize * YYSIZEOF (*yyvsp),
                    &yyls1, yysize * YYSIZEOF (*yylsp),
                    &yystacksize);
        yyss = yyss1;
        yyvs = yyvs1;
        yyls = yyls1;
      }
# else /* defined YYSTACK_RELOCATE */
      /* Extend the stack our own way.  */
      if (YYMAXDEPTH <= yystacksize)
        YYNOMEM;
      yystacksize *= 2;
      if (YYMAXDEPTH < yystacksize)
        yystacksize = YYMAXDEPTH;

      {
        yy_state_t *yyss1 = yyss;
        union yyalloc *yyptr =
          YY_CAST (union yyalloc *,
                   YYSTACK_ALLOC (YY_CAST (YYSIZE_T, YYSTACK_BYTES (yystacksize))));
        if (! yyptr)
          YYNOMEM;
        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

      yyssp = yyss + yysize - 1;
      yyvsp = yyvs + yysize - 1;
      yylsp = yyls + yysize - 1;

      YY_IGNORE_USELESS_CAST_BEGIN
      YYDPRINTF ((stderr, "Stack size increased to %ld\n",
                  YY_CAST (long, yystacksize)));
      YY_IGNORE_USELESS_CAST_END

      if (yyss + yystacksize - 1 <= yyssp)
        YYABORT;
    }
#endif /* !defined yyoverflow && !defined YYSTACK_RELOCATE */


  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 (yypact_value_is_default (yyn))
    goto yydefault;

  /* Not known => get a lookahead token if don't already have one.  */

  /* YYCHAR is either empty, or end-of-input, or a valid lookahead.  */
  if (yychar == YYEMPTY)
    {
      YYDPRINTF ((stderr, "Reading a token\n"));
      yychar = yylex (&yylval, &yylloc, info);
    }

  if (yychar <= YYEOF)
    {
      yychar = YYEOF;
      yytoken = YYSYMBOL_YYEOF;
      YYDPRINTF ((stderr, "Now at end of input.\n"));
    }
  else if (yychar == YYerror)
    {
      /* The scanner already issued an error message, process directly
         to error recovery.  But do not keep the error token as
         lookahead, it is too special and may lead us to an endless
         loop in error recovery. */
      yychar = YYUNDEF;
      yytoken = YYSYMBOL_YYerror;
      yyerror_range[1] = yylloc;
      goto yyerrlab1;
    }
  else
    {
      yytoken = YYTRANSLATE (yychar);
      YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc);
    }

  /* If the proper action on seeing token YYTOKEN is to reduce or to
     detect an error, take that action.  */
  yyn += yytoken;
  if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
    goto yydefault;
  yyn = yytable[yyn];
  if (yyn <= 0)
    {
      if (yytable_value_is_error (yyn))
        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);
  yystate = yyn;
  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
  *++yyvsp = yylval;
  YY_IGNORE_MAYBE_UNINITIALIZED_END
  *++yylsp = yylloc;

  /* Discard the shifted token.  */
  yychar = YYEMPTY;
  goto yynewstate;


/*-----------------------------------------------------------.
| yydefault -- do the default action for the current state.  |
`-----------------------------------------------------------*/
yydefault:
  yyn = yydefact[yystate];
  if (yyn == 0)
    goto yyerrlab;
  goto yyreduce;


/*-----------------------------.
| yyreduce -- do a reduction.  |
`-----------------------------*/
yyreduce:
  /* yyn is the number of a rule to reduce with.  */
  yylen = yyr2[yyn];

  /* If YYLEN is nonzero, implement the default value of the action:
     '$$ = $1'.

     Otherwise, the following line sets YYVAL to garbage.
     This behavior is undocumented and Bison
     users should not rely upon it.  Assigning to YYVAL
     unconditionally makes the parser a bit smaller, and it avoids a
     GCC warning that YYVAL may be used uninitialized.  */
  yyval = yyvsp[1-yylen];

  /* Default location. */
  YYLLOC_DEFAULT (yyloc, (yylsp - yylen), yylen);
  yyerror_range[1] = yyloc;
  YY_REDUCE_PRINT (yyn);
  switch (yyn)
    {
  case 4: /* item: time  */
               {
	    yyHaveTime++;
	}
    break;

  case 5: /* item: zone  */
               {
	    yyHaveZone++;
	}
    break;

  case 6: /* item: date  */
               {
	    yyHaveDate++;
	}
    break;

  case 7: /* item: ordMonth  */
                   {
	    yyHaveOrdinalMonth++;
	}
    break;

  case 8: /* item: day  */
              {
	    yyHaveDay++;
	}
    break;

  case 9: /* item: relspec  */
                  {
	    yyHaveRel++;
	}
    break;

  case 10: /* item: iso  */
              {
	    yyHaveTime++;
	    yyHaveDate++;
	}
    break;

  case 11: /* item: trek  */
               {
	    yyHaveTime++;
	    yyHaveDate++;
	    yyHaveRel++;
	}
    break;

  case 13: /* time: tUNUMBER tMERIDIAN  */
                             {
	    yyHour = (yyvsp[-1].Number);
	    yyMinutes = 0;
	    yySeconds = 0;
	    yyMeridian = (yyvsp[0].Meridian);
	}
    break;

  case 14: /* time: tUNUMBER ':' tUNUMBER o_merid  */
                                        {
	    yyHour = (yyvsp[-3].Number);
	    yyMinutes = (yyvsp[-1].Number);
	    yySeconds = 0;
	    yyMeridian = (yyvsp[0].Meridian);
	}
    break;

  case 15: /* time: tUNUMBER ':' tUNUMBER ':' tUNUMBER o_merid  */
                                                     {
	    yyHour = (yyvsp[-5].Number);
	    yyMinutes = (yyvsp[-3].Number);
	    yySeconds = (yyvsp[-1].Number);
	    yyMeridian = (yyvsp[0].Meridian);
	}
    break;

  case 16: /* zone: tZONE tDST  */
                     {
	    yyTimezone = (yyvsp[-1].Number);
	    if (yyTimezone > HOUR( 12)) yyTimezone -= HOUR(100);
	    yyDSTmode = DSTon;
	}
    break;

  case 17: /* zone: tZONE  */
                {
	    yyTimezone = (yyvsp[0].Number);
	    if (yyTimezone > HOUR( 12)) yyTimezone -= HOUR(100);
	    yyDSTmode = DSToff;
	}
    break;

  case 18: /* zone: tDAYZONE  */
                   {
	    yyTimezone = (yyvsp[0].Number);
	    yyDSTmode = DSTon;
	}
    break;

  case 19: /* zone: sign tUNUMBER  */
                        {
	    yyTimezone = -(yyvsp[-1].Number)*((yyvsp[0].Number) % 100 + ((yyvsp[0].Number) / 100) * 60);
	    yyDSTmode = DSToff;
	}
    break;

  case 20: /* day: tDAY  */
               {
	    yyDayOrdinal = 1;
	    yyDayNumber = (yyvsp[0].Number);
	}
    break;

  case 21: /* day: tDAY ','  */
                   {
	    yyDayOrdinal = 1;
	    yyDayNumber = (yyvsp[-1].Number);
	}
    break;

  case 22: /* day: tUNUMBER tDAY  */
                        {
	    yyDayOrdinal = (yyvsp[-1].Number);
	    yyDayNumber = (yyvsp[0].Number);
	}
    break;

  case 23: /* day: sign tUNUMBER tDAY  */
                             {
	    yyDayOrdinal = (yyvsp[-2].Number) * (yyvsp[-1].Number);
	    yyDayNumber = (yyvsp[0].Number);
	}
    break;

  case 24: /* day: tNEXT tDAY  */
                     {
	    yyDayOrdinal = 2;
	    yyDayNumber = (yyvsp[0].Number);
	}
    break;

  case 25: /* date: tUNUMBER '/' tUNUMBER  */
                                {
	    yyMonth = (yyvsp[-2].Number);
	    yyDay = (yyvsp[0].Number);
	}
    break;

  case 26: /* date: tUNUMBER '/' tUNUMBER '/' tUNUMBER  */
                                             {
	    yyMonth = (yyvsp[-4].Number);
	    yyDay = (yyvsp[-2].Number);
	    yyYear = (yyvsp[0].Number);
	}
    break;

  case 27: /* date: tISOBASE  */
                   {
	    yyYear = (yyvsp[0].Number) / 10000;
	    yyMonth = ((yyvsp[0].Number) % 10000)/100;
	    yyDay = (yyvsp[0].Number) % 100;
	}
    break;

  case 28: /* date: tUNUMBER '-' tMONTH '-' tUNUMBER  */
                                           {
	    yyDay = (yyvsp[-4].Number);
	    yyMonth = (yyvsp[-2].Number);
	    yyYear = (yyvsp[0].Number);
	}
    break;

  case 29: /* date: tUNUMBER '-' tUNUMBER '-' tUNUMBER  */
                                             {
	    yyMonth = (yyvsp[-2].Number);
	    yyDay = (yyvsp[0].Number);
	    yyYear = (yyvsp[-4].Number);
	}
    break;

  case 30: /* date: tMONTH tUNUMBER  */
                          {
	    yyMonth = (yyvsp[-1].Number);
	    yyDay = (yyvsp[0].Number);
	}
    break;

  case 31: /* date: tMONTH tUNUMBER ',' tUNUMBER  */
                                       {
	    yyMonth = (yyvsp[-3].Number);
	    yyDay = (yyvsp[-2].Number);
	    yyYear = (yyvsp[0].Number);
	}
    break;

  case 32: /* date: tUNUMBER tMONTH  */
                          {
	    yyMonth = (yyvsp[0].Number);
	    yyDay = (yyvsp[-1].Number);
	}
    break;

  case 33: /* date: tEPOCH  */
                 {
	    yyMonth = 1;
	    yyDay = 1;
	    yyYear = EPOCH;
	}
    break;

  case 34: /* date: tUNUMBER tMONTH tUNUMBER  */
                                   {
	    yyMonth = (yyvsp[-1].Number);
	    yyDay = (yyvsp[-2].Number);
	    yyYear = (yyvsp[0].Number);
	}
    break;

  case 35: /* ordMonth: tNEXT tMONTH  */
                       {
	    yyMonthOrdinal = 1;
	    yyMonth = (yyvsp[0].Number);
	}
    break;

  case 36: /* ordMonth: tNEXT tUNUMBER tMONTH  */
                                {
	    yyMonthOrdinal = (yyvsp[-1].Number);
	    yyMonth = (yyvsp[0].Number);
	}
    break;

  case 37: /* iso: tUNUMBER '-' tUNUMBER '-' tUNUMBER tZONE tUNUMBER ':' tUNUMBER ':' tUNUMBER  */
                                                   {
	    if ((yyvsp[-5].Number) != HOUR( 7) + HOUR(100)) YYABORT;
	    yyYear = (yyvsp[-10].Number);
	    yyMonth = (yyvsp[-8].Number);
	    yyDay = (yyvsp[-6].Number);
	    yyHour = (yyvsp[-4].Number);
	    yyMinutes = (yyvsp[-2].Number);
	    yySeconds = (yyvsp[0].Number);
	}
    break;

  case 38: /* iso: tISOBASE tZONE tISOBASE  */
                                  {
	    if ((yyvsp[-1].Number) != HOUR( 7) + HOUR(100)) YYABORT;
	    yyYear = (yyvsp[-2].Number) / 10000;
	    yyMonth = ((yyvsp[-2].Number) % 10000)/100;
	    yyDay = (yyvsp[-2].Number) % 100;
	    yyHour = (yyvsp[0].Number) / 10000;
	    yyMinutes = ((yyvsp[0].Number) % 10000)/100;
	    yySeconds = (yyvsp[0].Number) % 100;
	}
    break;

  case 39: /* iso: tISOBASE tZONE tUNUMBER ':' tUNUMBER ':' tUNUMBER  */
                                                            {
	    if ((yyvsp[-5].Number) != HOUR( 7) + HOUR(100)) YYABORT;
	    yyYear = (yyvsp[-6].Number) / 10000;
	    yyMonth = ((yyvsp[-6].Number) % 10000)/100;
	    yyDay = (yyvsp[-6].Number) % 100;
	    yyHour = (yyvsp[-4].Number);
	    yyMinutes = (yyvsp[-2].Number);
	    yySeconds = (yyvsp[0].Number);
	}
    break;

  case 40: /* iso: tISOBASE tISOBASE  */
                            {
	    yyYear = (yyvsp[-1].Number) / 10000;
	    yyMonth = ((yyvsp[-1].Number) % 10000)/100;
	    yyDay = (yyvsp[-1].Number) % 100;
	    yyHour = (yyvsp[0].Number) / 10000;
	    yyMinutes = ((yyvsp[0].Number) % 10000)/100;
	    yySeconds = (yyvsp[0].Number) % 100;
	}
    break;

  case 41: /* trek: tSTARDATE tUNUMBER '.' tUNUMBER  */
                                          {
	    /*
	     * Offset computed year by -377 so that the returned years will be
	     * in a range accessible with a 32 bit clock seconds value.
	     */

	    yyYear = (yyvsp[-2].Number)/1000 + 2323 - 377;
	    yyDay  = 1;
	    yyMonth = 1;
	    yyRelDay += (((yyvsp[-2].Number)%1000)*(365 + IsLeapYear(yyYear)))/1000;
	    yyRelSeconds += (yyvsp[0].Number) * 144 * 60;
	}
    break;

  case 42: /* relspec: relunits tAGO  */
                        {
	    yyRelSeconds *= -1;
	    yyRelMonth *= -1;
	    yyRelDay *= -1;
	}
    break;

  case 44: /* relunits: sign tUNUMBER unit  */
                              {
	    *yyRelPointer += (yyvsp[-2].Number) * (yyvsp[-1].Number) * (yyvsp[0].Number);
	}
    break;

  case 45: /* relunits: tUNUMBER unit  */
                        {
	    *yyRelPointer += (yyvsp[-1].Number) * (yyvsp[0].Number);
	}
    break;

  case 46: /* relunits: tNEXT unit  */
                     {
	    *yyRelPointer += (yyvsp[0].Number);
	}
    break;

  case 47: /* relunits: tNEXT tUNUMBER unit  */
                              {
	    *yyRelPointer += (yyvsp[-1].Number) * (yyvsp[0].Number);
	}
    break;

  case 48: /* relunits: unit  */
               {
	    *yyRelPointer += (yyvsp[0].Number);
	}
    break;

  case 49: /* sign: '-'  */
              {
	    (yyval.Number) = -1;
	}
    break;

  case 50: /* sign: '+'  */
              {
	    (yyval.Number) =  1;
	}
    break;

  case 51: /* unit: tSEC_UNIT  */
                    {
	    (yyval.Number) = (yyvsp[0].Number);
	    yyRelPointer = &yyRelSeconds;
	}
    break;

  case 52: /* unit: tDAY_UNIT  */
                    {
	    (yyval.Number) = (yyvsp[0].Number);
	    yyRelPointer = &yyRelDay;
	}
    break;

  case 53: /* unit: tMONTH_UNIT  */
                      {
	    (yyval.Number) = (yyvsp[0].Number);
	    yyRelPointer = &yyRelMonth;
	}
    break;

  case 54: /* number: tUNUMBER  */
                   {
	    if (yyHaveTime && yyHaveDate && !yyHaveRel) {
		yyYear = (yyvsp[0].Number);
	    } else {
		yyHaveTime++;
		if (yyDigitCount <= 2) {
		    yyHour = (yyvsp[0].Number);
		    yyMinutes = 0;
		} else {
		    yyHour = (yyvsp[0].Number) / 100;
		    yyMinutes = (yyvsp[0].Number) % 100;
		}
		yySeconds = 0;
		yyMeridian = MER24;
	    }
	}
    break;

  case 55: /* o_merid: %empty  */
                     {
	    (yyval.Meridian) = MER24;
	}
    break;

  case 56: /* o_merid: tMERIDIAN  */
                    {
	    (yyval.Meridian) = (yyvsp[0].Meridian);
	}
    break;



      default: break;
    }
  /* User semantic actions sometimes alter yychar, and that requires
     that yytoken be updated with the new translation.  We take the
     approach of translating immediately before every use of yytoken.
     One alternative is translating here after every semantic action,
     but that translation would be missed if the semantic action invokes
     YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or
     if it invokes YYBACKUP.  In the case of YYABORT or YYACCEPT, an
     incorrect destructor might then be invoked immediately.  In the
     case of YYERROR or YYBACKUP, subsequent parser actions might lead
     to an incorrect destructor call or verbose syntax error message
     before the lookahead is translated.  */
  YY_SYMBOL_PRINT ("-> $$ =", YY_CAST (yysymbol_kind_t, yyr1[yyn]), &yyval, &yyloc);

  YYPOPSTACK (yylen);
  yylen = 0;

  *++yyvsp = yyval;
  *++yylsp = yyloc;

  /* Now 'shift' the result of the reduction.  Determine what state
     that goes to, based on the state we popped back to and the rule
     number reduced by.  */
  {
    const int yylhs = yyr1[yyn] - YYNTOKENS;
    const int yyi = yypgoto[yylhs] + *yyssp;
    yystate = (0 <= yyi && yyi <= YYLAST && yycheck[yyi] == *yyssp
               ? yytable[yyi]
               : yydefgoto[yylhs]);
  }

  goto yynewstate;


/*--------------------------------------.
| yyerrlab -- here on detecting error.  |
`--------------------------------------*/
yyerrlab:
  /* Make sure we have latest lookahead translation.  See comments at
     user semantic actions for why this is necessary.  */
  yytoken = yychar == YYEMPTY ? YYSYMBOL_YYEMPTY : YYTRANSLATE (yychar);
  /* If not already recovering from an error, report this error.  */
  if (!yyerrstatus)
    {
      yyerror (&yylloc, info, YY_("syntax error"));
    }

  yyerror_range[1] = 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.  |
`---------------------------------------------------*/
yyerrorlab:
  /* Pacify compilers when the user code never invokes YYERROR and the
     label yyerrorlab therefore never appears in user code.  */
  if (0)
    YYERROR;

  /* Do not reclaim the symbols of the rule whose action triggered
     this YYERROR.  */
  YYPOPSTACK (yylen);
  yylen = 0;
  YY_STACK_PRINT (yyss, yyssp);
  yystate = *yyssp;
  goto yyerrlab1;


/*-------------------------------------------------------------.
| yyerrlab1 -- common code for both syntax error and YYERROR.  |
`-------------------------------------------------------------*/
yyerrlab1:
  yyerrstatus = 3;      /* Each real token shifted decrements this.  */

  /* Pop stack until we find a state that shifts the error token.  */
  for (;;)
    {
      yyn = yypact[yystate];
      if (!yypact_value_is_default (yyn))
        {
          yyn += YYSYMBOL_YYerror;
          if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYSYMBOL_YYerror)
            {
              yyn = yytable[yyn];
              if (0 < yyn)
                break;
            }
        }

      /* Pop the current state because it cannot handle the error token.  */
      if (yyssp == yyss)
        YYABORT;

      yyerror_range[1] = *yylsp;
      yydestruct ("Error: popping",
                  YY_ACCESSING_SYMBOL (yystate), yyvsp, yylsp, info);
      YYPOPSTACK (1);
      yystate = *yyssp;
      YY_STACK_PRINT (yyss, yyssp);
    }

  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
  *++yyvsp = yylval;
  YY_IGNORE_MAYBE_UNINITIALIZED_END

  yyerror_range[2] = yylloc;
  ++yylsp;
  YYLLOC_DEFAULT (*yylsp, yyerror_range, 2);

  /* Shift the error token.  */
  YY_SYMBOL_PRINT ("Shifting", YY_ACCESSING_SYMBOL (yyn), yyvsp, yylsp);

  yystate = yyn;
  goto yynewstate;


/*-------------------------------------.
| yyacceptlab -- YYACCEPT comes here.  |
`-------------------------------------*/
yyacceptlab:
  yyresult = 0;
  goto yyreturnlab;


/*-----------------------------------.
| yyabortlab -- YYABORT comes here.  |
`-----------------------------------*/
yyabortlab:
  yyresult = 1;
  goto yyreturnlab;


/*-----------------------------------------------------------.
| yyexhaustedlab -- YYNOMEM (memory exhaustion) comes here.  |
`-----------------------------------------------------------*/
yyexhaustedlab:
  yyerror (&yylloc, info, YY_("memory exhausted"));
  yyresult = 2;
  goto yyreturnlab;


/*----------------------------------------------------------.
| yyreturnlab -- parsing is finished, clean up and return.  |
`----------------------------------------------------------*/
yyreturnlab:
  if (yychar != YYEMPTY)
    {
      /* Make sure we have latest lookahead translation.  See comments at
         user semantic actions for why this is necessary.  */
      yytoken = YYTRANSLATE (yychar);
      yydestruct ("Cleanup: discarding lookahead",
                  yytoken, &yylval, &yylloc, info);
    }
  /* Do not reclaim the symbols of the rule whose action triggered
     this YYABORT or YYACCEPT.  */
  YYPOPSTACK (yylen);
  YY_STACK_PRINT (yyss, yyssp);
  while (yyssp != yyss)
    {
      yydestruct ("Cleanup: popping",
                  YY_ACCESSING_SYMBOL (+*yyssp), yyvsp, yylsp, info);
      YYPOPSTACK (1);
    }
#ifndef yyoverflow
  if (yyss != yyssa)
    YYSTACK_FREE (yyss);
#endif

  return yyresult;
}


/*
 * Month and day table.
 */

static const TABLE MonthDayTable[] = {
    { "january",	tMONTH,	 1 },
    { "february",	tMONTH,	 2 },
    { "march",		tMONTH,	 3 },
    { "april",		tMONTH,	 4 },
    { "may",		tMONTH,	 5 },
    { "june",		tMONTH,	 6 },
    { "july",		tMONTH,	 7 },
    { "august",		tMONTH,	 8 },
    { "september",	tMONTH,	 9 },
    { "sept",		tMONTH,	 9 },
    { "october",	tMONTH, 10 },
    { "november",	tMONTH, 11 },
    { "december",	tMONTH, 12 },
    { "sunday",		tDAY, 0 },
    { "monday",		tDAY, 1 },
    { "tuesday",	tDAY, 2 },
    { "tues",		tDAY, 2 },
    { "wednesday",	tDAY, 3 },
    { "wednes",		tDAY, 3 },
    { "thursday",	tDAY, 4 },
    { "thur",		tDAY, 4 },
    { "thurs",		tDAY, 4 },
    { "friday",		tDAY, 5 },
    { "saturday",	tDAY, 6 },
    { NULL, 0, 0 }
};

/*
 * Time units table.
 */

static const TABLE UnitsTable[] = {
    { "year",		tMONTH_UNIT,	12 },
    { "month",		tMONTH_UNIT,	 1 },
    { "fortnight",	tDAY_UNIT,	14 },
    { "week",		tDAY_UNIT,	 7 },
    { "day",		tDAY_UNIT,	 1 },
    { "hour",		tSEC_UNIT, 60 * 60 },
    { "minute",		tSEC_UNIT,	60 },
    { "min",		tSEC_UNIT,	60 },
    { "second",		tSEC_UNIT,	 1 },
    { "sec",		tSEC_UNIT,	 1 },
    { NULL, 0, 0 }
};

/*
 * Assorted relative-time words.
 */

static const TABLE OtherTable[] = {
    { "tomorrow",	tDAY_UNIT,	1 },
    { "yesterday",	tDAY_UNIT,	-1 },
    { "today",		tDAY_UNIT,	0 },
    { "now",		tSEC_UNIT,	0 },
    { "last",		tUNUMBER,	-1 },
    { "this",		tSEC_UNIT,	0 },
    { "next",		tNEXT,		1 },
#if 0
    { "first",		tUNUMBER,	1 },
    { "second",		tUNUMBER,	2 },
    { "third",		tUNUMBER,	3 },
    { "fourth",		tUNUMBER,	4 },
    { "fifth",		tUNUMBER,	5 },
    { "sixth",		tUNUMBER,	6 },
    { "seventh",	tUNUMBER,	7 },
    { "eighth",		tUNUMBER,	8 },
    { "ninth",		tUNUMBER,	9 },
    { "tenth",		tUNUMBER,	10 },
    { "eleventh",	tUNUMBER,	11 },
    { "twelfth",	tUNUMBER,	12 },
#endif
    { "ago",		tAGO,		1 },
    { "epoch",		tEPOCH,		0 },
    { "stardate",	tSTARDATE,	0 },
    { NULL, 0, 0 }
};

/*
 * The timezone table. (Note: This table was modified to not use any floating
 * point constants to work around an SGI compiler bug).
 */

static const TABLE TimezoneTable[] = {
    { "gmt",	tZONE,	   HOUR( 0) },	    /* Greenwich Mean */
    { "ut",	tZONE,	   HOUR( 0) },	    /* Universal (Coordinated) */
    { "utc",	tZONE,	   HOUR( 0) },
    { "uct",	tZONE,	   HOUR( 0) },	    /* Universal Coordinated Time */
    { "wet",	tZONE,	   HOUR( 0) },	    /* Western European */
    { "bst",	tDAYZONE,  HOUR( 0) },	    /* British Summer */
    { "wat",	tZONE,	   HOUR( 1) },	    /* West Africa */
    { "at",	tZONE,	   HOUR( 2) },	    /* Azores */
#if	0
    /* For completeness.  BST is also British Summer, and GST is
     * also Guam Standard. */
    { "bst",	tZONE,	   HOUR( 3) },	    /* Brazil Standard */
    { "gst",	tZONE,	   HOUR( 3) },	    /* Greenland Standard */
#endif
    { "nft",	tZONE,	   HOUR( 7/2) },    /* Newfoundland */
    { "nst",	tZONE,	   HOUR( 7/2) },    /* Newfoundland Standard */
    { "ndt",	tDAYZONE,  HOUR( 7/2) },    /* Newfoundland Daylight */
    { "ast",	tZONE,	   HOUR( 4) },	    /* Atlantic Standard */
    { "adt",	tDAYZONE,  HOUR( 4) },	    /* Atlantic Daylight */
    { "est",	tZONE,	   HOUR( 5) },	    /* Eastern Standard */
    { "edt",	tDAYZONE,  HOUR( 5) },	    /* Eastern Daylight */
    { "cst",	tZONE,	   HOUR( 6) },	    /* Central Standard */
    { "cdt",	tDAYZONE,  HOUR( 6) },	    /* Central Daylight */
    { "mst",	tZONE,	   HOUR( 7) },	    /* Mountain Standard */
    { "mdt",	tDAYZONE,  HOUR( 7) },	    /* Mountain Daylight */
    { "pst",	tZONE,	   HOUR( 8) },	    /* Pacific Standard */
    { "pdt",	tDAYZONE,  HOUR( 8) },	    /* Pacific Daylight */
    { "yst",	tZONE,	   HOUR( 9) },	    /* Yukon Standard */
    { "ydt",	tDAYZONE,  HOUR( 9) },	    /* Yukon Daylight */
    { "akst",	tZONE,	   HOUR( 9) },	    /* Alaska Standard */
    { "akdt",	tDAYZONE,  HOUR( 9) },	    /* Alaska Daylight */
    { "hst",	tZONE,	   HOUR(10) },	    /* Hawaii Standard */
    { "hdt",	tDAYZONE,  HOUR(10) },	    /* Hawaii Daylight */
    { "cat",	tZONE,	   HOUR(10) },	    /* Central Alaska */
    { "ahst",	tZONE,	   HOUR(10) },	    /* Alaska-Hawaii Standard */
    { "nt",	tZONE,	   HOUR(11) },	    /* Nome */
    { "idlw",	tZONE,	   HOUR(12) },	    /* International Date Line West */
    { "cet",	tZONE,	  -HOUR( 1) },	    /* Central European */
    { "cest",	tDAYZONE, -HOUR( 1) },	    /* Central European Summer */
    { "met",	tZONE,	  -HOUR( 1) },	    /* Middle European */
    { "mewt",	tZONE,	  -HOUR( 1) },	    /* Middle European Winter */
    { "mest",	tDAYZONE, -HOUR( 1) },	    /* Middle European Summer */
    { "swt",	tZONE,	  -HOUR( 1) },	    /* Swedish Winter */
    { "sst",	tDAYZONE, -HOUR( 1) },	    /* Swedish Summer */
    { "fwt",	tZONE,	  -HOUR( 1) },	    /* French Winter */
    { "fst",	tDAYZONE, -HOUR( 1) },	    /* French Summer */
    { "eet",	tZONE,	  -HOUR( 2) },	    /* Eastern Europe, USSR Zone 1 */
    { "bt",	tZONE,	  -HOUR( 3) },	    /* Baghdad, USSR Zone 2 */
    { "it",	tZONE,	  -HOUR( 7/2) },    /* Iran */
    { "zp4",	tZONE,	  -HOUR( 4) },	    /* USSR Zone 3 */
    { "zp5",	tZONE,	  -HOUR( 5) },	    /* USSR Zone 4 */
    { "ist",	tZONE,	  -HOUR(11/2) },    /* Indian Standard */
    { "zp6",	tZONE,	  -HOUR( 6) },	    /* USSR Zone 5 */
#if	0
    /* For completeness.  NST is also Newfoundland Standard, and SST is
     * also Swedish Summer. */
    { "nst",	tZONE,	  -HOUR(13/2) },    /* North Sumatra */
    { "sst",	tZONE,	  -HOUR( 7) },	    /* South Sumatra, USSR Zone 6 */
#endif	/* 0 */
    { "wast",	tZONE,	  -HOUR( 7) },	    /* West Australian Standard */
    { "wadt",	tDAYZONE, -HOUR( 7) },	    /* West Australian Daylight */
    { "jt",	tZONE,	  -HOUR(15/2) },    /* Java (3pm in Cronusland!) */
    { "cct",	tZONE,	  -HOUR( 8) },	    /* China Coast, USSR Zone 7 */
    { "jst",	tZONE,	  -HOUR( 9) },	    /* Japan Standard, USSR Zone 8 */
    { "jdt",	tDAYZONE, -HOUR( 9) },	    /* Japan Daylight */
    { "kst",	tZONE,	  -HOUR( 9) },	    /* Korea Standard */
    { "kdt",	tDAYZONE, -HOUR( 9) },	    /* Korea Daylight */
    { "cast",	tZONE,	  -HOUR(19/2) },    /* Central Australian Standard */
    { "cadt",	tDAYZONE, -HOUR(19/2) },    /* Central Australian Daylight */
    { "east",	tZONE,	  -HOUR(10) },	    /* Eastern Australian Standard */
    { "eadt",	tDAYZONE, -HOUR(10) },	    /* Eastern Australian Daylight */
    { "gst",	tZONE,	  -HOUR(10) },	    /* Guam Standard, USSR Zone 9 */
    { "nzt",	tZONE,	  -HOUR(12) },	    /* New Zealand */
    { "nzst",	tZONE,	  -HOUR(12) },	    /* New Zealand Standard */
    { "nzdt",	tDAYZONE, -HOUR(12) },	    /* New Zealand Daylight */
    { "idle",	tZONE,	  -HOUR(12) },	    /* International Date Line East */
    /* ADDED BY Marco Nijdam */
    { "dst",	tDST,	  HOUR( 0) },	    /* DST on (hour is ignored) */
    /* End ADDED */
    { NULL, 0, 0 }
};

/*
 * Military timezone table.
 */

static const TABLE MilitaryTable[] = {
    { "a",	tZONE,	-HOUR( 1) + HOUR(100) },
    { "b",	tZONE,	-HOUR( 2) + HOUR(100) },
    { "c",	tZONE,	-HOUR( 3) + HOUR(100) },
    { "d",	tZONE,	-HOUR( 4) + HOUR(100) },
    { "e",	tZONE,	-HOUR( 5) + HOUR(100) },
    { "f",	tZONE,	-HOUR( 6) + HOUR(100) },
    { "g",	tZONE,	-HOUR( 7) + HOUR(100) },
    { "h",	tZONE,	-HOUR( 8) + HOUR(100) },
    { "i",	tZONE,	-HOUR( 9) + HOUR(100) },
    { "k",	tZONE,	-HOUR(10) + HOUR(100) },
    { "l",	tZONE,	-HOUR(11) + HOUR(100) },
    { "m",	tZONE,	-HOUR(12) + HOUR(100) },
    { "n",	tZONE,	HOUR(  1) + HOUR(100) },
    { "o",	tZONE,	HOUR(  2) + HOUR(100) },
    { "p",	tZONE,	HOUR(  3) + HOUR(100) },
    { "q",	tZONE,	HOUR(  4) + HOUR(100) },
    { "r",	tZONE,	HOUR(  5) + HOUR(100) },
    { "s",	tZONE,	HOUR(  6) + HOUR(100) },
    { "t",	tZONE,	HOUR(  7) + HOUR(100) },
    { "u",	tZONE,	HOUR(  8) + HOUR(100) },
    { "v",	tZONE,	HOUR(  9) + HOUR(100) },
    { "w",	tZONE,	HOUR( 10) + HOUR(100) },
    { "x",	tZONE,	HOUR( 11) + HOUR(100) },
    { "y",	tZONE,	HOUR( 12) + HOUR(100) },
    { "z",	tZONE,	HOUR( 0)  + HOUR(100) },
    { NULL, 0, 0 }
};

/*
 * Dump error messages in the bit bucket.
 */

static void
TclDateerror(
    YYLTYPE* location,
    DateInfo* infoPtr,
    const char *s)
{
    Tcl_Obj* t;
    Tcl_AppendToObj(infoPtr->messages, infoPtr->separatrix, -1);
    Tcl_AppendToObj(infoPtr->messages, s, -1);
    Tcl_AppendToObj(infoPtr->messages, " (characters ", -1);
    TclNewIntObj(t, location->first_column);
    Tcl_IncrRefCount(t);
    Tcl_AppendObjToObj(infoPtr->messages, t);
    Tcl_DecrRefCount(t);
    Tcl_AppendToObj(infoPtr->messages, "-", -1);
    TclNewIntObj(t, location->last_column);
    Tcl_IncrRefCount(t);
    Tcl_AppendObjToObj(infoPtr->messages, t);
    Tcl_DecrRefCount(t);
    Tcl_AppendToObj(infoPtr->messages, ")", -1);
    infoPtr->separatrix = "\n";
}

static time_t
ToSeconds(
    time_t Hours,
    time_t Minutes,
    time_t Seconds,
    MERIDIAN Meridian)
{
    if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59) {
	return -1;
    }
    switch (Meridian) {
    case MER24:
	if (Hours < 0 || Hours > 23) {
	    return -1;
	}
	return (Hours * 60L + Minutes) * 60L + Seconds;
    case MERam:
	if (Hours < 1 || Hours > 12) {
	    return -1;
	}
	return ((Hours % 12) * 60L + Minutes) * 60L + Seconds;
    case MERpm:
	if (Hours < 1 || Hours > 12) {
	    return -1;
	}
	return (((Hours % 12) + 12) * 60L + Minutes) * 60L + Seconds;
    }
    return -1;			/* Should never be reached */
}

static int
LookupWord(
    YYSTYPE* yylvalPtr,
    char *buff)
{
    char *p;
    char *q;
    const TABLE *tp;
    int i, abbrev;

    /*
     * Make it lowercase.
     */

    Tcl_UtfToLower(buff);

    if (strcmp(buff, "am") == 0 || strcmp(buff, "a.m.") == 0) {
	yylvalPtr->Meridian = MERam;
	return tMERIDIAN;
    }
    if (strcmp(buff, "pm") == 0 || strcmp(buff, "p.m.") == 0) {
	yylvalPtr->Meridian = MERpm;
	return tMERIDIAN;
    }

    /*
     * See if we have an abbreviation for a month.
     */

    if (strlen(buff) == 3) {
	abbrev = 1;
    } else if (strlen(buff) == 4 && buff[3] == '.') {
	abbrev = 1;
	buff[3] = '\0';
    } else {
	abbrev = 0;
    }

    for (tp = MonthDayTable; tp->name; tp++) {
	if (abbrev) {
	    if (strncmp(buff, tp->name, 3) == 0) {
		yylvalPtr->Number = tp->value;
		return tp->type;
	    }
	} else if (strcmp(buff, tp->name) == 0) {
	    yylvalPtr->Number = tp->value;
	    return tp->type;
	}
    }

    for (tp = TimezoneTable; tp->name; tp++) {
	if (strcmp(buff, tp->name) == 0) {
	    yylvalPtr->Number = tp->value;
	    return tp->type;
	}
    }

    for (tp = UnitsTable; tp->name; tp++) {
	if (strcmp(buff, tp->name) == 0) {
	    yylvalPtr->Number = tp->value;
	    return tp->type;
	}
    }

    /*
     * Strip off any plural and try the units table again.
     */

    i = strlen(buff) - 1;
    if (i > 0 && buff[i] == 's') {
	buff[i] = '\0';
	for (tp = UnitsTable; tp->name; tp++) {
	    if (strcmp(buff, tp->name) == 0) {
		yylvalPtr->Number = tp->value;
		return tp->type;
	    }
	}
    }

    for (tp = OtherTable; tp->name; tp++) {
	if (strcmp(buff, tp->name) == 0) {
	    yylvalPtr->Number = tp->value;
	    return tp->type;
	}
    }

    /*
     * Military timezones.
     */

    if (buff[1] == '\0' && !(*buff & 0x80)
	    && isalpha(UCHAR(*buff))) {			/* INTL: ISO only */
	for (tp = MilitaryTable; tp->name; tp++) {
	    if (strcmp(buff, tp->name) == 0) {
		yylvalPtr->Number = tp->value;
		return tp->type;
	    }
	}
    }

    /*
     * Drop out any periods and try the timezone table again.
     */

    for (i = 0, p = q = buff; *q; q++) {
	if (*q != '.') {
	    *p++ = *q;
	} else {
	    i++;
	}
    }
    *p = '\0';
    if (i) {
	for (tp = TimezoneTable; tp->name; tp++) {
	    if (strcmp(buff, tp->name) == 0) {
		yylvalPtr->Number = tp->value;
		return tp->type;
	    }
	}
    }

    return tID;
}

static int
TclDatelex(
    YYSTYPE* yylvalPtr,
    YYLTYPE* location,
    DateInfo *info)
{
    char c;
    char *p;
    char buff[20];
    int Count;

    location->first_column = yyInput - info->dateStart;
    for ( ; ; ) {
	while (TclIsSpaceProcM(*yyInput)) {
	    yyInput++;
	}

	if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */
	    /*
	     * Convert the string into a number; count the number of digits.
	     */

	    Count = 0;
	    for (yylvalPtr->Number = 0;
		    isdigit(UCHAR(c = *yyInput++)); ) {	  /* INTL: digit */
		yylvalPtr->Number = 10 * yylvalPtr->Number + c - '0';
		Count++;
	    }
	    yyInput--;
	    yyDigitCount = Count;

	    /*
	     * A number with 6 or more digits is considered an ISO 8601 base.
	     */

	    if (Count >= 6) {
		location->last_column = yyInput - info->dateStart - 1;
		return tISOBASE;
	    } else {
		location->last_column = yyInput - info->dateStart - 1;
		return tUNUMBER;
	    }
	}
	if (!(c & 0x80) && isalpha(UCHAR(c))) {		  /* INTL: ISO only. */
	    for (p = buff; isalpha(UCHAR(c = *yyInput++)) /* INTL: ISO only. */
		     || c == '.'; ) {
		if (p < &buff[sizeof buff - 1]) {
		    *p++ = c;
		}
	    }
	    *p = '\0';
	    yyInput--;
	    location->last_column = yyInput - info->dateStart - 1;
	    return LookupWord(yylvalPtr, buff);
	}
	if (c != '(') {
	    location->last_column = yyInput - info->dateStart;
	    return *yyInput++;
	}
	Count = 0;
	do {
	    c = *yyInput++;
	    if (c == '\0') {
		location->last_column = yyInput - info->dateStart - 1;
		return c;
	    } else if (c == '(') {
		Count++;
	    } else if (c == ')') {
		Count--;
	    }
	} while (Count > 0);
    }
}

int
TclClockOldscanObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Count of parameters */
    Tcl_Obj *const *objv)	/* Parameters */
{
    Tcl_Obj *result, *resultElement;
    int yr, mo, da;
    DateInfo dateInfo;
    DateInfo* info = &dateInfo;
    int status;

    if (objc != 5) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"stringToParse baseYear baseMonth baseDay" );
	return TCL_ERROR;
    }

    yyInput = TclGetString(objv[1]);
    dateInfo.dateStart = yyInput;

    yyHaveDate = 0;
    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;

    yyHaveTime = 0;
    yyHour = 0; yyMinutes = 0; yySeconds = 0; yyMeridian = MER24;

    yyHaveZone = 0;
    yyTimezone = 0; yyDSTmode = DSTmaybe;

    yyHaveOrdinalMonth = 0;
    yyMonthOrdinal = 0;

    yyHaveDay = 0;
    yyDayOrdinal = 0; yyDayNumber = 0;

    yyHaveRel = 0;
    yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL;

    TclNewObj(dateInfo.messages);
    dateInfo.separatrix = "";
    Tcl_IncrRefCount(dateInfo.messages);

    status = yyparse(&dateInfo);
    if (status == 1) {
	Tcl_SetObjResult(interp, dateInfo.messages);
	Tcl_DecrRefCount(dateInfo.messages);
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", (char *)NULL);
	return TCL_ERROR;
    } else if (status == 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1));
	Tcl_DecrRefCount(dateInfo.messages);
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)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(dateInfo.messages);
	Tcl_SetErrorCode(interp, "TCL", "BUG", (char *)NULL);
	return TCL_ERROR;
    }
    Tcl_DecrRefCount(dateInfo.messages);

    if (yyHaveDate > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one date in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL);
	return TCL_ERROR;
    }
    if (yyHaveTime > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one time of day in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL);
	return TCL_ERROR;
    }
    if (yyHaveZone > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one time zone in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL);
	return TCL_ERROR;
    }
    if (yyHaveDay > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one weekday in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL);
	return TCL_ERROR;
    }
    if (yyHaveOrdinalMonth > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one ordinal month in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL);
	return TCL_ERROR;
    }

    TclNewObj(result);
    TclNewObj(resultElement);
    if (yyHaveDate) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyYear));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyMonth));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyDay));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    if (yyHaveTime) {
	Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(
		ToSeconds(yyHour, yyMinutes, yySeconds, (MERIDIAN)yyMeridian)));
    } else {
	TclNewObj(resultElement);
	Tcl_ListObjAppendElement(interp, result, resultElement);
    }

    TclNewObj(resultElement);
    if (yyHaveZone) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(-yyTimezone));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(1 - yyDSTmode));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    TclNewObj(resultElement);
    if (yyHaveRel) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyRelMonth));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyRelDay));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyRelSeconds));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    TclNewObj(resultElement);
    if (yyHaveDay && !yyHaveDate) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyDayOrdinal));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyDayNumber));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    TclNewObj(resultElement);
    if (yyHaveOrdinalMonth) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyMonthOrdinal));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyMonth));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    Tcl_SetObjResult(interp, result);
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclDecls.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
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










+
+
+
+
+
+
+
+
+



















-
-

-
+







/*
 * tclDecls.h --
 *
 *	Declarations of functions in the platform independent public Tcl API.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

#ifndef _TCLDECLS
#define _TCLDECLS

#include <stddef.h> /* for size_t */

#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
#   define TCL_STORAGE_CLASS DLLEXPORT
#else
#   ifdef USE_TCL_STUBS
#      define TCL_STORAGE_CLASS
#   else
#      define TCL_STORAGE_CLASS DLLIMPORT
#   endif
#endif

#if !defined(BUILD_tcl)
# define TCL_DEPRECATED(msg) EXTERN TCL_DEPRECATED_API(msg)
#elif defined(TCL_NO_DEPRECATED)
# define TCL_DEPRECATED(msg) MODULE_SCOPE
#else
# define TCL_DEPRECATED(msg) EXTERN
# define TCL_DEPRECATED(msg) MODULE_SCOPE
#endif


/*
 * WARNING: This file is automatically generated by the tools/genStubs.tcl
 * script.  Any modifications to the function declarations below should be made
 * in the generic/tcl.decls script.
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
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







-
+
-








-
+
-
-
-




-
+
-
-







EXTERN int		Tcl_GetIntFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, int *intPtr);
/* 39 */
EXTERN int		Tcl_GetLongFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, long *longPtr);
/* 40 */
EXTERN const Tcl_ObjType * Tcl_GetObjType(const char *typeName);
/* 41 */
/* Slot 41 is reserved */
EXTERN char *		TclGetStringFromObj(Tcl_Obj *objPtr, void *lengthPtr);
/* 42 */
EXTERN void		Tcl_InvalidateStringRep(Tcl_Obj *objPtr);
/* 43 */
EXTERN int		Tcl_ListObjAppendList(Tcl_Interp *interp,
				Tcl_Obj *listPtr, Tcl_Obj *elemListPtr);
/* 44 */
EXTERN int		Tcl_ListObjAppendElement(Tcl_Interp *interp,
				Tcl_Obj *listPtr, Tcl_Obj *objPtr);
/* 45 */
/* Slot 45 is reserved */
EXTERN int		TclListObjGetElements(Tcl_Interp *interp,
				Tcl_Obj *listPtr, void *objcPtr,
				Tcl_Obj ***objvPtr);
/* 46 */
EXTERN int		Tcl_ListObjIndex(Tcl_Interp *interp,
				Tcl_Obj *listPtr, Tcl_Size index,
				Tcl_Obj **objPtrPtr);
/* 47 */
/* Slot 47 is reserved */
EXTERN int		TclListObjLength(Tcl_Interp *interp,
				Tcl_Obj *listPtr, void *lengthPtr);
/* 48 */
EXTERN int		Tcl_ListObjReplace(Tcl_Interp *interp,
				Tcl_Obj *listPtr, Tcl_Size first,
				Tcl_Size count, Tcl_Size objc,
				Tcl_Obj *const objv[]);
/* Slot 49 is reserved */
/* 50 */
1869
1870
1871
1872
1873
1874
1875














































































































1876
1877
1878
1879
1880
1881
1882
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/* 688 */
EXTERN Tcl_Obj *	Tcl_NewWideUIntObj(Tcl_WideUInt wideValue);
/* 689 */
EXTERN void		Tcl_SetWideUIntObj(Tcl_Obj *objPtr,
				Tcl_WideUInt uwideValue);
/* 690 */
EXTERN void		TclUnusedStubEntry(void);
/* 691 */
EXTERN Tcl_ObjInterface * Tcl_NewObjInterface(void);
/* 692 */
EXTERN Tcl_ObjType *	Tcl_NewObjType(void);
/* 693 */
EXTERN int		Tcl_ObjInterfaceSetVersion(Tcl_ObjInterface *oiPtr,
				int version);
/* 694 */
EXTERN int		Tcl_ObjTypeSetFreeInternalRepProc(Tcl_ObjType *otPtr,
				Tcl_FreeInternalRepProc *freeIntRepProc);
/* 695 */
EXTERN int		Tcl_ObjTypeSetDupInternalRepProc(Tcl_ObjType *otPtr,
				Tcl_DupInternalRepProc *dupIntRepProc);
/* 696 */
EXTERN int		Tcl_ObjTypeSetUpdateStringProc(Tcl_ObjType *otPtr,
				Tcl_UpdateStringProc *updateStringProc);
/* 697 */
EXTERN int		Tcl_ObjTypeSetSetFromAnyProc(Tcl_ObjType *otPtr,
				Tcl_SetFromAnyProc *setFromAnyProc);
/* 698 */
EXTERN int		Tcl_ObjTypeSetVersion(Tcl_ObjType *otPtr,
				int version);
/* 699 */
EXTERN int		Tcl_ObjInterfaceSetFnListAll(Tcl_ObjInterface *oiPtr,
				Tcl_ObjInterfaceListAllProc *fnPtr);
/* 700 */
EXTERN int		Tcl_ObjInterfaceSetFnListAppend(
				Tcl_ObjInterface *oiPtr,
				Tcl_ObjInterfaceListAppendProc *fnPtr);
/* 701 */
EXTERN int		Tcl_ObjInterfaceSetFnListAppendList(
				Tcl_ObjInterface *oiPtr,
				Tcl_ObjInterfaceListAppendlistProc fnPtr);
/* 702 */
EXTERN int		Tcl_ObjInterfaceSetFnListIndex(
				Tcl_ObjInterface *oiPtr,
				Tcl_ObjInterfaceListIndexProc fnPtr);
/* 703 */
EXTERN int		Tcl_ObjInterfaceSetFnListIndexEnd(
				Tcl_ObjInterface *oiPtr,
				Tcl_ObjInterfaceListIndexEndProc fnPtr);
/* 704 */
EXTERN int		Tcl_ObjInterfaceSetFnListIsSorted(
				Tcl_ObjInterface *oiPtr,
				Tcl_ObjInterfaceListIsSortedProc fnPtr);
/* 705 */
EXTERN int		Tcl_ObjInterfaceSetFnListLength(
				Tcl_ObjInterface *oiPtr,
				Tcl_ObjInterfaceListLengthProc fnPtr);
/* 706 */
EXTERN int		Tcl_ObjInterfaceSetFnListRange(
				Tcl_ObjInterface *oiPtr,
				Tcl_ObjInterfaceListRangeProc fnPtr);
/* 707 */
EXTERN int		Tcl_ObjInterfaceSetFnListRangeEnd(
				Tcl_ObjInterface *oiPtr,
				Tcl_ObjInterfaceListRangeEndProc fnPtr);
/* 708 */
EXTERN int		Tcl_ObjInterfaceSetFnListReplace(
				Tcl_ObjInterface *oiPtr,
				Tcl_ObjInterfaceListReplaceProc fnPtr);
/* 709 */
EXTERN int		Tcl_ObjInterfaceSetFnListReplaceList(
				Tcl_ObjInterface *oiPtr,
				Tcl_ObjInterfaceListReplaceListProc fnPtr);
/* 710 */
EXTERN int		Tcl_ObjInterfaceSetFnListReverse(
				Tcl_ObjInterface *objInterfacePtr,
				Tcl_ObjInterfaceListReverseProc fnPtr);
/* 711 */
EXTERN int		Tcl_ObjInterfaceSetFnListSet(Tcl_ObjInterface *oiPtr,
				Tcl_ObjInterfaceListSetProc fnPtr);
/* 712 */
EXTERN int		Tcl_ObjInterfaceSetFnListSetDeep(
				Tcl_ObjInterface *oiPtr,
				Tcl_ObjInterfaceListSetDeepProc fnPtr);
/* 713 */
EXTERN int		Tcl_ObjInterfaceSetFnStringIndex(
				Tcl_ObjInterface *oiPtr,
				Tcl_ObjInterfaceStringIndexProc fnPtr);
/* 714 */
EXTERN int		Tcl_ObjInterfaceSetFnStringIndexEnd(
				Tcl_ObjInterface *oiPtr,
				Tcl_ObjInterfaceStringIndexEndProc fnPtr);
/* 715 */
EXTERN int		Tcl_ObjInterfaceSetFnStringLength(
				Tcl_ObjInterface *oiPtr,
				Tcl_ObjInterfaceStringLengthProc fnPtr);
/* 716 */
EXTERN int		Tcl_ObjInterfaceSetFnStringRange(
				Tcl_ObjInterface *oiPtr,
				Tcl_ObjInterfaceStringRangeProc fnPtr);
/* 717 */
EXTERN int		Tcl_ObjInterfaceSetFnStringRangeEnd(
				Tcl_ObjInterface *oiPtr,
				Tcl_ObjInterfaceStringRangeEndProc fnPtr);
/* 718 */
EXTERN int		Tcl_ObjTypeSetInterface(Tcl_ObjType *objTypePtr,
				Tcl_ObjInterface *objInterfacePtr);
/* 719 */
EXTERN int		Tcl_ObjTypeSetName(Tcl_ObjType *objTypePtr,
				char *name);
/* 720 */
EXTERN int		Tcl_ObjInterfaceSetFnStringIsEmpty(
				Tcl_ObjInterface *oiPtr,
				Tcl_ObjInterfaceStringIsEmptyProc fnPtr);
/* 721 */
EXTERN int		Tcl_ObjInterfaceSetFnListContains(
				Tcl_ObjInterface *oiPtr,
				Tcl_ObjInterfaceListContainsProc fnPtr);

typedef struct {
    const struct TclPlatStubs *tclPlatStubs;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

1921
1922
1923
1924
1925
1926
1927
1928

1929
1930
1931
1932

1933
1934

1935
1936
1937
1938
1939
1940
1941
2032
2033
2034
2035
2036
2037
2038

2039
2040
2041
2042

2043
2044

2045
2046
2047
2048
2049
2050
2051
2052







-
+



-
+

-
+







    int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */
    int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */
    void (*reserved36)(void);
    int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */
    int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */
    int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */
    const Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */
    char * (*tclGetStringFromObj) (Tcl_Obj *objPtr, void *lengthPtr); /* 41 */
    void (*reserved41)(void);
    void (*tcl_InvalidateStringRep) (Tcl_Obj *objPtr); /* 42 */
    int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 43 */
    int (*tcl_ListObjAppendElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 44 */
    int (*tclListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, void *objcPtr, Tcl_Obj ***objvPtr); /* 45 */
    void (*reserved45)(void);
    int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size index, Tcl_Obj **objPtrPtr); /* 46 */
    int (*tclListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, void *lengthPtr); /* 47 */
    void (*reserved47)(void);
    int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size first, Tcl_Size count, Tcl_Size objc, Tcl_Obj *const objv[]); /* 48 */
    void (*reserved49)(void);
    Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, Tcl_Size numBytes); /* 50 */
    Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */
    void (*reserved52)(void);
    Tcl_Obj * (*tcl_NewListObj) (Tcl_Size objc, Tcl_Obj *const objv[]); /* 53 */
    void (*reserved54)(void);
2571
2572
2573
2574
2575
2576
2577































2578
2579
2580
2581
2582
2583
2584
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    int (*tcl_GetWideUIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 684 */
    Tcl_Obj * (*tcl_DStringToObj) (Tcl_DString *dsPtr); /* 685 */
    int (*tcl_UtfNcmp) (const char *s1, const char *s2, size_t n); /* 686 */
    int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, size_t n); /* 687 */
    Tcl_Obj * (*tcl_NewWideUIntObj) (Tcl_WideUInt wideValue); /* 688 */
    void (*tcl_SetWideUIntObj) (Tcl_Obj *objPtr, Tcl_WideUInt uwideValue); /* 689 */
    void (*tclUnusedStubEntry) (void); /* 690 */
    Tcl_ObjInterface * (*tcl_NewObjInterface) (void); /* 691 */
    Tcl_ObjType * (*tcl_NewObjType) (void); /* 692 */
    int (*tcl_ObjInterfaceSetVersion) (Tcl_ObjInterface *oiPtr, int version); /* 693 */
    int (*tcl_ObjTypeSetFreeInternalRepProc) (Tcl_ObjType *otPtr, Tcl_FreeInternalRepProc *freeIntRepProc); /* 694 */
    int (*tcl_ObjTypeSetDupInternalRepProc) (Tcl_ObjType *otPtr, Tcl_DupInternalRepProc *dupIntRepProc); /* 695 */
    int (*tcl_ObjTypeSetUpdateStringProc) (Tcl_ObjType *otPtr, Tcl_UpdateStringProc *updateStringProc); /* 696 */
    int (*tcl_ObjTypeSetSetFromAnyProc) (Tcl_ObjType *otPtr, Tcl_SetFromAnyProc *setFromAnyProc); /* 697 */
    int (*tcl_ObjTypeSetVersion) (Tcl_ObjType *otPtr, int version); /* 698 */
    int (*tcl_ObjInterfaceSetFnListAll) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListAllProc *fnPtr); /* 699 */
    int (*tcl_ObjInterfaceSetFnListAppend) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListAppendProc *fnPtr); /* 700 */
    int (*tcl_ObjInterfaceSetFnListAppendList) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListAppendlistProc fnPtr); /* 701 */
    int (*tcl_ObjInterfaceSetFnListIndex) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListIndexProc fnPtr); /* 702 */
    int (*tcl_ObjInterfaceSetFnListIndexEnd) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListIndexEndProc fnPtr); /* 703 */
    int (*tcl_ObjInterfaceSetFnListIsSorted) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListIsSortedProc fnPtr); /* 704 */
    int (*tcl_ObjInterfaceSetFnListLength) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListLengthProc fnPtr); /* 705 */
    int (*tcl_ObjInterfaceSetFnListRange) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListRangeProc fnPtr); /* 706 */
    int (*tcl_ObjInterfaceSetFnListRangeEnd) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListRangeEndProc fnPtr); /* 707 */
    int (*tcl_ObjInterfaceSetFnListReplace) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListReplaceProc fnPtr); /* 708 */
    int (*tcl_ObjInterfaceSetFnListReplaceList) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListReplaceListProc fnPtr); /* 709 */
    int (*tcl_ObjInterfaceSetFnListReverse) (Tcl_ObjInterface *objInterfacePtr, Tcl_ObjInterfaceListReverseProc fnPtr); /* 710 */
    int (*tcl_ObjInterfaceSetFnListSet) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListSetProc fnPtr); /* 711 */
    int (*tcl_ObjInterfaceSetFnListSetDeep) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListSetDeepProc fnPtr); /* 712 */
    int (*tcl_ObjInterfaceSetFnStringIndex) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceStringIndexProc fnPtr); /* 713 */
    int (*tcl_ObjInterfaceSetFnStringIndexEnd) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceStringIndexEndProc fnPtr); /* 714 */
    int (*tcl_ObjInterfaceSetFnStringLength) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceStringLengthProc fnPtr); /* 715 */
    int (*tcl_ObjInterfaceSetFnStringRange) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceStringRangeProc fnPtr); /* 716 */
    int (*tcl_ObjInterfaceSetFnStringRangeEnd) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceStringRangeEndProc fnPtr); /* 717 */
    int (*tcl_ObjTypeSetInterface) (Tcl_ObjType *objTypePtr, Tcl_ObjInterface *objInterfacePtr); /* 718 */
    int (*tcl_ObjTypeSetName) (Tcl_ObjType *objTypePtr, char *name); /* 719 */
    int (*tcl_ObjInterfaceSetFnStringIsEmpty) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceStringIsEmptyProc fnPtr); /* 720 */
    int (*tcl_ObjInterfaceSetFnListContains) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListContainsProc fnPtr); /* 721 */
} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif
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
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







-
+
-






-
+
-


-
-
+







	(tclStubsPtr->tcl_GetInt) /* 37 */
#define Tcl_GetIntFromObj \
	(tclStubsPtr->tcl_GetIntFromObj) /* 38 */
#define Tcl_GetLongFromObj \
	(tclStubsPtr->tcl_GetLongFromObj) /* 39 */
#define Tcl_GetObjType \
	(tclStubsPtr->tcl_GetObjType) /* 40 */
#define TclGetStringFromObj \
/* Slot 41 is reserved */
	(tclStubsPtr->tclGetStringFromObj) /* 41 */
#define Tcl_InvalidateStringRep \
	(tclStubsPtr->tcl_InvalidateStringRep) /* 42 */
#define Tcl_ListObjAppendList \
	(tclStubsPtr->tcl_ListObjAppendList) /* 43 */
#define Tcl_ListObjAppendElement \
	(tclStubsPtr->tcl_ListObjAppendElement) /* 44 */
#define TclListObjGetElements \
/* Slot 45 is reserved */
	(tclStubsPtr->tclListObjGetElements) /* 45 */
#define Tcl_ListObjIndex \
	(tclStubsPtr->tcl_ListObjIndex) /* 46 */
#define TclListObjLength \
	(tclStubsPtr->tclListObjLength) /* 47 */
/* Slot 47 is reserved */
#define Tcl_ListObjReplace \
	(tclStubsPtr->tcl_ListObjReplace) /* 48 */
/* Slot 49 is reserved */
#define Tcl_NewByteArrayObj \
	(tclStubsPtr->tcl_NewByteArrayObj) /* 50 */
#define Tcl_NewDoubleObj \
	(tclStubsPtr->tcl_NewDoubleObj) /* 51 */
3904
3905
3906
3907
3908
3909
3910






























































3911
3912
3913
3914
3915
3916
3917
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
4111
4112
4113
4114
4115
4116
4117
4118







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	(tclStubsPtr->tcl_UtfNcasecmp) /* 687 */
#define Tcl_NewWideUIntObj \
	(tclStubsPtr->tcl_NewWideUIntObj) /* 688 */
#define Tcl_SetWideUIntObj \
	(tclStubsPtr->tcl_SetWideUIntObj) /* 689 */
#define TclUnusedStubEntry \
	(tclStubsPtr->tclUnusedStubEntry) /* 690 */
#define Tcl_NewObjInterface \
	(tclStubsPtr->tcl_NewObjInterface) /* 691 */
#define Tcl_NewObjType \
	(tclStubsPtr->tcl_NewObjType) /* 692 */
#define Tcl_ObjInterfaceSetVersion \
	(tclStubsPtr->tcl_ObjInterfaceSetVersion) /* 693 */
#define Tcl_ObjTypeSetFreeInternalRepProc \
	(tclStubsPtr->tcl_ObjTypeSetFreeInternalRepProc) /* 694 */
#define Tcl_ObjTypeSetDupInternalRepProc \
	(tclStubsPtr->tcl_ObjTypeSetDupInternalRepProc) /* 695 */
#define Tcl_ObjTypeSetUpdateStringProc \
	(tclStubsPtr->tcl_ObjTypeSetUpdateStringProc) /* 696 */
#define Tcl_ObjTypeSetSetFromAnyProc \
	(tclStubsPtr->tcl_ObjTypeSetSetFromAnyProc) /* 697 */
#define Tcl_ObjTypeSetVersion \
	(tclStubsPtr->tcl_ObjTypeSetVersion) /* 698 */
#define Tcl_ObjInterfaceSetFnListAll \
	(tclStubsPtr->tcl_ObjInterfaceSetFnListAll) /* 699 */
#define Tcl_ObjInterfaceSetFnListAppend \
	(tclStubsPtr->tcl_ObjInterfaceSetFnListAppend) /* 700 */
#define Tcl_ObjInterfaceSetFnListAppendList \
	(tclStubsPtr->tcl_ObjInterfaceSetFnListAppendList) /* 701 */
#define Tcl_ObjInterfaceSetFnListIndex \
	(tclStubsPtr->tcl_ObjInterfaceSetFnListIndex) /* 702 */
#define Tcl_ObjInterfaceSetFnListIndexEnd \
	(tclStubsPtr->tcl_ObjInterfaceSetFnListIndexEnd) /* 703 */
#define Tcl_ObjInterfaceSetFnListIsSorted \
	(tclStubsPtr->tcl_ObjInterfaceSetFnListIsSorted) /* 704 */
#define Tcl_ObjInterfaceSetFnListLength \
	(tclStubsPtr->tcl_ObjInterfaceSetFnListLength) /* 705 */
#define Tcl_ObjInterfaceSetFnListRange \
	(tclStubsPtr->tcl_ObjInterfaceSetFnListRange) /* 706 */
#define Tcl_ObjInterfaceSetFnListRangeEnd \
	(tclStubsPtr->tcl_ObjInterfaceSetFnListRangeEnd) /* 707 */
#define Tcl_ObjInterfaceSetFnListReplace \
	(tclStubsPtr->tcl_ObjInterfaceSetFnListReplace) /* 708 */
#define Tcl_ObjInterfaceSetFnListReplaceList \
	(tclStubsPtr->tcl_ObjInterfaceSetFnListReplaceList) /* 709 */
#define Tcl_ObjInterfaceSetFnListReverse \
	(tclStubsPtr->tcl_ObjInterfaceSetFnListReverse) /* 710 */
#define Tcl_ObjInterfaceSetFnListSet \
	(tclStubsPtr->tcl_ObjInterfaceSetFnListSet) /* 711 */
#define Tcl_ObjInterfaceSetFnListSetDeep \
	(tclStubsPtr->tcl_ObjInterfaceSetFnListSetDeep) /* 712 */
#define Tcl_ObjInterfaceSetFnStringIndex \
	(tclStubsPtr->tcl_ObjInterfaceSetFnStringIndex) /* 713 */
#define Tcl_ObjInterfaceSetFnStringIndexEnd \
	(tclStubsPtr->tcl_ObjInterfaceSetFnStringIndexEnd) /* 714 */
#define Tcl_ObjInterfaceSetFnStringLength \
	(tclStubsPtr->tcl_ObjInterfaceSetFnStringLength) /* 715 */
#define Tcl_ObjInterfaceSetFnStringRange \
	(tclStubsPtr->tcl_ObjInterfaceSetFnStringRange) /* 716 */
#define Tcl_ObjInterfaceSetFnStringRangeEnd \
	(tclStubsPtr->tcl_ObjInterfaceSetFnStringRangeEnd) /* 717 */
#define Tcl_ObjTypeSetInterface \
	(tclStubsPtr->tcl_ObjTypeSetInterface) /* 718 */
#define Tcl_ObjTypeSetName \
	(tclStubsPtr->tcl_ObjTypeSetName) /* 719 */
#define Tcl_ObjInterfaceSetFnStringIsEmpty \
	(tclStubsPtr->tcl_ObjInterfaceSetFnStringIsEmpty) /* 720 */
#define Tcl_ObjInterfaceSetFnListContains \
	(tclStubsPtr->tcl_ObjInterfaceSetFnListContains) /* 721 */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#undef TclUnusedStubEntry

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
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







-
-
+

-
+

-
+



-

-
-
+
+
+
+


-
-
+
+
-

-
-
-
+
+
+
+
+
+




-
+
-
-
-
-
+
-
-
-
+







#define Tcl_GetString(objPtr) \
	Tcl_GetStringFromObj(objPtr, (Tcl_Size *)NULL)
#define Tcl_GetUnicode(objPtr) \
	Tcl_GetUnicodeFromObj(objPtr, (Tcl_Size *)NULL)
#undef Tcl_GetIndexFromObjStruct
#undef Tcl_GetBooleanFromObj
#undef Tcl_GetBoolean
#if !defined(TCLBOOLWARNING)
#if !defined(__cplusplus) && !defined(BUILD_tcl) && !defined(BUILD_tk) && defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 201112L)
#if !defined(__cplusplus) && !defined(BUILD_tcl) && !defined(BUILD_tk) && !defined(_MSC_VER)
#	define TCLBOOLWARNING(boolPtr) (void)(sizeof(struct {_Static_assert(sizeof(*(boolPtr)) <= sizeof(int), "sizeof(boolPtr) too large");int dummy;})),
#elif defined(__GNUC__) && !defined(__STRICT_ANSI__)
#elif defined(__GNUC__)
	/* If this gives: "error: size of array ‘_bool_Var’ is negative", it means that sizeof(*boolPtr)>sizeof(int), which is not allowed */
#   define TCLBOOLWARNING(boolPtr) ({__attribute__((unused)) char _bool_Var[sizeof(*(boolPtr)) <= sizeof(int) ? 1 : -1];}),
#   define TCLBOOLWARNING(boolPtr) ({__attribute__((unused)) char _bool_Var[sizeof(*(boolPtr)) > sizeof(int) ? -1 : 1];}),
#else
#   define TCLBOOLWARNING(boolPtr)
#endif
#endif /* !TCLBOOLWARNING */
#if defined(USE_TCL_STUBS)
#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \
	(tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), \
#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg,\
	flags, indexPtr) \
	(tclStubsPtr->tcl_GetIndexFromObjStruct(\
	    (interp), (objPtr), (tablePtr), (offset), (msg), \
		(flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr)))
#define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \
	((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \
	((sizeof(*(boolPtr)) <= sizeof(int)) ? Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)) : \
	(Tcl_GetBoolFromObj(interp, objPtr,\
	     (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
	(TCLBOOLWARNING(boolPtr)Tcl_Panic("sizeof(%s) must be <= sizeof(int)", & #boolPtr [1]),TCL_ERROR)))
#define Tcl_GetBoolean(interp, src, boolPtr) \
	((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \
	((sizeof(*(boolPtr)) <= sizeof(int)) ? Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)) : \
	(TCLBOOLWARNING(boolPtr)Tcl_Panic("sizeof(%s) must be <= sizeof(int)", & #boolPtr [1]),TCL_ERROR)))
	(Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof(\
	    (*(boolPtr))), (char *)(boolPtr)))
#undef Tcl_GetByteArrayFromObj
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
	(tclStubsPtr->tcl_GetBytesFromObj(\
	    NULL, objPtr, (Tcl_Size *)(void *)(sizePtr)))
#else
#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \
	((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), \
		(flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr)))
#define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \
#undef Tcl_GetByteArrayFromObj
	((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \
	((sizeof(*(boolPtr)) <= sizeof(int)) ? Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)) : \
	(TCLBOOLWARNING(boolPtr)Tcl_Panic("sizeof(%s) must be <= sizeof(int)", & #boolPtr [1]),TCL_ERROR)))
#define Tcl_GetBoolean(interp, src, boolPtr) \
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
	((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \
	((sizeof(*(boolPtr)) <= sizeof(int)) ? Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)) : \
	(TCLBOOLWARNING(boolPtr)Tcl_Panic("sizeof(%s) must be <= sizeof(int)", & #boolPtr [1]),TCL_ERROR)))
	(Tcl_GetBytesFromObj)(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr))
#endif

#ifdef TCL_MEM_DEBUG
#   undef Tcl_Alloc
#   define Tcl_Alloc(x) \
    (Tcl_DbCkalloc((x), __FILE__, __LINE__))
#   undef Tcl_Free
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
4288
4289
4290
4291
4292
4293
4294
































4295
4296
4297
4298
4299
4300
4301







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







#define Tcl_NewIntObj(value) Tcl_NewWideIntObj((int)(value))
#define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line)
#define Tcl_SetIntObj(objPtr, value)	Tcl_SetWideIntObj((objPtr), (int)(value))
#define Tcl_SetLongObj(objPtr, value)	Tcl_SetWideIntObj((objPtr), (long)(value))
#define Tcl_BackgroundError(interp)	Tcl_BackgroundException((interp), TCL_ERROR)
#define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0)

#if TCL_UTF_MAX < 4
#   undef Tcl_UniCharToUtfDString
#   define Tcl_UniCharToUtfDString Tcl_Char16ToUtfDString
#   undef Tcl_UtfToUniCharDString
#   define Tcl_UtfToUniCharDString Tcl_UtfToChar16DString
#   undef Tcl_UtfToUniChar
#   define Tcl_UtfToUniChar Tcl_UtfToChar16
#   undef Tcl_UniCharLen
#   define Tcl_UniCharLen Tcl_Char16Len
#   undef Tcl_UniCharToUtf
#   if defined(USE_TCL_STUBS)
#	define Tcl_UniCharToUtf(c, p) \
		(tclStubsPtr->tcl_UniCharToUtf((c)|TCL_COMBINE, (p)))
#   else
#	define Tcl_UniCharToUtf(c, p) \
		((Tcl_UniCharToUtf)((c)|TCL_COMBINE, (p)))
#   endif
#   undef Tcl_NumUtfChars
#   define Tcl_NumUtfChars TclNumUtfChars
#   undef Tcl_GetCharLength
#   define Tcl_GetCharLength TclGetCharLength
#   undef Tcl_UtfAtIndex
#   define Tcl_UtfAtIndex TclUtfAtIndex
#   undef Tcl_GetRange
#   define Tcl_GetRange TclGetRange
#   undef Tcl_GetUniChar
#   define Tcl_GetUniChar TclGetUniChar
#   undef Tcl_UtfNcmp
#   define Tcl_UtfNcmp TclUtfNcmp
#   undef Tcl_UtfNcasecmp
#   define Tcl_UtfNcasecmp TclUtfNcasecmp
#endif
#if defined(USE_TCL_STUBS)
#   define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \
		? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))tclStubsPtr->tcl_UniCharToUtfDString \
		: (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_Char16ToUtfDString)
#   define Tcl_UtfToWCharDString (sizeof(wchar_t) != sizeof(short) \
		? (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))tclStubsPtr->tcl_UtfToUniCharDString \
		: (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))Tcl_UtfToChar16DString)
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
4325
4326
4327
4328
4329
4330
4331



4332
4333

4334
4335
4336
4337































































































































































4338
4339







-
-
-
+
+
-




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


 */

#define Tcl_EvalObj(interp, objPtr) \
    Tcl_EvalObjEx(interp, objPtr, 0)
#define Tcl_GlobalEvalObj(interp, objPtr) \
    Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)

#if TCL_MAJOR_VERSION > 8
#   undef Tcl_Close
#   define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)
# undef Tcl_Close
# define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)
#endif

#undef TclUtfCharComplete
#undef TclUtfNext
#undef TclUtfPrev
#ifndef TCL_NO_DEPRECATED
#   define Tcl_CreateSlave Tcl_CreateChild
#   define Tcl_GetSlave Tcl_GetChild
#   define Tcl_GetMaster Tcl_GetParent
#endif

/* Protect those 11 functions, make them useless through the stub table */
#undef TclGetStringFromObj
#undef TclGetBytesFromObj
#undef TclGetUnicodeFromObj
#undef TclListObjGetElements
#undef TclListObjLength
#undef TclDictObjSize
#undef TclSplitList
#undef TclSplitPath
#undef TclFSSplitPath
#undef TclParseArgsObjv
#undef TclGetAliasObj

#if TCL_MAJOR_VERSION < 9
    /* TIP #627 for 8.7 */
#   undef Tcl_CreateObjCommand2
#   define Tcl_CreateObjCommand2 Tcl_CreateObjCommand
#   undef Tcl_CreateObjTrace2
#   define Tcl_CreateObjTrace2 Tcl_CreateObjTrace
#   undef Tcl_NRCreateCommand2
#   define Tcl_NRCreateCommand2 Tcl_NRCreateCommand
#   undef Tcl_NRCallObjProc2
#   define Tcl_NRCallObjProc2 Tcl_NRCallObjProc
    /* TIP #660 for 8.7 */
#   undef Tcl_GetSizeIntFromObj
#   define Tcl_GetSizeIntFromObj Tcl_GetIntFromObj

#   undef Tcl_GetBytesFromObj
#   define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \
	    tclStubsPtr->tclGetBytesFromObj((interp), (objPtr), (sizePtr))
#   undef Tcl_GetStringFromObj
#   define Tcl_GetStringFromObj(objPtr, sizePtr) \
	    tclStubsPtr->tclGetStringFromObj((objPtr), (sizePtr))
#   undef Tcl_GetUnicodeFromObj
#   define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
	    tclStubsPtr->tclGetUnicodeFromObj((objPtr), (sizePtr))
#   undef Tcl_ListObjGetElements
#   define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) \
	    tclStubsPtr->tclListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr))
#   undef Tcl_ListObjLength
#   define Tcl_ListObjLength(interp, listPtr, lengthPtr) \
	    tclStubsPtr->tclListObjLength((interp), (listPtr), (lengthPtr))
#   undef Tcl_DictObjSize
#   define Tcl_DictObjSize(interp, dictPtr, sizePtr) \
	    tclStubsPtr->tclDictObjSize((interp), (dictPtr), (sizePtr))
#   undef Tcl_SplitList
#   define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) \
	    tclStubsPtr->tclSplitList((interp), (listStr), (argcPtr), (argvPtr))
#   undef Tcl_SplitPath
#   define Tcl_SplitPath(path, argcPtr, argvPtr) \
	    tclStubsPtr->tclSplitPath((path), (argcPtr), (argvPtr))
#   undef Tcl_FSSplitPath
#   define Tcl_FSSplitPath(pathPtr, lenPtr) \
	    tclStubsPtr->tclFSSplitPath((pathPtr), (lenPtr))
#   undef Tcl_ParseArgsObjv
#   define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) \
	    tclStubsPtr->tclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv))
#   undef Tcl_GetAliasObj
#   define Tcl_GetAliasObj(interp, childCmd, targetInterpPtr, targetCmdPtr, objcPtr, objv) \
	    tclStubsPtr->tclGetAliasObj((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (objcPtr), (objv))
#elif defined(TCL_8_API)
#   undef Tcl_GetByteArrayFromObj
#   undef Tcl_GetBytesFromObj
#   undef Tcl_GetStringFromObj
#   undef Tcl_GetUnicodeFromObj
#   undef Tcl_ListObjGetElements
#   undef Tcl_ListObjLength
#   undef Tcl_DictObjSize
#   undef Tcl_SplitList
#   undef Tcl_SplitPath
#   undef Tcl_FSSplitPath
#   undef Tcl_ParseArgsObjv
#   undef Tcl_GetAliasObj
#   if !defined(USE_TCL_STUBS)
#	define Tcl_GetByteArrayFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \
		TclGetBytesFromObj(NULL, (objPtr), (sizePtr)) : \
		(Tcl_GetBytesFromObj)(NULL, (objPtr), (Tcl_Size *)(void *)(sizePtr)))
#	define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \
		TclGetBytesFromObj((interp), (objPtr), (sizePtr)) : \
		(Tcl_GetBytesFromObj)((interp), (objPtr), (Tcl_Size *)(void *)(sizePtr)))
#	define Tcl_GetStringFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \
		(TclGetStringFromObj)((objPtr), (sizePtr)) : \
		(Tcl_GetStringFromObj)((objPtr), (Tcl_Size *)(void *)(sizePtr)))
#	define Tcl_GetUnicodeFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \
		TclGetUnicodeFromObj((objPtr), (sizePtr)) : \
		(Tcl_GetUnicodeFromObj)((objPtr), (Tcl_Size *)(void *)(sizePtr)))
#	define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) <= sizeof(int) ? \
		(TclListObjGetElements)((interp), (listPtr), (objcPtr), (objvPtr)) : \
		(Tcl_ListObjGetElements)((interp), (listPtr), (Tcl_Size *)(void *)(objcPtr), (objvPtr)))
#	define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) <= sizeof(int) ? \
		(TclListObjLength)((interp), (listPtr), (lengthPtr)) : \
		(Tcl_ListObjLength)((interp), (listPtr), (Tcl_Size *)(void *)(lengthPtr)))
#	define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \
		TclDictObjSize((interp), (dictPtr), (sizePtr)) : \
		(Tcl_DictObjSize)((interp), (dictPtr), (Tcl_Size *)(void *)(sizePtr)))
#	define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) <= sizeof(int) ? \
		TclSplitList((interp), (listStr), (argcPtr), (argvPtr)) : \
		(Tcl_SplitList)((interp), (listStr), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
#	define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) <= sizeof(int) ? \
		TclSplitPath((path), (argcPtr), (argvPtr)) : \
		(Tcl_SplitPath)((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
#	define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) <= sizeof(int) ? \
		TclFSSplitPath((pathPtr), (lenPtr)) : \
		(Tcl_FSSplitPath)((pathPtr), (Tcl_Size *)(void *)(lenPtr)))
#	define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) <= sizeof(int) ? \
		TclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) : \
		(Tcl_ParseArgsObjv)((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv)))
#	define Tcl_GetAliasObj(interp, childCmd, targetInterpPtr, targetCmdPtr, objcPtr, objv) (sizeof(*(objcPtr)) <= sizeof(int) ? \
		TclGetAliasObj((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (objcPtr), (objv)) : \
		(Tcl_GetAliasObj)((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (Tcl_Size *)(void *)(objcPtr), (objv)))
#   elif !defined(BUILD_tcl)
#	define Tcl_GetByteArrayFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \
		tclStubsPtr->tclGetBytesFromObj(NULL, (objPtr), (sizePtr)) : \
		tclStubsPtr->tcl_GetBytesFromObj(NULL, (objPtr), (Tcl_Size *)(void *)(sizePtr)))
#	define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \
		tclStubsPtr->tclGetBytesFromObj((interp), (objPtr), (sizePtr)) : \
		tclStubsPtr->tcl_GetBytesFromObj((interp), (objPtr), (Tcl_Size *)(void *)(sizePtr)))
#	define Tcl_GetStringFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \
		tclStubsPtr->tclGetStringFromObj((objPtr), (sizePtr)) : \
		tclStubsPtr->tcl_GetStringFromObj((objPtr), (Tcl_Size *)(void *)(sizePtr)))
#	define Tcl_GetUnicodeFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \
		tclStubsPtr->tclGetUnicodeFromObj((objPtr), (sizePtr)) : \
		tclStubsPtr->tcl_GetUnicodeFromObj((objPtr), (Tcl_Size *)(void *)(sizePtr)))
#	define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) <= sizeof(int) ? \
		tclStubsPtr->tclListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr)) : \
		tclStubsPtr->tcl_ListObjGetElements((interp), (listPtr), (Tcl_Size *)(void *)(objcPtr), (objvPtr)))
#	define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) <= sizeof(int) ? \
		tclStubsPtr->tclListObjLength((interp), (listPtr), (lengthPtr)) : \
		tclStubsPtr->tcl_ListObjLength((interp), (listPtr), (Tcl_Size *)(void *)(lengthPtr)))
#	define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \
		tclStubsPtr->tclDictObjSize((interp), (dictPtr), (sizePtr)) : \
		tclStubsPtr->tcl_DictObjSize((interp), (dictPtr), (Tcl_Size *)(void *)(sizePtr)))
#	define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) <= sizeof(int) ? \
		tclStubsPtr->tclSplitList((interp), (listStr), (argcPtr), (argvPtr)) : \
		tclStubsPtr->tcl_SplitList((interp), (listStr), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
#	define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) <= sizeof(int) ? \
		tclStubsPtr->tclSplitPath((path), (argcPtr), (argvPtr)) : \
		tclStubsPtr->tcl_SplitPath((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
#	define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) <= sizeof(int) ? \
		tclStubsPtr->tclFSSplitPath((pathPtr), (lenPtr)) : \
		tclStubsPtr->tcl_FSSplitPath((pathPtr), (Tcl_Size *)(void *)(lenPtr)))
#	define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) <= sizeof(int) ? \
		tclStubsPtr->tclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) : \
		tclStubsPtr->tcl_ParseArgsObjv((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv)))
#	define Tcl_GetAliasObj(interp, childCmd, targetInterpPtr, targetCmdPtr, objcPtr, objv) (sizeof(*(objcPtr)) <= sizeof(int) ? \
		tclStubsPtr->tclGetAliasObj((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (objcPtr), (objv)) : \
		tclStubsPtr->tcl_GetAliasObj((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (Tcl_Size *)(void *)(objcPtr), (objv)))
#   endif /* defined(USE_TCL_STUBS) */
#else /* !defined(TCL_8_API) */
#   undef Tcl_GetByteArrayFromObj
#   define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
	   Tcl_GetBytesFromObj(NULL, (objPtr), (sizePtr))
#endif /* defined(TCL_8_API) */

#endif /* _TCLDECLS */
Changes to generic/tclDictObj.c.
1
2
3
4
5
6
7
8
9
10
11
12


















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclDictObj.c --
 *
 *	This file contains functions that implement the Tcl dict object type
 *	and its accessor command.
 *
 * Copyright © 2002-2010 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * Copyright © 2024 Nathan Coulter.
 *
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclDictObj.c --
 *
 *	This file contains functions that implement the Tcl dict object type
 *	and its accessor command.
 */

#include "tclInt.h"
#include "tclTomMath.h"
#include <assert.h>

/*
 * Forward declaration.
 */
58
59
60
61
62
63
64



65
66
67
68
69
70
71
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87







+
+
+







static Tcl_NRPostProc		FinalizeDictUpdate;
static Tcl_NRPostProc		FinalizeDictWith;
static Tcl_ObjCmdProc		DictForNRCmd;
static Tcl_ObjCmdProc		DictMapNRCmd;
static Tcl_NRPostProc		DictForLoopCallback;
static Tcl_NRPostProc		DictMapLoopCallback;

static Tcl_ObjInterfaceListLengthProc	DictAsListLength;
/* static Tcl_ObjInterfaceListIndexProc     DictAsListIndex; */

/*
 * Table of dict subcommand names and implementations.
 */

static const EnsembleImplMap implementationMap[] = {
    {"append",	DictAppendCmd,	TclCompileDictAppendCmd, NULL, NULL, 0 },
    {"create",	DictCreateCmd,	TclCompileDictCreateCmd, NULL, NULL, 0 },
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
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







+
+










-
+
+
+
+
+
+





+
-
+


+
+
-
+




-
+





-
+















-
+







				 * created. */
    ChainEntry *entryChainTail;	/* Other end of linked list of all entries in
				 * the dictionary. Used for doing traversal of
				 * the entries in the order that they are
				 * created. */
    size_t epoch;		/* Epoch counter */
    size_t refCount;		/* Reference counter (see above) */
    int dupedKeys;		/* Whether there are duplicate keys in the
				 *  dictionary */
    Tcl_Obj *chain;		/* Linked list used for invalidating the
				 * string representations of updated nested
				 * dictionaries. */
} Dict;

/*
 * The structure below defines the dictionary object type by means of
 * functions that can be invoked by generic object code.
 */

const Tcl_ObjType tclDictType = {

ObjInterface dictObjInterface;



static ObjectType tclDictObjectType = {
    "dict",
    FreeDictInternalRep,	/* freeIntRepProc */
    DupDictInternalRep,		/* dupIntRepProc */
    UpdateStringOfDict,		/* updateStringProc */
    SetDictFromAny,		/* setFromAnyProc */
    2,
    TCL_OBJTYPE_V0
    NULL
};

Tcl_ObjType *tclDictTypePtr = (Tcl_ObjType *)&tclDictObjectType;

#define DictSetInternalRep(objPtr, dictRepPtr)				\
#define DictSetInternalRep(objPtr, dictRepPtr)								\
    do {                                                                \
	Tcl_ObjInternalRep ir;						\
	ir.twoPtrValue.ptr1 = (dictRepPtr);                             \
	ir.twoPtrValue.ptr2 = NULL;                                     \
	Tcl_StoreInternalRep((objPtr), &tclDictType, &ir);		\
	Tcl_StoreInternalRep((objPtr), tclDictTypePtr, &ir);		\
    } while (0)

#define DictGetInternalRep(objPtr, dictRepPtr)				\
    do {                                                                \
	const Tcl_ObjInternalRep *irPtr;				\
	irPtr = TclFetchInternalRep((objPtr), &tclDictType);		\
	irPtr = TclFetchInternalRep((objPtr), tclDictTypePtr);		\
	(dictRepPtr) = irPtr ? (Dict *)irPtr->twoPtrValue.ptr1 : NULL;	\
    } while (0)

/*
 * The type of the specially adapted version of the Tcl_Obj*-containing hash
 * table defined in the tclObj.c code. This version differs in that it
 * allocates a bit more space in each hash entry in order to hold the pointers
 * used to keep the hash entries in a linked list.
 *
 * Note that this type of hash table is *only* suitable for direct use in
 * *this* file. Everything else should use the dict iterator API.
 */

static const Tcl_HashKeyType chainHashType = {
    TCL_HASH_KEY_TYPE_VERSION,
    TCL_HASH_KEY_DIRECT_COMPARE,        /* allows compare keys by pointers */
    TCL_HASH_KEY_DIRECT_COMPARE,	/* allows compare keys by pointers */
    TclHashObjKey,
    TclCompareObjKeys,
    AllocChainEntry,
    TclFreeObjEntry
};

/*
196
197
198
199
200
201
202









203
204
205
206
207
208
209
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244







+
+
+
+
+
+
+
+
+







				 * values assigned to it. */
    Tcl_DictSearch search;	/* The dictionary search structure. */
    Tcl_Obj *scriptObj;		/* The script to evaluate each time through
				 * the loop. */
    Tcl_Obj *accumulatorObj;	/* The dictionary used to accumulate the
				 * results. */
} DictMapStorage;


void TclDictInit(void) {
    Tcl_ObjInterface *oiPtr;
    oiPtr = Tcl_NewObjInterface();
    Tcl_ObjInterfaceSetFnListLength(oiPtr ,DictAsListLength);
    Tcl_ObjTypeSetInterface(tclDictTypePtr ,oiPtr);
    return;
}

/***** START OF FUNCTIONS IMPLEMENTING DICT CORE API *****/

/*
 *----------------------------------------------------------------------
 *
 * AllocChainEntry --
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
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







-
+



-
+













-
+





-
+







	/*
	 * Assume that cPtr is never NULL since we know the number of array
	 * elements already.
	 */

	flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
	keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry);
	elem = TclGetStringFromObj(keyPtr, &length);
	elem = Tcl_GetStringFromObj(keyPtr, &length);
	bytesNeeded += TclScanElement(elem, length, flagPtr+i);
	flagPtr[i+1] = TCL_DONT_QUOTE_HASH;
	valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
	elem = TclGetStringFromObj(valuePtr, &length);
	elem = Tcl_GetStringFromObj(valuePtr, &length);
	bytesNeeded += TclScanElement(elem, length, flagPtr+i+1);
    }
    bytesNeeded += numElems;

    /*
     * Pass 2: copy into string rep buffer.
     */

    dst = Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);
    TclOOM(dst, bytesNeeded);
    for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
	flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
	keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry);
	elem = TclGetStringFromObj(keyPtr, &length);
	elem = Tcl_GetStringFromObj(keyPtr, &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
	*dst++ = ' ';

	flagPtr[i+1] |= TCL_DONT_QUOTE_HASH;
	valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
	elem = TclGetStringFromObj(valuePtr, &length);
	elem = Tcl_GetStringFromObj(valuePtr, &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i+1]);
	*dst++ = ' ';
    }
    /* Last space overwrote the terminating NUL; cal T_ISR again to restore */
    (void)Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);

    if (flagPtr != localFlags) {
591
592
593
594
595
596
597

598
599
600
601
602
603
604
605
606

607
608
609
610
611
612
613
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641

642
643
644
645
646
647
648
649







+








-
+







    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
{
    Tcl_HashEntry *hPtr;
    int isNew;
    Dict *dict = (Dict *)Tcl_Alloc(sizeof(Dict));

    dict->dupedKeys = 0;
    InitChainTable(dict);

    /*
     * Since lists and dictionaries have very closely-related string
     * representations (i.e. the same parsing code) we can safely special-case
     * the conversion from lists to dictionaries.
     */

    if (TclHasInternalRep(objPtr, &tclListType)) {
    if (TclHasInternalRep(objPtr, tclListTypePtr)) {
	Tcl_Size objc, i;
	Tcl_Obj **objv;

	/* Cannot fail, we already know the Tcl_ObjType is "list". */
	TclListObjGetElements(NULL, objPtr, &objc, &objv);
	if (objc & 1) {
	    goto missingValue;
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
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







-

+








-
+







		Tcl_Obj *discardedValue = (Tcl_Obj *)Tcl_GetHashValue(hPtr);

		/*
		 * Not really a well-formed dictionary as there are duplicate
		 * keys, so better get the string rep here so that we can
		 * convert back.
		 */

		(void) TclGetString(objPtr);
		dict->dupedKeys = 1;

		TclDecrRefCount(discardedValue);
	    }
	    Tcl_SetHashValue(hPtr, objv[i+1]);
	    Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */
	}
    } else {
	Tcl_Size length;
	const char *nextElem = TclGetStringFromObj(objPtr, &length);
	const char *nextElem = Tcl_GetStringFromObj(objPtr, &length);
	const char *limit = (nextElem + length);

	while (nextElem < limit) {
	    Tcl_Obj *keyPtr, *valuePtr;
	    const char *elemStart;
	    Tcl_Size elemSize;
	    int literal;
690
691
692
693
694
695
696

697
698
699
700
701
702
703
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740







+







	    }

	    /* Store key and value in the hash table we're building. */
	    hPtr = CreateChainEntry(dict, keyPtr, &isNew);
	    if (!isNew) {
		Tcl_Obj *discardedValue = (Tcl_Obj *)Tcl_GetHashValue(hPtr);

		dict->dupedKeys = 1;
		TclDecrRefCount(keyPtr);
		TclDecrRefCount(discardedValue);
	    }
	    Tcl_SetHashValue(hPtr, valuePtr);
	    Tcl_IncrRefCount(valuePtr); /* since hash now holds ref to it */
	}
    }
738
739
740
741
742
743
744
























































745
746
747
748
749
750
751
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	if (SetDictFromAny(interp, dictPtr) != TCL_OK) {
	    return NULL;
	}
	DictGetInternalRep(dictPtr, dict);
    }
    return dict;
}


/*
 *----------------------------------------------------------------------
 *
 * TclDictObjSmartRef --
 *
 *	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 *
TclDictObjSmartRef(
    Tcl_Interp *interp,
    Tcl_Obj    *dictPtr)
{
    Tcl_Obj *result;
    Dict    *dict;

    if (!TclHasInternalRep(dictPtr, tclDictTypePtr)
	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
	return NULL;
    }

    DictGetInternalRep(dictPtr, dict);

    result = Tcl_NewObj();
    DictSetInternalRep(result, dict);
    dict->refCount++;
    result->internalRep.twoPtrValue.ptr2 = NULL;
    result->typePtr = tclDictTypePtr;

    return result;
}


/*
 *----------------------------------------------------------------------
 *
 * TclTraceDictPath --
 *
 *	Trace through a tree of dictionaries using the array of keys given. If
1261
1262
1263
1264
1265
1266
1267
1268

1269
1270
1271
1272
1273
1274
1275
1354
1355
1356
1357
1358
1359
1360

1361
1362
1363
1364
1365
1366
1367
1368







-
+







 *	Removes a reference to the dictionary's internal rep.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DictObjDone(
    Tcl_DictSearch *searchPtr)		/* Pointer to a hash search context. */
    Tcl_DictSearch *searchPtr)	/* Pointer to a hash search context. */
{
    Dict *dict;

    if (searchPtr->epoch) {
	searchPtr->epoch = 0;
	dict = (Dict *) searchPtr->dictionaryPtr;
	if (dict->refCount-- <= 1) {
1313
1314
1315
1316
1317
1318
1319
1320

1321
1322
1323
1324
1325
1326
1327
1406
1407
1408
1409
1410
1411
1412

1413
1414
1415
1416
1417
1418
1419
1420







-
+







    if (Tcl_IsShared(dictPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_DictObjPutKeyList");
    }
    if (keyc < 1) {
	Tcl_Panic("%s called with empty key list", "Tcl_DictObjPutKeyList");
    }

    dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_CREATE);
    dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1, keyv, DICT_PATH_CREATE);
    if (dictPtr == NULL) {
	return TCL_ERROR;
    }

    DictGetInternalRep(dictPtr, dict);
    assert(dict != NULL);
    hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew);
1371
1372
1373
1374
1375
1376
1377
1378

1379
1380
1381
1382
1383
1384
1385
1464
1465
1466
1467
1468
1469
1470

1471
1472
1473
1474
1475
1476
1477
1478







-
+







    if (Tcl_IsShared(dictPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_DictObjRemoveKeyList");
    }
    if (keyc < 1) {
	Tcl_Panic("%s called with empty key list", "Tcl_DictObjRemoveKeyList");
    }

    dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_UPDATE);
    dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1, keyv, DICT_PATH_UPDATE);
    if (dictPtr == NULL) {
	return TCL_ERROR;
    }

    DictGetInternalRep(dictPtr, dict);
    assert(dict != NULL);
    DeleteChainEntry(dict, keyv[keyc-1]);
1653
1654
1655
1656
1657
1658
1659
1660

1661
1662
1663
1664
1665
1666
1667
1746
1747
1748
1749
1750
1751
1752

1753
1754
1755
1756
1757
1758
1759
1760







-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictCreateCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictObj;
    int i;

1703
1704
1705
1706
1707
1708
1709
1710

1711
1712
1713
1714
1715
1716
1717
1796
1797
1798
1799
1800
1801
1802

1803
1804
1805
1806
1807
1808
1809
1810







-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictGetCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *valuePtr = NULL;
    int result;

1756
1757
1758
1759
1760
1761
1762
1763

1764
1765
1766
1767
1768
1769
1770
1849
1850
1851
1852
1853
1854
1855

1856
1857
1858
1859
1860
1861
1862
1863







-
+







     * Loop through the list of keys, looking up the key at the current index
     * in the current dictionary each time. Once we've done the lookup, we set
     * the current dictionary to be the value we looked up (in case the value
     * was not the last one and we are going through a chain of searches.)
     * Note that this loop always executes at least once.
     */

    dictPtr = TclTraceDictPath(interp, objv[1], objc-3,objv+2, DICT_PATH_READ);
    dictPtr = TclTraceDictPath(interp, objv[1], objc-3, objv+2, DICT_PATH_READ);
    if (dictPtr == NULL) {
	return TCL_ERROR;
    }
    result = Tcl_DictObjGet(interp, dictPtr, objv[objc-1], &valuePtr);
    if (result != TCL_OK) {
	return result;
    }
1796
1797
1798
1799
1800
1801
1802
1803

1804
1805
1806
1807
1808
1809
1810
1889
1890
1891
1892
1893
1894
1895

1896
1897
1898
1899
1900
1901
1902
1903







-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictGetDefCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *keyPtr, *valuePtr, *defaultPtr;
    Tcl_Obj *const *keyPath;
    int numKeys;
1861
1862
1863
1864
1865
1866
1867
1868

1869
1870
1871
1872
1873
1874
1875
1954
1955
1956
1957
1958
1959
1960

1961
1962
1963
1964
1965
1966
1967
1968







-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictReplaceCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr;
    int i;

1909
1910
1911
1912
1913
1914
1915
1916

1917
1918
1919
1920
1921
1922
1923
2002
2003
2004
2005
2006
2007
2008

2009
2010
2011
2012
2013
2014
2015
2016







-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictRemoveCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr;
    int i;

1957
1958
1959
1960
1961
1962
1963
1964

1965
1966
1967
1968
1969
1970
1971
2050
2051
2052
2053
2054
2055
2056

2057
2058
2059
2060
2061
2062
2063
2064







-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictMergeCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *targetObj, *keyObj = NULL, *valueObj = NULL;
    int allocatedDict = 0;
    int i, done;
2044
2045
2046
2047
2048
2049
2050
2051

2052
2053
2054
2055
2056
2057
2058
2137
2138
2139
2140
2141
2142
2143

2144
2145
2146
2147
2148
2149
2150
2151







-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictKeysCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *listPtr;
    const char *pattern = NULL;

2123
2124
2125
2126
2127
2128
2129
2130

2131
2132
2133
2134
2135
2136
2137
2216
2217
2218
2219
2220
2221
2222

2223
2224
2225
2226
2227
2228
2229
2230







-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictValuesCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *valuePtr = NULL, *listPtr;
    Tcl_DictSearch search;
    int done;
2149
2150
2151
2152
2153
2154
2155
2156

2157
2158
2159
2160
2161
2162
2163
2242
2243
2244
2245
2246
2247
2248

2249
2250
2251
2252
2253
2254
2255
2256







-
+







    if (objc == 3) {
	pattern = TclGetString(objv[2]);
    } else {
	pattern = NULL;
    }
    listPtr = Tcl_NewListObj(0, NULL);
    for (; !done ; Tcl_DictObjNext(&search, NULL, &valuePtr, &done)) {
	if (pattern==NULL || Tcl_StringMatch(TclGetString(valuePtr),pattern)) {
	if (pattern==NULL || Tcl_StringMatch(TclGetString(valuePtr), pattern)) {
	    /*
	     * Assume this operation always succeeds.
	     */

	    Tcl_ListObjAppendElement(interp, listPtr, valuePtr);
	}
    }
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
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







-
+





-
+









-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictSizeCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int result;
    Tcl_Size size;
	Tcl_Size size;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
	return TCL_ERROR;
    }
    result = Tcl_DictObjSize(interp, objv[1], &size);
    if (result == TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(size));
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclDictObjSmartRef --
 *
 *	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 *
TclDictObjSmartRef(
    Tcl_Interp *interp,
    Tcl_Obj    *dictPtr)
{
    Tcl_Obj *result;
    Dict    *dict;

    if (!TclHasInternalRep(dictPtr, &tclDictType)
	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
	return NULL;
    }

    DictGetInternalRep(dictPtr, dict);

    result = Tcl_NewObj();
    DictSetInternalRep(result, dict);
    dict->refCount++;
    result->internalRep.twoPtrValue.ptr2 = NULL;
    result->typePtr = &tclDictType;

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * DictExistsCmd --
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
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







-
+











-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictExistsCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *valuePtr;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary key ?key ...?");
	return TCL_ERROR;
    }

    dictPtr = TclTraceDictPath(NULL, objv[1], objc-3, objv+2,DICT_PATH_EXISTS);
    dictPtr = TclTraceDictPath(NULL, objv[1], objc-3, objv+2, DICT_PATH_EXISTS);
    if (dictPtr == NULL || dictPtr == DICT_PATH_NON_EXISTENT ||
	    Tcl_DictObjGet(NULL, dictPtr, objv[objc-1], &valuePtr) != TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
    } else {
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(valuePtr != NULL));
    }
    return TCL_OK;
2318
2319
2320
2321
2322
2323
2324
2325

2326
2327
2328
2329
2330
2331
2332
2357
2358
2359
2360
2361
2362
2363

2364
2365
2366
2367
2368
2369
2370
2371







-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictInfoCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Dict *dict;
    char *statsStr;

2362
2363
2364
2365
2366
2367
2368
2369

2370
2371
2372
2373
2374
2375
2376
2401
2402
2403
2404
2405
2406
2407

2408
2409
2410
2411
2412
2413
2414
2415







-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictIncrCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int code = TCL_OK;
    Tcl_Obj *dictPtr, *valuePtr = NULL;

2483
2484
2485
2486
2487
2488
2489
2490

2491
2492
2493
2494
2495
2496
2497
2522
2523
2524
2525
2526
2527
2528

2529
2530
2531
2532
2533
2534
2535
2536







-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictLappendCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
    int i, allocatedDict = 0, allocatedValue = 0;

2570
2571
2572
2573
2574
2575
2576
2577

2578
2579
2580
2581
2582
2583
2584
2609
2610
2611
2612
2613
2614
2615

2616
2617
2618
2619
2620
2621
2622
2623







-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictAppendCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
    int allocatedDict = 0;

2672
2673
2674
2675
2676
2677
2678
2679

2680
2681
2682
2683
2684
2685
2686
2711
2712
2713
2714
2715
2716
2717

2718
2719
2720
2721
2722
2723
2724
2725







-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictForNRCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
    Tcl_Obj **varv, *keyObj, *valueObj;
2868
2869
2870
2871
2872
2873
2874
2875

2876
2877
2878
2879
2880
2881
2882
2907
2908
2909
2910
2911
2912
2913

2914
2915
2916
2917
2918
2919
2920
2921







-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictMapNRCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj **varv, *keyObj, *valueObj;
    DictMapStorage *storagePtr;
2953
2954
2955
2956
2957
2958
2959
2960

2961
2962
2963
2964
2965
2966
2967
2992
2993
2994
2995
2996
2997
2998

2999
3000
3001
3002
3003
3004
3005
3006







-
+







    }
    TclDecrRefCount(valueObj);

    /*
     * Run the script.
     */

    TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL);
    TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL, NULL, NULL);
    return TclNREvalObjEx(interp, storagePtr->scriptObj, 0,
	    iPtr->cmdFramePtr, 3);

    /*
     * For unwinding everything on error.
     */

3043
3044
3045
3046
3047
3048
3049
3050

3051
3052
3053
3054
3055
3056
3057
3082
3083
3084
3085
3086
3087
3088

3089
3090
3091
3092
3093
3094
3095
3096







-
+







    }
    TclDecrRefCount(valueObj);

    /*
     * Run the script.
     */

    TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL);
    TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL, NULL, NULL);
    return TclNREvalObjEx(interp, storagePtr->scriptObj, 0,
	    iPtr->cmdFramePtr, 3);

    /*
     * For unwinding everything once the iterating is done.
     */

3081
3082
3083
3084
3085
3086
3087
3088

3089
3090
3091
3092
3093
3094
3095
3120
3121
3122
3123
3124
3125
3126

3127
3128
3129
3130
3131
3132
3133
3134







-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictSetCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *resultPtr;
    int result, allocatedDict = 0;

3141
3142
3143
3144
3145
3146
3147
3148

3149
3150
3151
3152
3153
3154
3155
3180
3181
3182
3183
3184
3185
3186

3187
3188
3189
3190
3191
3192
3193
3194







-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictUnsetCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *resultPtr;
    int result, allocatedDict = 0;

3200
3201
3202
3203
3204
3205
3206
3207

3208
3209
3210
3211
3212
3213
3214
3239
3240
3241
3242
3243
3244
3245

3246
3247
3248
3249
3250
3251
3252
3253







-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictFilterCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    static const char *const filters[] = {
	"key", "script", "value", NULL
3224
3225
3226
3227
3228
3229
3230
3231

3232
3233
3234
3235
3236
3237
3238
3263
3264
3265
3266
3267
3268
3269

3270
3271
3272
3273
3274
3275
3276
3277







-
+







    const char *pattern;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary filterType ?arg ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[2], filters, "filterType",
	     0, &index) != TCL_OK) {
	    0, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    switch (index) {
    case FILTER_KEYS:
	/*
	 * Create a dictionary whose keys all match a certain pattern.
3486
3487
3488
3489
3490
3491
3492
3493

3494
3495
3496
3497
3498
3499
3500
3525
3526
3527
3528
3529
3530
3531

3532
3533
3534
3535
3536
3537
3538
3539







-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictUpdateCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *dictPtr, *objPtr;
    int i;
3534
3535
3536
3537
3538
3539
3540
3541

3542
3543
3544
3545
3546
3547
3548
3573
3574
3575
3576
3577
3578
3579

3580
3581
3582
3583
3584
3585
3586
3587







-
+







     * Execute the body after setting up the NRE handler to process the
     * results.
     */

    objPtr = Tcl_NewListObj(objc-3, objv+2);
    Tcl_IncrRefCount(objPtr);
    Tcl_IncrRefCount(objv[1]);
    TclNRAddCallback(interp, FinalizeDictUpdate, objv[1], objPtr, NULL,NULL);
    TclNRAddCallback(interp, FinalizeDictUpdate, objv[1], objPtr, NULL, NULL);

    return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
}

static int
FinalizeDictUpdate(
    void *data[],
3645
3646
3647
3648
3649
3650
3651
3652

3653
3654
3655
3656
3657
3658
3659
3684
3685
3686
3687
3688
3689
3690

3691
3692
3693
3694
3695
3696
3697
3698







-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictWithCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *dictPtr, *keysPtr, *pathPtr;

3985
3986
3987
3988
3989
3990
3991















































3992
3993
3994
3995
3996
3997
3998
3999
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









Tcl_Command
TclInitDictCmd(
    Tcl_Interp *interp)
{
    return TclMakeEnsemble(interp, "dict", implementationMap);
}

/*
 *----------------------------------------------------------------------
 *
 * DictAsListLength --
 *
 *   Compute the length of a list as if the dict value were converted to a
 *   list.
 *
 *   Note: the list length may not match the dict size * 2.  This occurs when
 *   there are duplicate keys in the original string representation.
 *
 * Side Effects --
 *
 *   The internal representation of objPtr might be converted to list.
 *
 */

static int
DictAsListLength(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    Tcl_Size *lenPtr)
{
    Tcl_Size length;
    int status;

    if (TclHasStringRep(objPtr)) {
	status = TclSetListFromAny(interp ,objPtr);
	if (status) {
	    /* This shouldn't be possible because any dict can be converted to
	     * a list*/
	    Tcl_Panic("%s {could not convert dictionary to list}"
		, "DictAsListLength");
	}
	status = Tcl_ListObjLength(interp ,objPtr ,lenPtr); 
	return status;
    } else {
	status = Tcl_DictObjSize(interp ,objPtr ,&length);
	if (status) {
	    return status;
	} else {
	    *lenPtr = length * 2;
	}
	return TCL_OK;
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclDisassemble.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14

















15
16
17
18
19
20
21
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

-
-
-
-
-








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclDisassemble.c --
 *
 *	This file contains procedures that disassemble bytecode into either
 *	human-readable or Tcl-processable forms.
 *
 * Copyright © 1996-1998 Sun Microsystems, Inc.
 * Copyright © 2001 Kevin B. Kenny. All rights reserved.
 * Copyright © 2013-2016 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */


/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclDisassemble.c --
 *
 *	This file contains procedures that disassemble bytecode into either
 *	human-readable or Tcl-processable forms.
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tclOOInt.h"
#include <assert.h>

/*
 * Prototypes for procedures defined later in this file:
38
39
40
41
42
43
44
45

46
47
48
49
50
51
52
50
51
52
53
54
55
56

57
58
59
60
61
62
63
64







-
+








static const Tcl_ObjType instNameType = {
    "instname",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    UpdateStringOfInstName,	/* updateStringProc */
    NULL,			/* setFromAnyProc */
    TCL_OBJTYPE_V0
	0
};

#define InstNameSetInternalRep(objPtr, inst) \
    do {								\
	Tcl_ObjInternalRep ir;						\
	ir.wideValue = (inst);						\
	Tcl_StoreInternalRep((objPtr), &instNameType, &ir);		\
196
197
198
199
200
201
202
203

204
205
206
207
208
209
210
208
209
210
211
212
213
214

215
216
217
218
219
220
221
222







-
+







    Tcl_Obj *objPtr,		/* Points to the Tcl object whose string
				 * representation should be printed. */
    Tcl_Size maxChars)		/* Maximum number of chars to print. */
{
    char *bytes;
    Tcl_Size length;

    bytes = TclGetStringFromObj(objPtr, &length);
    bytes = Tcl_GetStringFromObj(objPtr, &length);
    TclPrintSource(outFile, bytes, TclMin(length, maxChars));
}

/*
 *----------------------------------------------------------------------
 *
 * TclPrintSource --
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
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







-
+
+



-
+
+



-
+
+



-
+
+

-
+
+





-
+
+




-
+
+

-
+
+

-
+
+




-
+
+




-
+
+




-
+
+




-
+
+


















-
+
+






-
+
+








-
+
+













-
+







    AuxData *auxPtr = NULL;

    suffixBuffer[0] = '\0';
    Tcl_AppendPrintfToObj(bufferObj, "(%u) %s ", pcOffset, instDesc->name);
    for (i = 0;  i < instDesc->numOperands;  i++) {
	switch (instDesc->opTypes[i]) {
	case OPERAND_INT1:
	    opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++;
	    opnd = TclGetInt1AtPtr(pc+numBytes);
	    numBytes++;
	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
	    break;
	case OPERAND_INT4:
	    opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
	    opnd = TclGetInt4AtPtr(pc+numBytes);
	    numBytes += 4;
	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
	    break;
	case OPERAND_UINT1:
	    opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
	    opnd = TclGetUInt1AtPtr(pc+numBytes);
	    numBytes++;
	    Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd);
	    break;
	case OPERAND_UINT4:
	    opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
	    opnd = TclGetUInt4AtPtr(pc+numBytes);
	    numBytes += 4;
	    if (opCode == INST_START_CMD) {
		snprintf(suffixBuffer+strlen(suffixBuffer), sizeof(suffixBuffer) - strlen(suffixBuffer),
		snprintf(suffixBuffer+strlen(suffixBuffer),
			sizeof(suffixBuffer) - strlen(suffixBuffer),
			", %u cmds start here", opnd);
	    }
	    Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd);
	    break;
	case OPERAND_OFFSET1:
	    opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++;
	    opnd = TclGetInt1AtPtr(pc+numBytes);
	    numBytes++;
	    snprintf(suffixBuffer, sizeof(suffixBuffer), "pc %u", pcOffset+opnd);
	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
	    break;
	case OPERAND_OFFSET4:
	    opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
	    opnd = TclGetInt4AtPtr(pc+numBytes);
	    numBytes += 4;
	    if (opCode == INST_START_CMD) {
		snprintf(suffixBuffer, sizeof(suffixBuffer), "next cmd at pc %u", pcOffset+opnd);
		snprintf(suffixBuffer, sizeof(suffixBuffer),
			"next cmd at pc %u", pcOffset+opnd);
	    } else {
		snprintf(suffixBuffer, sizeof(suffixBuffer), "pc %u", pcOffset+opnd);
		snprintf(suffixBuffer, sizeof(suffixBuffer),
			"pc %u", pcOffset+opnd);
	    }
	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
	    break;
	case OPERAND_LIT1:
	    opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
	    opnd = TclGetUInt1AtPtr(pc+numBytes);
	    numBytes++;
	    suffixObj = codePtr->objArrayPtr[opnd];
	    Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd);
	    break;
	case OPERAND_LIT4:
	    opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
	    opnd = TclGetUInt4AtPtr(pc+numBytes);
	    numBytes += 4;
	    suffixObj = codePtr->objArrayPtr[opnd];
	    Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd);
	    break;
	case OPERAND_AUX4:
	    opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
	    opnd = TclGetUInt4AtPtr(pc+numBytes);
	    numBytes += 4;
	    Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd);
	    auxPtr = &codePtr->auxDataArrayPtr[opnd];
	    break;
	case OPERAND_IDX4:
	    opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
	    opnd = TclGetInt4AtPtr(pc+numBytes);
	    numBytes += 4;
	    if (opnd >= -1) {
		Tcl_AppendPrintfToObj(bufferObj, "%d ", opnd);
	    } else if (opnd == -2) {
		Tcl_AppendPrintfToObj(bufferObj, "end ");
	    } else {
		Tcl_AppendPrintfToObj(bufferObj, "end-%d ", -2-opnd);
	    }
	    break;
	case OPERAND_LVT1:
	    opnd = TclGetUInt1AtPtr(pc+numBytes);
	    numBytes++;
	    goto printLVTindex;
	case OPERAND_LVT4:
	    opnd = TclGetUInt4AtPtr(pc+numBytes);
	    numBytes += 4;
	printLVTindex:
	    if (localPtr != NULL) {
		if (opnd >= localCt) {
		    Tcl_Panic("FormatInstruction: bad local var index %u (%" TCL_SIZE_MODIFIER "d locals)",
		    Tcl_Panic("FormatInstruction: bad local var index %u (%"
			    TCL_SIZE_MODIFIER "d locals)",
			    opnd, localCt);
		}
		for (j = 0;  j < opnd;  j++) {
		    localPtr = localPtr->nextPtr;
		}
		if (TclIsVarTemporary(localPtr)) {
		    snprintf(suffixBuffer, sizeof(suffixBuffer), "temp var %u", opnd);
		    snprintf(suffixBuffer, sizeof(suffixBuffer),
			    "temp var %u", opnd);
		} else {
		    snprintf(suffixBuffer, sizeof(suffixBuffer), "var ");
		    suffixSrc = localPtr->name;
		}
	    }
	    Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", opnd);
	    break;
	case OPERAND_SCLS1:
	    opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
	    opnd = TclGetUInt1AtPtr(pc+numBytes);
	    numBytes++;
	    Tcl_AppendPrintfToObj(bufferObj, "%s ",
		    tclStringClassTable[opnd].name);
	    break;
	case OPERAND_NONE:
	default:
	    break;
	}
    }
    if (suffixObj) {
	const char *bytes;
	Tcl_Size length;

	Tcl_AppendToObj(bufferObj, "\t# ", -1);
	bytes = TclGetStringFromObj(codePtr->objArrayPtr[opnd], &length);
	bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length);
	PrintSourceToObj(bufferObj, bytes, TclMin(length, 40));
    } else if (suffixBuffer[0]) {
	Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer);
	if (suffixSrc) {
	    PrintSourceToObj(bufferObj, suffixSrc, 40);
	}
    }
826
827
828
829
830
831
832
833

834
835
836
837
838
839
840
854
855
856
857
858
859
860

861
862
863
864
865
866
867
868







-
+







 *----------------------------------------------------------------------
 */

static void
UpdateStringOfInstName(
    Tcl_Obj *objPtr)
{
    size_t inst;	/* NOTE: We know this is really an unsigned char */
    size_t inst;		/* NOTE: We know this is really an unsigned char */
    char *dst;

    InstNameGetInternalRep(objPtr, inst);

    if (inst >= LAST_INST_OPCODE) {
	dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 5);
	TclOOM(dst, TCL_INTEGER_SPACE + 5);
951
952
953
954
955
956
957
958

959
960
961
962
963
964
965
979
980
981
982
983
984
985

986
987
988
989
990
991
992
993







-
+







    ByteCodeGetInternalRep(objPtr, &tclByteCodeType, codePtr);

    /*
     * Get the literals from the bytecode.
     */

    TclNewObj(literals);
    for (i=0 ; i<codePtr->numLitObjects ; i++) {
    for (i=0 ; i<(int)codePtr->numLitObjects ; i++) {
	Tcl_ListObjAppendElement(NULL, literals, codePtr->objArrayPtr[i]);
    }

    /*
     * Get the variables from the bytecode.
     */

1169
1170
1171
1172
1173
1174
1175
1176
1177


1178
1179
1180
1181
1182
1183
1184
1197
1198
1199
1200
1201
1202
1203


1204
1205
1206
1207
1208
1209
1210
1211
1212







-
-
+
+







     * The way these are encoded in the bytecode is non-trivial; the Decode
     * macro (which updates its argument and returns the next decoded value)
     * handles this so that the rest of the code does not.
     */

#define Decode(ptr) \
    ((TclGetUInt1AtPtr(ptr) == 0xFF)			\
	? ((ptr)+=5 , TclGetInt4AtPtr((ptr)-4))		\
	: ((ptr)+=1 , TclGetInt1AtPtr((ptr)-1)))
	? ((ptr)+=5, TclGetInt4AtPtr((ptr)-4))		\
	: ((ptr)+=1, TclGetInt1AtPtr((ptr)-1)))

    TclNewObj(commands);
    codeOffPtr = codePtr->codeDeltaStart;
    codeLenPtr = codePtr->codeLengthStart;
    srcOffPtr = codePtr->srcDeltaStart;
    srcLenPtr = codePtr->srcLengthStart;
    codeOffset = sourceOffset = 0;
1257
1258
1259
1260
1261
1262
1263
1264

1265
1266
1267
1268
1269
1270
1271
1285
1286
1287
1288
1289
1290
1291

1292
1293
1294
1295
1296
1297
1298
1299







-
+







 *	in order to disassemble them.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_DisassembleObjCmd(
    void *clientData,	/* What type of operation. */
    void *clientData,		/* What type of operation. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const types[] = {
	"constructor", "destructor",
	"lambda", "method", "objmethod", "proc", "script", NULL
Changes to generic/tclEncoding.c.
1
2
3
4
5
6
7
8
9
10
11















12
13
14
15
16
17
18
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

-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclEncoding.c --
 *
 *	Contains the implementation of the encoding conversion package.
 *
 * Copyright © 1996-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclEncoding.c --
 *
 *	Contains the implementation of the encoding conversion package.
 */

#include "tclInt.h"
#include <assert.h>

typedef size_t (LengthProc)(const char *src);

/*
 * The following data structure represents an encoding, which describes how to
267
268
269
270
271
272
273
274

275
276
277
278
279
280
281
278
279
280
281
282
283
284

285
286
287
288
289
290
291
292







-
+








static const Tcl_ObjType encodingType = {
    "encoding",
    FreeEncodingInternalRep,
    DupEncodingInternalRep,
    NULL,
    NULL,
    TCL_OBJTYPE_V0
	0
};

#define EncodingSetInternalRep(objPtr, encoding) \
    do {								\
	Tcl_ObjInternalRep ir;						\
	ir.twoPtrValue.ptr1 = (encoding);				\
	ir.twoPtrValue.ptr2 = NULL;					\
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
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







-
+
















-
-
-
-
-
-
+
+
+
+
+
+







    const char *src,		/* Source string in specified encoding. */
    Tcl_Size srcLen,		/* Source string length in bytes, or < 0 for
				 * encoding-specific string length. */
    Tcl_DString *dstPtr)	/* Uninitialized or free DString in which the
				 * converted string is stored. */
{
    Tcl_ExternalToUtfDStringEx(
	NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_TCL8, dstPtr, NULL);
	NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_STRICT, dstPtr, NULL);
    return Tcl_DStringValue(dstPtr);
}

/*
 *-------------------------------------------------------------------------
 *
 * Tcl_ExternalToUtfDStringEx --
 *
 *	Convert a source buffer from the specified encoding into UTF-8.
 *	"flags" controls the behavior if any of the bytes in
 *	the source buffer are invalid or cannot be represented in utf-8.
 *	Possible flags values:
 *	target encoding. It should be composed by OR-ing the following:
 *	- *At most one* of TCL_ENCODING_PROFILE{DEFAULT,TCL8,STRICT}
 *
 * Results:
 *	The return value is one of
 *	  TCL_OK: success. Converted string in *dstPtr
 *	  TCL_ERROR: error in passed parameters. Error message in interp
 *	  TCL_CONVERT_MULTIBYTE: source ends in truncated multibyte sequence
 *	  TCL_CONVERT_SYNTAX: source is not conformant to encoding definition
 *	  TCL_CONVERT_UNKNOWN: source contained a character that could not
 *	The return value is one of:
 *	  TCL_OK: success. Converted string in *dstPtr.
 *	  TCL_ERROR: Error in passed parameters. Error message in interp.
 *	  TCL_CONVERT_MULTIBYTE: Source ends in truncated multibyte sequence.
 *	  TCL_CONVERT_SYNTAX: Source is not conformant to encoding definition.
 *	  TCL_CONVERT_UNKNOWN: Source contained a character that could not.
 *	      be represented in target encoding.
 *
 * Side effects:
 *	TCL_OK: The converted bytes are stored in the DString and NUL
 *	    terminated in an encoding-specific manner.
 *	TCL_ERROR: an error, message is stored in the interp if not NULL.
 *	TCL_CONVERT_*: if errorLocPtr is NULL, an error message is stored
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2521
2522
2523
2524
2525
2526
2527

2528
2529
2530
2531
2532
2533
2534







-







        OUTPUT_ISOLATEDSURROGATE;                                       \
        continue; /* Rerun loop so length checks etc. repeated */       \
    } else                                                              \
        (void) 0

    profile = ENCODING_PROFILE_GET(flags);
    for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {

	if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
	    /*
	     * If there is more string to follow, this will ensure that the
	     * last UTF-8 character in the source buffer hasn't been cut off.
	     */

	    result = TCL_CONVERT_MULTIBYTE;
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
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







-
-
-
-
+
+
+
+

-
+
















-
+
+







		 */
		*dst++ = 0;
		src += 2;
	    }

	} else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
	    /*
             * Incomplete byte sequence not because there are insufficient
             * bytes in source buffer (have already checked that above) but
             * because the UTF-8 sequence is truncated.
             */
		 * Incomplete byte sequence not because there are insufficient
		 * bytes in source buffer (have already checked that above) but
		 * because the UTF-8 sequence is truncated.
		 */

            CHECK_ISOLATEDSURROGATE;
		CHECK_ISOLATEDSURROGATE;

	    if (flags & ENCODING_INPUT) {
		/* Incomplete bytes for modified UTF-8 target */
		if (PROFILE_STRICT(profile)) {
		    result = (flags & TCL_ENCODING_CHAR_LIMIT)
			    ? TCL_CONVERT_MULTIBYTE
			    : TCL_CONVERT_SYNTAX;
		    break;
		}
	    }
	    if (PROFILE_REPLACE(profile)) {
		ch = UNICODE_REPLACE_CHAR;
		++src;
	    } else {
		/* TCL_ENCODING_PROFILE_TCL8 */
		char chbuf[2];
		chbuf[0] = UCHAR(*src++); chbuf[1] = 0;
		chbuf[0] = UCHAR(*src++);
		chbuf[1] = 0;
		TclUtfToUniChar(chbuf, &ch);
	    }
	    dst += Tcl_UniCharToUtf(ch, dst);
	} else {
            /* Have a complete character */
	    size_t len = TclUtfToUniChar(src, &ch);

3506
3507
3508
3509
3510
3511
3512
3513


3514
3515
3516
3517
3518
3519
3520
3517
3518
3519
3520
3521
3522
3523

3524
3525
3526
3527
3528
3529
3530
3531
3532







-
+
+







	    if (prefixBytes[byte]) {
		src--;
	    }
	    if (PROFILE_REPLACE(flags)) {
		ch = UNICODE_REPLACE_CHAR;
	    } else {
		char chbuf[2];
		chbuf[0] = byte; chbuf[1] = 0;
		chbuf[0] = byte;
		chbuf[1] = 0;
		TclUtfToUniChar(chbuf, &ch);
	    }
	}

	/*
	 * Special case for 1-byte Utf chars for speed.
	 */
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3816
3817
3818
3819
3820
3821
3822

3823
3824
3825
3826
3827
3828
3829







-







	    if (PROFILE_STRICT(flags)) {
		result = TCL_CONVERT_UNKNOWN;
		break;
	    }
	    /*
	     * Plunge on, using '?' as a fallback character.
	     */

	    ch = '?'; /* Profiles TCL8 and REPLACE */
	}

	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}
4487
4488
4489
4490
4491
4492
4493
4494

4495
4496
4497
4498
4499
4500
4501
4498
4499
4500
4501
4502
4503
4504

4505
4506
4507
4508
4509
4510
4511
4512







-
+








    Tcl_DecrRefCount(libPathObj);
    Tcl_DecrRefCount(encodingObj);
    *encodingPtr = libraryPath.encoding;
    if (*encodingPtr) {
	((Encoding *)(*encodingPtr))->refCount++;
    }
    bytes = TclGetStringFromObj(searchPathObj, &numBytes);
    bytes = Tcl_GetStringFromObj(searchPathObj, &numBytes);

    *lengthPtr = numBytes;
    *valuePtr = (char *)Tcl_Alloc(numBytes + 1);
    memcpy(*valuePtr, bytes, numBytes + 1);
    Tcl_DecrRefCount(searchPathObj);
}

Changes to generic/tclEnsemble.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclEnsemble.c --
 *
 *	Contains support for ensembles (see TIP#112), which provide simple
 *	mechanism for creating composite commands on top of namespaces.
 *
 * Copyright © 2005-2013 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclEnsemble.c --
 *
 *	Contains support for ensembles (see TIP#112), which provide simple
 *	mechanism for creating composite commands on top of namespaces.
 */

#include "tclInt.h"
#include "tclCompile.h"

/*
 * Declarations for functions local to this file:
 */

86
87
88
89
90
91
92
93

94
95
96
97
98
99
100
97
98
99
100
101
102
103

104
105
106
107
108
109
110
111







-
+








static const Tcl_ObjType ensembleCmdType = {
    "ensembleCommand",		/* the type's name */
    FreeEnsembleCmdRep,		/* freeIntRepProc */
    DupEnsembleCmdRep,		/* dupIntRepProc */
    NULL,			/* updateStringProc */
    NULL,			/* setFromAnyProc */
    TCL_OBJTYPE_V0
	0
};

#define ECRSetInternalRep(objPtr, ecRepPtr) \
    do {								\
	Tcl_ObjInternalRep ir;						\
	ir.twoPtrValue.ptr1 = (ecRepPtr);				\
	ir.twoPtrValue.ptr2 = NULL;					\
1859
1860
1861
1862
1863
1864
1865
1866

1867
1868
1869
1870
1871
1872
1873
1870
1871
1872
1873
1874
1875
1876

1877
1878
1879
1880
1881
1882
1883
1884







-
+







	const char *subcmdName; /* Name of the subcommand or unique prefix of
				 * it (a non-unique prefix produces an error). */
	char *fullName = NULL;	/* Full name of the subcommand. */
	Tcl_Size stringLength, i;
	Tcl_Size tableLength = ensemblePtr->subcommandTable.numEntries;
	Tcl_Obj *fix;

	subcmdName = TclGetStringFromObj(subObj, &stringLength);
	subcmdName = Tcl_GetStringFromObj(subObj, &stringLength);
	for (i=0 ; i<tableLength ; i++) {
	    int cmp = strncmp(subcmdName,
		    ensemblePtr->subcommandArrayPtr[i],
		    stringLength);

	    if (cmp == 0) {
		if (fullName != NULL) {
1938
1939
1940
1941
1942
1943
1944
1945





1946
1947
1948
1949
1950
1951
1952
1949
1950
1951
1952
1953
1954
1955

1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967







-
+
+
+
+
+







				 * Will be freed by the dispatch engine. */
	Tcl_Obj **copyObjv;
	Tcl_Size copyObjc, prefixObjc;

	TclListObjLength(NULL, prefixObj, &prefixObjc);

	if (objc == 2) {
	    copyPtr = TclListObjCopy(NULL, prefixObj);
	    copyPtr = TclDuplicatePureObj(
		interp, prefixObj, tclListTypePtr);
	    if (!copyPtr) {
		return TCL_ERROR;
	    }
	} else {
	    copyPtr = Tcl_NewListObj(objc - 2 + prefixObjc, NULL);
	    Tcl_ListObjAppendList(NULL, copyPtr, prefixObj);
	    Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
		    ensemblePtr->numParameters, objv + 1);
	    Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
		    objc - 2 - ensemblePtr->numParameters,
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







+
-
+
+
+
+







    Tcl_Size i, prefixObjc;
    Tcl_Obj **paramv, *unknownCmd, *ensObj;

    /*
     * Create the "unknown" command callback to determine what to do.
     */

    unknownCmd = TclDuplicatePureObj(
    unknownCmd = Tcl_DuplicateObj(ensemblePtr->unknownHandler);
	interp, ensemblePtr->unknownHandler, tclListTypePtr);
    if (!unknownCmd) {
	return TCL_ERROR;
    }
    TclNewObj(ensObj);
    Tcl_GetCommandFullName(interp, ensemblePtr->token, ensObj);
    Tcl_ListObjAppendElement(NULL, unknownCmd, ensObj);
    for (i = 1 ; i < objc ; i++) {
	Tcl_ListObjAppendElement(NULL, unknownCmd, objv[i]);
    }
    TclListObjGetElements(NULL, unknownCmd, &paramc, &paramv);
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721



2722
2723
2724
2725
2726
2727
2728
2731
2732
2733
2734
2735
2736
2737



2738
2739
2740
2741
2742
2743
2744
2745
2746
2747







-
-
-
+
+
+







			Tcl_IncrRefCount(target);
			continue;
		    }
		}

		/*
		 * Target was not in the dictionary.  Map onto the namespace.
		 * In this case there is no guarantee that the command is
		 * actually there.  It is the responsibility of the programmer
		 * (or [::unknown] of course) to provide the procedure.
		 * In this case there is no guarantee that the command
		 * is actually there.  It is the responsibility of the
		 * programmer (or [::unknown] of course) to provide the procedure.
		 */

		cmdObj = Tcl_NewStringObj(name, TCL_AUTO_LENGTH);
		cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
		Tcl_SetHashValue(hPtr, cmdPrefixObj);
		Tcl_IncrRefCount(cmdPrefixObj);
	    }
3064
3065
3066
3067
3068
3069
3070
3071

3072
3073
3074
3075
3076
3077

3078
3079
3080
3081
3082
3083
3084
3083
3084
3085
3086
3087
3088
3089

3090
3091
3092
3093
3094
3095

3096
3097
3098
3099
3100
3101
3102
3103







-
+





-
+







	const char *str;
	Tcl_Obj *matchObj = NULL;

	if (TclListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) {
	    goto tryCompileToInv;
	}
	for (i=0 ; i<len ; i++) {
	    str = TclGetStringFromObj(elems[i], &sclen);
	    str = Tcl_GetStringFromObj(elems[i], &sclen);
	    if ((sclen == numBytes) && !memcmp(word, str, numBytes)) {
		/*
		 * Exact match! Excellent!
		 */

		result = Tcl_DictObjGet(NULL, mapObj,elems[i], &targetCmdObj);
		result = Tcl_DictObjGet(NULL, mapObj, elems[i], &targetCmdObj);
		if (result != TCL_OK || targetCmdObj == NULL) {
		    goto tryCompileToInv;
		}
		replacement = elems[i];
		goto doneMapLookup;
	    }

3467
3468
3469
3470
3471
3472
3473
3474

3475
3476
3477
3478
3479
3480
3481
3486
3487
3488
3489
3490
3491
3492

3493
3494
3495
3496
3497
3498
3499
3500







-
+







     * difference. Hence the call to TclContinuationsEnterDerived...
     */

    TclListObjGetElements(NULL, replacements, &numWords, &words);
    for (i = 0, tokPtr = parsePtr->tokenPtr; i < parsePtr->numWords;
	    i++, tokPtr = TokenAfter(tokPtr)) {
	if (i > 0 && i <= numWords) {
	    bytes = TclGetStringFromObj(words[i - 1], &length);
	    bytes = Tcl_GetStringFromObj(words[i-1], &length);
	    PushLiteral(envPtr, bytes, length);
	    continue;
	}

	SetLineInformation(i);
	if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    int literal = TclRegisterLiteral(envPtr,
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
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







-
+












-
+
-







    /*
     * Push the name of the command we're actually dispatching to as part of
     * the implementation.
     */

    TclNewObj(objPtr);
    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
    bytes = TclGetStringFromObj(objPtr, &length);
    bytes = Tcl_GetStringFromObj(objPtr, &length);
    if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) {
	extraLiteralFlags |= LITERAL_UNSHARED;
    }
    cmdLit = TclRegisterLiteral(envPtr, bytes, length, extraLiteralFlags);
    TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr);
    TclEmitPush(cmdLit, envPtr);
    TclDecrRefCount(objPtr);

    /*
     * Do the replacing dispatch.
     */

    TclEmitInvoke(envPtr, INST_INVOKE_REPLACE, parsePtr->numWords,
    TclEmitInvoke(envPtr, INST_INVOKE_REPLACE, parsePtr->numWords, numWords+1);
	    numWords + 1);
}

/*
 * Helpers that do issuing of instructions for commands that "don't have
 * compilers" (well, they do; these). They all work by just generating base
 * code to invoke the command; they're intended for ensemble subcommands so
 * that the costs of INST_INVOKE_REPLACE can be avoided where we can work out
Changes to generic/tclEnv.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
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-
-








-
-
-
-
+
+
+
+
+
+
+














-
+







-
+







/*
 * Copyright © 1991-1994 The Regents of the University of California.
 * Copyright © 1994-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclEnv.c --
 *
 *	Tcl support for environment variables, including a setenv function.
 *	This file contains the generic portion of the environment module. It
 *	is primarily responsible for keeping the "env" arrays in sync with the
 *	system environment variables.
 *
 * Copyright © 1991-1994 The Regents of the University of California.
 * Copyright © 1994-1998 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"

TCL_DECLARE_MUTEX(envMutex)	/* To serialize access to environ. */

#if defined(_WIN32)
#  define tenviron _wenviron
#  define tenviron2utfdstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \
	(char *)Tcl_Char16ToUtfDString((const unsigned short *)(str), -1, (dsPtr)))
#  define utf2tenvirondstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \
	(const WCHAR *)Tcl_UtfToChar16DString((str), -1, (dsPtr)))
#  define tenviron2utfdstr(str, dsPtr) \
    (Tcl_DStringInit(dsPtr),						\
    (char *)Tcl_Char16ToUtfDString(					\
	    (const unsigned short *)(str), -1, (dsPtr)))
#  define utf2tenvirondstr(str, dsPtr) \
    (Tcl_DStringInit(dsPtr),						\
    (const WCHAR *) Tcl_UtfToChar16DString((str), -1, (dsPtr)))
#  define techar WCHAR
#  ifdef USE_PUTENV
#    define putenv(env) _wputenv((const wchar_t *)env)
#  endif
#else
#  define tenviron environ
#  define tenviron2utfdstr(str, dsPtr) \
	Tcl_ExternalToUtfDString(NULL, str, -1, dsPtr)
#  define utf2tenvirondstr(str, dsPtr) \
	Tcl_UtfToExternalDString(NULL, str, -1, dsPtr)
#  define techar char
#endif

/* MODULE_SCOPE */
size_t TclEnvEpoch = 0;	/* Epoch of the tcl environment
size_t TclEnvEpoch = 0;		/* Epoch of the tcl environment
				 * (if changed with tcl-env). */

static struct {
    Tcl_Size cacheSize;		/* Number of env strings in cache. */
    char **cache;		/* Array containing all of the environment
				 * strings that Tcl has allocated. */
#ifndef USE_PUTENV
    techar **ourEnviron;		/* Cache of the array that we allocate. We
    techar **ourEnviron;	/* Cache of the array that we allocate. We
				 * need to track this in case another
				 * subsystem swaps around the environ array
				 * like we do. */
    Tcl_Size ourEnvironSize;	/* Non-zero means that the environ array was
				 * malloced and has this many total entries
				 * allocated to it (not all may be in use at
				 * once). Zero means that the environment
Changes to generic/tclEvent.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

















16
17
18
19
20
21
22
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

-
-
-
-
-
-








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclEvent.c --
 *
 *	This file implements some general event related interfaces including
 *	background errors, exit handlers, and the "vwait" and "update" command
 *	functions.
 *
 * Copyright © 1990-1994 The Regents of the University of California.
 * Copyright © 1994-1998 Sun Microsystems, Inc.
 * Copyright © 2004 Zoran Vasiljevic.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclEvent.c --
 *
 *	This file implements some general event related interfaces including
 *	background errors, exit handlers, and the "vwait" and "update" command
 *	functions.
 */

#include "tclInt.h"
#include "tclUuid.h"
#if defined(HAVE_ZLIB) && defined(TCL_WITH_INTERNAL_ZLIB)
#include "zlib.h"
#endif /* HAVE_ZLIB */

/*
68
69
70
71
72
73
74
75

76
77
78
79
80
81
82
79
80
81
82
83
84
85

86
87
88
89
90
91
92
93







-
+







/*
 * For each exit handler created with a call to Tcl_Create(Late)ExitHandler
 * there is a structure of the following type:
 */

typedef struct ExitHandler {
    Tcl_ExitProc *proc;		/* Function to call when process exits. */
    void *clientData;	/* One word of information to pass to proc. */
    void *clientData;		/* One word of information to pass to proc. */
    struct ExitHandler *nextPtr;/* Next in list of all exit handlers for this
				 * application, or NULL for end of list. */
} ExitHandler;

/*
 * There is both per-process and per-thread exit handlers. The first list is
 * controlled by a mutex. The other is in thread local storage.
118
119
120
121
122
123
124
125

126
127
128
129
130
131
132
129
130
131
132
133
134
135

136
137
138
139
140
141
142
143







-
+







				 * standard channels. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

#if TCL_THREADS
typedef struct {
    Tcl_ThreadCreateProc *proc;	/* Main() function of the thread */
    void *clientData;	/* The one argument to Main() */
    void *clientData;		/* The one argument to Main() */
} ThreadClientData;
static Tcl_ThreadCreateType NewThreadProc(void *clientData);
#endif /* TCL_THREADS */

/*
 * Prototypes for functions referenced only in this file:
 */
208
209
210
211
212
213
214
215

216
217
218
219
220
221
222
219
220
221
222
223
224
225

226
227
228
229
230
231
232
233







-
+







 *	Depends on what actions the handler command takes for the errors.
 *
 *----------------------------------------------------------------------
 */

static void
HandleBgErrors(
    void *clientData)	/* Pointer to ErrAssocData structure. */
    void *clientData)		/* Pointer to ErrAssocData structure. */
{
    ErrAssocData *assocPtr = (ErrAssocData *)clientData;
    Tcl_Interp *interp = assocPtr->interp;
    BgError *errPtr;

    /*
     * Not bothering to save/restore the interp state. Assume that any code
233
234
235
236
237
238
239
240





241
242
243
244
245
246
247
244
245
246
247
248
249
250

251
252
253
254
255
256
257
258
259
260
261
262







-
+
+
+
+
+







	Tcl_Obj **prefixObjv, **tempObjv;

	/*
	 * Note we copy the handler command prefix each pass through, so we do
	 * support one handler setting another handler.
	 */

	Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix);
	Tcl_Obj *copyObj = TclDuplicatePureObj(
	    interp, assocPtr->cmdPrefix, tclListTypePtr);
	if (!copyObj) {
	    return;
	}

	errPtr = assocPtr->firstBgPtr;

	TclListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv);
	tempObjv = (Tcl_Obj**)Tcl_Alloc((prefixObjc+2) * sizeof(Tcl_Obj *));
	memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *));
	tempObjv[prefixObjc] = errPtr->errorMsg;
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







-
+







 *	reports, they are canceled.
 *
 *----------------------------------------------------------------------
 */

static void
BgErrorDeleteProc(
    void *clientData,	/* Pointer to ErrAssocData structure. */
    void *clientData,		/* Pointer to ErrAssocData structure. */
    TCL_UNUSED(Tcl_Interp *))
{
    ErrAssocData *assocPtr = (ErrAssocData *)clientData;
    BgError *errPtr;

    while (assocPtr->firstBgPtr != NULL) {
	errPtr = assocPtr->firstBgPtr;
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







-
+







 *
 *----------------------------------------------------------------------
 */

void
Tcl_CreateExitHandler(
    Tcl_ExitProc *proc,		/* Function to invoke. */
    void *clientData)	/* Arbitrary value to pass to proc. */
    void *clientData)		/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr = (ExitHandler*)Tcl_Alloc(sizeof(ExitHandler));

    exitPtr->proc = proc;
    exitPtr->clientData = clientData;
    Tcl_MutexLock(&exitMutex);
    exitPtr->nextPtr = firstExitPtr;
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







-
+







 *
 *----------------------------------------------------------------------
 */

void
TclCreateLateExitHandler(
    Tcl_ExitProc *proc,		/* Function to invoke. */
    void *clientData)	/* Arbitrary value to pass to proc. */
    void *clientData)		/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr = (ExitHandler*)Tcl_Alloc(sizeof(ExitHandler));

    exitPtr->proc = proc;
    exitPtr->clientData = clientData;
    Tcl_MutexLock(&exitMutex);
    exitPtr->nextPtr = firstLateExitPtr;
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







-
+







 *
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteExitHandler(
    Tcl_ExitProc *proc,		/* Function that was previously registered. */
    void *clientData)	/* Arbitrary value to pass to proc. */
    void *clientData)		/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr, *prevPtr;

    Tcl_MutexLock(&exitMutex);
    for (prevPtr = NULL, exitPtr = firstExitPtr; exitPtr != NULL;
	    prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
	if ((exitPtr->proc == proc)
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







-
+







 *
 *----------------------------------------------------------------------
 */

void
TclDeleteLateExitHandler(
    Tcl_ExitProc *proc,		/* Function that was previously registered. */
    void *clientData)	/* Arbitrary value to pass to proc. */
    void *clientData)		/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr, *prevPtr;

    Tcl_MutexLock(&exitMutex);
    for (prevPtr = NULL, exitPtr = firstLateExitPtr; exitPtr != NULL;
	    prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
	if ((exitPtr->proc == proc)
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







-
+







 *
 *----------------------------------------------------------------------
 */

void
Tcl_CreateThreadExitHandler(
    Tcl_ExitProc *proc,		/* Function to invoke. */
    void *clientData)	/* Arbitrary value to pass to proc. */
    void *clientData)		/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    exitPtr = (ExitHandler*)Tcl_Alloc(sizeof(ExitHandler));
    exitPtr->proc = proc;
    exitPtr->clientData = clientData;
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







-
+







 *
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteThreadExitHandler(
    Tcl_ExitProc *proc,		/* Function that was previously registered. */
    void *clientData)	/* Arbitrary value to pass to proc. */
    void *clientData)		/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr, *prevPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    for (prevPtr = NULL, exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL;
	    prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
	if ((exitPtr->proc == proc)
882
883
884
885
886
887
888
889

890
891
892
893
894
895
896


897
898
899
900
901
902
903
897
898
899
900
901
902
903

904
905
906
907
908
909


910
911
912
913
914
915
916
917
918







-
+





-
-
+
+







}

/*
 *----------------------------------------------------------------------
 *
 * InvokeExitHandlers --
 *
 *      Call the registered exit handlers.
 *	Call the registered exit handlers.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The exit handlers are invoked, and the ExitHandler struct is
 *      freed.
 *	The exit handlers are invoked, and the Exi	tHandler struct is
 *	freed.
 *
 *----------------------------------------------------------------------
 */
static void
InvokeExitHandlers(void)
{
    ExitHandler *exitPtr;
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1089
1090
1091
1092
1093
1094
1095



1096
1097
1098
1099
1100
1101
1102







-
-
-







#endif
#if defined(_MSC_VER)
	    ".msvc-" STRINGIFY(_MSC_VER)
#endif
#ifdef USE_NMAKE
	    ".nmake"
#endif
#ifdef TCL_NO_DEPRECATED
	    ".no-deprecate"
#endif
#if !TCL_THREADS
	    ".no-thread"
#endif
#ifndef TCL_CFG_OPTIMIZED
	    ".no-optimize"
#endif
#ifdef __OBJC__
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
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







-
-
+





-
+



















+
+
+
+
+







	/*
	 * Double check inside the mutex. There are definitely calls back into
	 * this routine from some of the functions below.
	 */

	TclpInitLock();
	if (subsystemsInitialized == 0) {

		/*
	    /*
	     * Initialize locks used by the memory allocators before anything
	     * interesting happens so we can use the allocators in the
	     * implementation of self-initializing locks.
	     */

	    TclInitThreadStorage();     /* Creates hash table for
	    TclInitThreadStorage();	/* Creates hash table for
					 * thread local storage */
#if defined(USE_TCLALLOC) && USE_TCLALLOC
	    TclInitAlloc();		/* Process wide mutex init */
#endif
#if TCL_THREADS && defined(USE_THREAD_ALLOC)
	    TclInitThreadAlloc();	/* Setup thread allocator caches */
#endif
#ifdef TCL_MEM_DEBUG
	    TclInitDbCkalloc();		/* Process wide mutex init */
#endif

	    TclpInitPlatform();		/* Creates signal handler(s) */
	    TclInitDoubleConversion();	/* Initializes constants for
					 * converting to/from double. */
	    TclInitObjSubsystem();	/* Register obj types, create
					 * mutexes. */
	    TclInitIOSubsystem();	/* Inits a tsd key (noop). */
	    TclInitEncodingSubsystem();	/* Process wide encoding init. */
	    TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */

	    TclArithSeriesInit();
	    TclListInit();
	    TclDictInit();
		TclProcInit();
	    subsystemsInitialized = 1;
	}
	TclpInitUnlock();
    }
    TclInitNotifier();
    return stubInfo.version;
}
2049
2050
2051
2052
2053
2054
2055
2056

2057
2058
2059
2060
2061
2062
2063
2065
2066
2067
2068
2069
2070
2071

2072
2073
2074
2075
2076
2077
2078
2079







-
+







 */

int
Tcl_CreateThread(
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread */
    void *clientData,		/* The one argument to Main() */
    size_t stackSize,	/* Size of stack for the new thread */
    size_t stackSize,		/* Size of stack for the new thread */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
#if TCL_THREADS
    ThreadClientData *cdPtr = (ThreadClientData *)Tcl_Alloc(sizeof(ThreadClientData));
    int result;

Changes to generic/tclExecute.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
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

-
-
-
-







+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclExecute.c --
 *
 *	This file contains procedures that execute byte-compiled Tcl commands.
 *
 * Copyright © 1996-1997 Sun Microsystems, Inc.
 * Copyright © 1998-2000 Scriptics Corporation.
 * Copyright © 2001 Kevin B. Kenny. All rights reserved.
 * Copyright © 2002-2010 Miguel Sofer.
 * Copyright © 2005-2007 Donal K. Fellows.
 * Copyright © 2007 Daniel A. Steffen <das@users.sourceforge.net>
 * Copyright © 2006-2008 Joe Mistachkin.  All rights reserved.
 * Copyright © 2021-2024 Nathan Coulter.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclExecute.c --
 *
 *	This file contains procedures that execute byte-compiled Tcl commands.
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tclOOInt.h"
#include "tclTomMath.h"
#include <math.h>
#include <assert.h>

448
449
450
451
452
453
454
455

456
457
458
459

460
461
462
463
464
465
466
460
461
462
463
464
465
466

467
468
469
470

471
472
473
474
475
476
477
478







-
+



-
+







 * Tcl_GetNumberFromObj(). The ANSI C "prototype" is:
 *
 * MODULE_SCOPE int GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 *			void **ptrPtr, int *tPtr);
 */

#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
    ((TclHasInternalRep((objPtr), &tclIntType))				\
    ((TclHasInternalRep((objPtr), tclIntTypePtr))					\
	?	(*(tPtr) = TCL_NUMBER_INT,				\
		*(ptrPtr) = (void *)					\
		    (&((objPtr)->internalRep.wideValue)), TCL_OK) :	\
    TclHasInternalRep((objPtr), &tclDoubleType)				\
    TclHasInternalRep((objPtr), tclDoubleTypePtr)				\
	?	(((isnan((objPtr)->internalRep.doubleValue))		\
		    ?	(*(tPtr) = TCL_NUMBER_NAN)			\
		    :	(*(tPtr) = TCL_NUMBER_DOUBLE)),			\
		*(ptrPtr) = (void *)					\
		    (&((objPtr)->internalRep.doubleValue)), TCL_OK) :	\
    (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))		\
	? TCL_ERROR :			\
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
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







-
+











-
+








const Tcl_ObjType tclExprCodeType = {
    "exprcode",
    FreeExprCodeInternalRep,	/* freeIntRepProc */
    DupExprCodeInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    NULL,			/* setFromAnyProc */
    TCL_OBJTYPE_V0
    0
};

/*
 * Custom object type only used in this file; values of its type should never
 * be seen by user scripts.
 */

static const Tcl_ObjType dictIteratorType = {
    "dictIterator",
    ReleaseDictIterator,
    NULL, NULL, NULL,
    TCL_OBJTYPE_V0
    0
};

/*
 *----------------------------------------------------------------------
 *
 * ReleaseDictIterator --
 *
917
918
919
920
921
922
923
924

925
926
927
928
929
930
931
929
930
931
932
933
934
935

936
937
938
939
940
941
942
943







-
+







{
    Tcl_MutexLock(&execMutex);
    execInitialized = 0;
    Tcl_MutexUnlock(&execMutex);
}

/*
 * Auxiliary code to insure that GrowEvaluationStack always returns correctly
 * Auxiliary code to ensure that GrowEvaluationStack returns correctly
 * aligned memory.
 *
 * WALLOCALIGN represents the alignment reqs in words, just as TCL_ALLOCALIGN
 * represents the reqs in bytes. This assumes that TCL_ALLOCALIGN is a
 * multiple of the wordsize 'sizeof(Tcl_Obj *)'.
 */

1434
1435
1436
1437
1438
1439
1440
1441

1442
1443
1444
1445
1446
1447
1448
1446
1447
1448
1449
1450
1451
1452

1453
1454
1455
1456
1457
1458
1459
1460







-
+








    if (codePtr == NULL) {
	/*
	 * TIP #280: No invoker (yet) - Expression compilation.
	 */

	Tcl_Size length;
	const char *string = TclGetStringFromObj(objPtr, &length);
	const char *string = Tcl_GetStringFromObj(objPtr, &length);

	TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0);
	TclCompileExpr(interp, string, length, &compEnv, 0);

	/*
	 * Successful compilation. If the expression yielded no instructions,
	 * push an zero object as the expression's result.
1473
1474
1475
1476
1477
1478
1479
1480

1481
1482
1483
1484
1485
1486
1487
1488
1489

1490
1491
1492
1493
1494
1495
1496
1485
1486
1487
1488
1489
1490
1491

1492
1493
1494
1495
1496
1497
1498
1499
1500

1501
1502
1503
1504
1505
1506
1507
1508







-
+








-
+








/*
 *----------------------------------------------------------------------
 *
 * DupExprCodeInternalRep --
 *
 *	Part of the Tcl object type implementation for Tcl expression
 *	bytecode. We do not copy the bytecode internalrep. Instead, we return
 *	bytecode. We do not copy the bytecode intrep. Instead, we return
 *	without setting copyPtr->typePtr, so the copy is a plain string copy
 *	of the expression value, and if it is to be used as a compiled
 *	expression, it will just need a recompile.
 *
 *	This makes sense, because with Tcl's copy-on-write practices, the
 *	usual (only?) time Tcl_DuplicateObj() will be called is when the copy
 *	is about to be modified, which would invalidate any copied bytecode
 *	anyway. The only reason it might make sense to copy the bytecode is if
 *	we had some modifying routines that operated directly on the internalrep,
 *	we had some modifying routines that operated directly on the intrep,
 *	like we do for lists and dicts.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
3370
3371
3372
3373
3374
3375
3376
3377










3378
3379
3380
3381
3382
3383
3384
3382
3383
3384
3385
3386
3387
3388

3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405







-
+
+
+
+
+
+
+
+
+
+







    lappendListDirect:
	objResultPtr = varPtr->value.objPtr;
	if (TclListObjLength(interp, objResultPtr, &len) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	if (Tcl_IsShared(objResultPtr)) {
	    Tcl_Obj *newValue = Tcl_DuplicateObj(objResultPtr);
	    Tcl_Obj *newValue;

	    DECACHE_STACK_INFO();
	    newValue = TclDuplicatePureObj(interp, objResultPtr, tclListTypePtr);
	    CACHE_STACK_INFO();

	    if (!newValue) {
		TRACE_ERROR(interp);
		goto gotError;
	    }

	    TclDecrRefCount(objResultPtr);
	    varPtr->value.objPtr = objResultPtr = newValue;
	    Tcl_IncrRefCount(newValue);
	}
	if (TclListObjAppendElements(interp, objResultPtr, objc, objv)
		!= TCL_OK) {
3429
3430
3431
3432
3433
3434
3435

3436






3437
3438
3439
3440
3441
3442
3443
3450
3451
3452
3453
3454
3455
3456
3457

3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470







+
-
+
+
+
+
+
+







	    if (!objResultPtr) {
		valueToAssign = valuePtr;
	    } else if (TclListObjLength(interp, objResultPtr, &len)!=TCL_OK) {
		TRACE_ERROR(interp);
		goto gotError;
	    } else {
		if (Tcl_IsShared(objResultPtr)) {
		    DECACHE_STACK_INFO();
		    valueToAssign = Tcl_DuplicateObj(objResultPtr);
		    valueToAssign = TclDuplicatePureObj(
			interp, objResultPtr, tclListTypePtr);
		    CACHE_STACK_INFO();
		    if (!valueToAssign) {
			goto errorInLappendListPtr;
		    }
		    createdNewObj = 1;
		} else {
		    valueToAssign = objResultPtr;
		}
		if (TclListObjAppendElements(interp, valueToAssign,
			objc, objv) != TCL_OK) {
		    if (createdNewObj) {
4389
4390
4391
4392
4393
4394
4395

4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406














4407
4408
4409
4410
4411
4412
4413
4416
4417
4418
4419
4420
4421
4422
4423











4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444







+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	origCmd = TclGetOriginalCommand(cmd);
	if (origCmd == NULL) {
	    origCmd = cmd;
	}

	TclNewObj(objResultPtr);
	Tcl_GetCommandFullName(interp, origCmd, objResultPtr);
	{
	if (TclCheckEmptyString(objResultPtr) == TCL_EMPTYSTRING_YES ) {
	    Tcl_DecrRefCount(objResultPtr);
	    instOriginError:
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "invalid command name \"%s\"", TclGetString(OBJ_AT_TOS)));
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
		    TclGetString(OBJ_AT_TOS), (char *)NULL);
	    CACHE_STACK_INFO();
	    TRACE_APPEND(("ERROR: not command\n"));
	    goto gotError;
	    int isEmpty = TCL_EMPTYSTRING_YES, status;
	    status = TclCheckEmptyString(interp, objResultPtr, &isEmpty);
	    if (status || isEmpty == TCL_EMPTYSTRING_YES) {
		Tcl_DecrRefCount(objResultPtr);
		instOriginError:
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"invalid command name \"%s\"", TclGetString(OBJ_AT_TOS)));
		DECACHE_STACK_INFO();
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
			TclGetString(OBJ_AT_TOS), (char *)NULL);
		CACHE_STACK_INFO();
		TRACE_APPEND(("ERROR: not command\n"));
		goto gotError;
	    }
	}
	TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_TOS)));
	NEXT_INST_F(1, 1, 1);
    }

    /*
     * -----------------------------------------------------------------
4683
4684
4685
4686
4687
4688
4689
4690


4691
4692
4693
4694
4695
4696
4697
4714
4715
4716
4717
4718
4719
4720

4721
4722
4723
4724
4725
4726
4727
4728
4729







-
+
+







    /*
     *	   End of TclOO support instructions.
     * -----------------------------------------------------------------
     *	   Start of INST_LIST and related instructions.
     */

    {
	int numIndices, nocase, match, cflags;
	int dstatus, numIndices, nocase, match, cflags,
	    toIdxAnchor, fromIdxAnchor;
	Tcl_Size slength, length2, fromIdx, toIdx, index, s1len, s2len;
	const char *s1, *s2;

    case INST_LIST:
	/*
	 * Pop the opnd (objc) top stack elements into a new list obj and then
	 * decrement their ref counts.
4712
4713
4714
4715
4716
4717
4718












4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730















































4731
4732



4733
4734
4735
4736
4737
4738
4739
4740
4741
4742



4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762












4763
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
4811
4812
4813
4814
4815
4816
4817
4818
4819
4820
4821
4822


4823
4824
4825
4826
4827
4828

































4829
4830
4831
4832
4833
4834
4835







+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+








-
-
+
+
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







	TRACE_APPEND(("%" TCL_SIZE_MODIFIER "d\n", length));
	NEXT_INST_F(1, 1, 1);

    case INST_LIST_INDEX:	/* lindex with objc == 3 */
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;
	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
	if (
	    TclHasInternalRep(value2Ptr, tclListTypePtr)
	    ||
	    TclObjectHasInterface(value2Ptr, list, length)
	) {
	    Tcl_Size value2Length;
	    if (Tcl_ListObjLength(interp,value2Ptr,&value2Length),
		value2Length == 1) {
		if (TclHasInternalRep(value2Ptr, tclListTypePtr)) {
		    value2Ptr = TclListObjGetElement(value2Ptr, 0);
		} else {
		    Tcl_ListObjIndex(interp, value2Ptr, 0, &value2Ptr);

	/* special case for AbstractList */
	if (TclObjTypeHasProc(valuePtr, indexProc)) {
	    DECACHE_STACK_INFO();
	    length = TclObjTypeLength(valuePtr);
	    if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    if (TclObjTypeIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) {
		CACHE_STACK_INFO();
		}
	    } else {
		goto TclLindexList;
	    }
	}

	if (TclObjectHasInterface(valuePtr, list, length)
	    || TclHasInternalRep(valuePtr, tclListTypePtr)) {
	    int code, haveElements = 0, status;

	    if (TclHasInternalRep(valuePtr, tclListTypePtr)) {
		/* since the type is tclListTypePtr, this can't fail */
		TclListObjGetElements(interp, valuePtr, &objc, &objv);
		haveElements = 1;
	    } else {
		TclObjectDispatchNoDefault(interp, status, valuePtr, list,
		    length, interp, valuePtr, &objc);
		if (status != TCL_OK) {
		    CACHE_STACK_INFO();
		    TRACE_ERROR(interp);
		    goto gotError;
		}

		if (objc < 0) {
		    objc = TCL_SIZE_MAX;
		}
	    } 

	    Tcl_IncrRefCount(value2Ptr);
	    DECACHE_STACK_INFO();
	    code = TclGetIntForIndexM(interp, value2Ptr, objc-1, &index);
	    CACHE_STACK_INFO();
	    if (code != TCL_OK) {
		goto TclLindexList;
	    }
	    Tcl_DecrRefCount(value2Ptr);

	    if (haveElements && code == TCL_OK) {
		tosPtr--;
		pcAdjustment = 1;
		goto lindexFastPath;
	    }

	    Tcl_ResetResult(interp);
	    TclObjectDispatchNoDefault(interp, status, valuePtr, list,
		index, interp, valuePtr, index, &objResultPtr);
	    if (status != TCL_OK) {
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    if (objResultPtr == NULL) {
		TclNewObj(objResultPtr);
	    }
	    CACHE_STACK_INFO();
	    if (objResultPtr == NULL) {
		/* Index is out of range, return empty result. */
		TclNewObj(objResultPtr);
	    }
	    Tcl_IncrRefCount(objResultPtr); // reference held here
	    goto lindexDone;
	}


	}
    TclLindexList:
	/*
	 * Extract the desired list element.
	 */

	{
	    Tcl_Size value2Length;
	    Tcl_Obj *indexListPtr = value2Ptr;

	    if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK)
		    && (!TclHasInternalRep(value2Ptr, &tclListType)
		    || (Tcl_ListObjLength(interp, value2Ptr, &value2Length),
			value2Length == 1
			    ? (indexListPtr = TclListObjGetElement(value2Ptr, 0), 1)
			    : 0))) {
		int code;

		/* increment the refCount of value2Ptr because TclListObjGetElement may
		 * have just extracted it from a list in the condition for this block.
		 */
		Tcl_IncrRefCount(indexListPtr);

		DECACHE_STACK_INFO();
		code = TclGetIntForIndexM(interp, indexListPtr, objc-1, &index);
		TclDecrRefCount(indexListPtr);
		CACHE_STACK_INFO();
		if (code == TCL_OK) {
		    Tcl_DecrRefCount(value2Ptr);
		    tosPtr--;
		    pcAdjustment = 1;
		    goto lindexFastPath;
		}
		Tcl_ResetResult(interp);
	    }
	}

	DECACHE_STACK_INFO();
	objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
	CACHE_STACK_INFO();

    lindexDone:
	if (!objResultPtr) {
	    TRACE_ERROR(interp);
	    goto gotError;
4798
4799
4800
4801
4802
4803
4804


























4805
4806
4807
4808
4809
4810
4811
4812
4813
4814






4815
4816
4817

4818
4819


4820
4821
4822


4823
4824
4825
4826
4827

4828





4829


4830

4831
4832
4833





4834



4835
4836
4837
4838
4839





4840
4841

4842
4843
4844



4845
4846
4847
4848
4849
4850
4851
4848
4849
4850
4851
4852
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
4877
4878
4879
4880
4881
4882
4883
4884
4885
4886




4887
4888
4889
4890
4891
4892


4893
4894


4895
4896



4897
4898
4899
4900
4901

4902
4903

4904
4905
4906
4907
4908
4909
4910
4911

4912



4913
4914
4915
4916
4917
4918
4919
4920
4921





4922
4923
4924
4925
4926


4927
4928


4929
4930
4931
4932
4933
4934
4935
4936
4937
4938







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
-
+
+
+
+
+
+
-
-

+
-
-
+
+
-
-
-
+
+



-

+
-
+
+
+
+
+

+
+
-
+
-
-
-
+
+
+
+
+

+
+
+
-
-
-
-
-
+
+
+
+
+
-
-
+

-
-
+
+
+







	/*
	 * Pop the list and get the index.
	 */

	valuePtr = OBJ_AT_TOS;
	opnd = TclGetInt4AtPtr(pc+1);
	TRACE(("\"%.30s\" %d => ", O2S(valuePtr), opnd));

	if (TclObjectHasInterface(valuePtr, list, length)
		&& TclObjectHasInterface(valuePtr ,list ,index)) {
	    TCL_UNUSEDVAR(int status);
	    TclObjectDispatchNoDefault(interp, status, valuePtr, list,
		length, interp, valuePtr, &length);

	    /* Decode end-offset index values. */

	    index = TclIndexDecode(opnd, length-1);

	    /* Compute value @ index */
	    if (index >= 0 && index < length) {
		TclObjectDispatchNoDefault(interp, status, valuePtr, list,
		    index, interp, valuePtr, index, &objResultPtr);
		if (objResultPtr == NULL) {
		    CACHE_STACK_INFO();
		    TRACE_ERROR(interp);
		    goto gotError;
		}
	    } else {
		TclNewObj(objResultPtr);
	    }
	    pcAdjustment = 5;
	    goto lindexFastPath2;
	}

	/*
	 * Get the contents of the list, making sure that it really is a list
	 * in the process.
	 */

	/* special case for AbstractList */
	if (TclObjTypeHasProc(valuePtr, indexProc)) {
	    length = TclObjTypeLength(valuePtr);

	if (!TclHasInternalRep(valuePtr, tclListTypePtr)
	    && TclObjectHasInterface(valuePtr, list, index)) {
	    if (Tcl_ListObjLength(interp, valuePtr, &objc) != TCL_OK) {
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    /* Decode end-offset index values. */
	    index = TclIndexDecode(opnd, length-1);

	    if (TclIndexIsFromEnd(opnd) && !Tcl_LengthIsFinite(objc)) {
	    if (index >= 0 && index < length) {
		/* Compute value @ index */
		/* end-relative index, and list end is indeterminate */
		if (TclObjectDispatchNoDefault(interp, dstatus, valuePtr, list, indexEnd,
		DECACHE_STACK_INFO();
		if (TclObjTypeIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) {
		    CACHE_STACK_INFO();
		    interp, valuePtr, index, &objResultPtr) != TCL_OK
		    || dstatus != TCL_OK) {
		    TRACE_ERROR(interp);
		    goto gotError;
		}
		CACHE_STACK_INFO();
	    } else {
		index = TclIndexDecode(opnd, TclIndexLast(objc));
		TclNewObj(objResultPtr);
		if (Tcl_ListObjIndex(interp, valuePtr, index, &objResultPtr)
		    != TCL_OK) {
		    TRACE_ERROR(interp);
		    goto gotError;
		}
	    }
	    if (objResultPtr == NULL) {
		TclNewObj(objResultPtr);

	    }
	    pcAdjustment = 5;
	    goto lindexFastPath2;
	}
	    Tcl_IncrRefCount(objResultPtr);

	    /*
	     * Stash the list element on the stack.
	     */

	    TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
	    /* Already has the correct refCount */
	    NEXT_INST_F(5, 1, -1);
	/* List case */
	if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	} else {
	    if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
		TRACE_ERROR(interp);
		goto gotError;
	    }

	/* Decode end-offset index values. */
	    /* Decode end-offset index values. */

	index = TclIndexDecode(opnd, objc - 1);
	pcAdjustment = 5;
	    index = TclIndexDecode(opnd, TclIndexLast(objc));
	    pcAdjustment = 5;
	}

    lindexFastPath:
	if (index >= 0 && index < objc) {
	    objResultPtr = objv[index];
	} else {
	    TclNewObj(objResultPtr);
	}
4902
4903
4904
4905
4906
4907
4908
4909
4910


4911
4912
4913
4914
4915
4916
4917
4918
4919
4920








4921
4922
4923
4924
4925
4926
4927
4928

4929
4930
4931
4932
4933
4934
4935
4989
4990
4991
4992
4993
4994
4995


4996
4997










4998
4999
5000
5001
5002
5003
5004
5005
5006
5007
5008
5009
5010
5011
5012

5013
5014
5015
5016
5017
5018
5019
5020







-
-
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+







-
+







	Tcl_DecrRefCount(valuePtr); /* This one should be done here */

	/*
	 * Compute the new variable value.
	 */

	DECACHE_STACK_INFO();
	if (TclObjTypeHasProc(valuePtr, setElementProc)) {
	    objResultPtr = TclObjTypeSetElement(interp,
	{
	    int status;
		    valuePtr, numIndices,
		    &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
	} else {
	    objResultPtr = TclLsetFlat(interp, valuePtr, numIndices,
		    &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
	}
	if (!objResultPtr) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	    status = TclLsetFlat(interp, valuePtr, numIndices,
		    &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS, &objResultPtr);

	    if (status != TCL_OK || !objResultPtr) {
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	}

	/*
	 * Set result.
	 */
	CACHE_STACK_INFO();
	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
	NEXT_INST_V(5, numIndices+1, -1);
	NEXT_INST_V(5, numIndices+1, 1);

    case INST_LSET_LIST:	/* 'lset' with 4 args */
	/*
	 * Get the old value of variable, and remove the stack ref. This is
	 * safe because the variable still references the object; the ref
	 * count will never go zero here - we can use the smaller macro
	 * Tcl_DecrRefCount.
4958
4959
4960
4961
4962
4963
4964
4965

4966
4967
4968
4969
4970
4971
4972
5043
5044
5045
5046
5047
5048
5049

5050
5051
5052
5053
5054
5055
5056
5057







-
+







	}

	/*
	 * Set result.
	 */

	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
	NEXT_INST_F(1, 2, -1);
	NEXT_INST_F(1, 2, 1);

    case INST_LIST_RANGE_IMM:	/* lrange with objc==4 and both indices in
				 * bytecode stream */

	/*
	 * Pop the list and get the indices.
	 */
5012
5013
5014
5015
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025


5026
5027
5028
5029


5030
5031
5032
5033
5034
5035
5036
5037
5038











5039
5040

5041

5042
5043




5044
5045
5046
5047
5048
5049

















5050
5051
5052
5053
5054
5055
5056
5057
5058
5059
5060
5061

5062
5063
5064
5065
5066
5067
5068
5069








5070
5071

5072
5073
5074
5075
5076
5077
5078
5079
5080
5081
5082
5083
5084
5085
5086
5087
5088
5089




5090

5091
5092
5093
5094
5095
5096
5097
5098
5099

5100
5101
5102
5103
5104
5105
5106
5107
5108
5109

5110
5111
5112
5113
5114
5115
5116
5117
5097
5098
5099
5100
5101
5102
5103







5104
5105




5106
5107









5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118


5119

5120
5121
5122
5123
5124
5125
5126






5127
5128
5129
5130
5131
5132
5133
5134
5135
5136
5137
5138
5139
5140
5141
5142
5143
5144
5145
5146
5147
5148
5149
5150
5151
5152
5153
5154

5155
5156
5157






5158
5159
5160
5161
5162
5163
5164
5165
5166

5167
5168
5169
5170
5171
5172
5173
5174
5175


5176
5177
5178
5179
5180



5181
5182
5183
5184

5185
5186
5187
5188

5189
5190
5191
5192

5193
5194
5195
5196
5197
5198
5199
5200



5201

5202
5203
5204
5205
5206
5207
5208







-
-
-
-
-
-
-
+
+
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
+
-
+


+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+











-
+


-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
+








-
-





-
-
-
+
+
+
+
-
+



-




-
+







-
-
-
+
-








	if (toIdx == TCL_INDEX_NONE) {
	emptyList:
	    TclNewObj(objResultPtr);
	    TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
	    NEXT_INST_F(9, 1, 1);
	}
	toIdx = TclIndexDecode(toIdx, objc - 1);
	if (toIdx == TCL_INDEX_NONE) {
	    goto emptyList;
	} else if (toIdx >= objc) {
	    toIdx = objc - 1;
	}


	toIdxAnchor = TclIndexIsFromEnd(toIdx);
	assert (toIdx >= 0 && toIdx < objc);
	/*
	assert ( fromIdx != TCL_INDEX_NONE );
	 *
	fromIdxAnchor = TclIndexIsFromEnd(fromIdx);

	 * Extra safety for legacy bytecodes:
	 */
	if (fromIdx == TCL_INDEX_NONE) {
	    fromIdx = TCL_INDEX_START;
	}

	fromIdx = TclIndexDecode(fromIdx, objc - 1);

	DECACHE_STACK_INFO();
	DECACHE_STACK_INFO();
	if (!Tcl_LengthIsFinite(objc)
	    && (toIdxAnchor == 1 || fromIdxAnchor == 1)) {

	    toIdx = TclIndexDecode(toIdx, SIZE_MAX);
	    fromIdx = TclIndexDecode(fromIdx, SIZE_MAX);
	    dstatus = TclObjectInterfaceCall(valuePtr, list, rangeEnd,
		interp, valuePtr, toIdxAnchor, toIdx, fromIdxAnchor,
		fromIdx, &objResultPtr);
	    if (dstatus != TCL_OK || objResultPtr == NULL) {
		CACHE_STACK_INFO();
	if (TclObjTypeHasProc(valuePtr, sliceProc)) {
	    if (TclObjTypeSlice(interp, valuePtr, fromIdx, toIdx, &objResultPtr) != TCL_OK) {
		TRACE_ERROR(interp);
		objResultPtr = NULL;
		goto gotError;
	    }
	} else {
	    toIdx = TclIndexDecode(toIdx, TclIndexLast(objc));
	    if (toIdx == TCL_INDEX_NONE) {
		goto emptyList;
	    } else if (Tcl_LengthIsFinite(objc) && toIdx + 1 >= objc + 1) {
	    objResultPtr = TclListObjRange(interp, valuePtr, fromIdx, toIdx);
	}
	if (objResultPtr == NULL) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
		toIdx = TclIndexLast(objc);
	    }

	    assert (toIdx < objc);
	    /*
	    assert ( fromIdx != TCL_INDEX_NONE );
	     *
	     * Extra safety for legacy bytecodes:
	     */
	    if (fromIdx == TCL_INDEX_NONE) {
		fromIdx = TCL_INDEX_START;
	    }

	    fromIdx = TclIndexDecode(fromIdx, objc - 1);

	    /* to do:  catch status? */
	    TclListObjRange(interp, valuePtr, fromIdx, toIdx, &objResultPtr);
	}

	CACHE_STACK_INFO();
	TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
	NEXT_INST_F(9, 1, 1);

    case INST_LIST_IN:
    case INST_LIST_NOT_IN:	/* Basic list containment operators. */
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;

	s1 = TclGetStringFromObj(valuePtr, &s1len);
	s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));

	if (TclObjTypeHasProc(value2Ptr, inOperProc) != NULL) {
	    int status = TclObjTypeInOperator(interp, valuePtr, value2Ptr, &match);
	    if (status != TCL_OK) {
		TRACE_ERROR(interp);
		goto gotError;
	    }
	if (TclObjectHasInterface(value2Ptr, list, contains)) {
	    int status;
            TclObjectDispatchNoDefault(interp, status, value2Ptr, list,
		contains, interp, value2Ptr, valuePtr, &match);
            if (status != TCL_OK) {
                TRACE_ERROR(interp);
                goto gotError;
            }
	} else {

	    TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
	    if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) {
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    match = 0;
	    if (length > 0) {
		Tcl_Size i = 0;
		Tcl_Obj *o;
		int isAbstractList = TclObjTypeHasProc(value2Ptr, indexProc) != NULL;

		/*
		 * An empty list doesn't match anything.
		 */

		do {
		    if (isAbstractList) {
			DECACHE_STACK_INFO();
			if (TclObjTypeIndex(interp, value2Ptr, i, &o) != TCL_OK) {
		    if (TclObjectHasInterface(valuePtr, list, index)) {
			TCL_UNUSEDVAR(int status);
			TclObjectDispatchNoDefault(interp, status, value2Ptr, list,
			    index, interp, value2Ptr, i, &o);
			    CACHE_STACK_INFO();
			if (!o) {
			    TRACE_ERROR(interp);
			    goto gotError;
			}
			CACHE_STACK_INFO();
		    } else {
			Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
		    }
		    if (o != NULL) {
			s2 = TclGetStringFromObj(o, &s2len);
			s2 = Tcl_GetStringFromObj(o, &s2len);
		    } else {
			s2 = "";
			s2len = 0;
		    }
		    if (s1len == s2len) {
			match = (memcmp(s1, s2, s1len) == 0);
		    }

		    /* Could be an ephemeral abstract obj */
		    Tcl_BounceRefCount(o);
		    TclBounceRefCount(o);

		    i++;
		} while (i < length && match == 0);
	    }
	}

	if (*pc == INST_LIST_NOT_IN) {
	    match = !match;
5178
5179
5180
5181
5182
5183
5184
5185

5186
5187
5188
5189
5190
5191
5192
5193
5194
5195
5196
5197
5198
5199
5200
5201
5202
5203

5204
5205
5206
5207
5208
5209
5210
5269
5270
5271
5272
5273
5274
5275

5276
5277
5278
5279
5280
5281
5282
5283
5284
5285
5286
5287
5288
5289
5290
5291
5292
5293

5294
5295
5296
5297
5298
5299
5300
5301







-
+

















-
+








	if (TclGetIntForIndexM(interp, fromIdxObj, length - end_indicator,
		&fromIdx) != TCL_OK) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	if (fromIdx == TCL_INDEX_NONE) {
	if (fromIdx < 0) {
	    fromIdx = 0;
	} else if (fromIdx > length) {
	    fromIdx = length;
	}
	numToDelete = 0;
	if (toIdxObj) {
	    if (TclGetIntForIndexM(interp, toIdxObj, length - end_indicator,
		    &toIdx) != TCL_OK) {
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    if (toIdx != TCL_INDEX_NONE) {
		if (toIdx > length) {
		    toIdx = length;
		}
		if (toIdx >= fromIdx) {
		    numToDelete = (size_t)toIdx - (size_t)fromIdx + 1;
		    numToDelete = toIdx - fromIdx + 1;
		}
	    }
	}

	CACHE_STACK_INFO();

	if (Tcl_IsShared(valuePtr)) {
5300
5301
5302
5303
5304
5305
5306
5307

5308
5309
5310
5311
5312
5313
5314
5315
5316
5317
5318
5319
5320
5321
5322
5323
5324

5325
5326
5327
5328
5329
5330
5331
5332
5333
5334
5335
5336
5337
5338
5339
5340
5341

5342
5343
5344
5345
5346
5347
5348
5391
5392
5393
5394
5395
5396
5397

5398
5399
5400
5401
5402
5403
5404
5405
5406
5407
5408
5409
5410
5411
5412
5413
5414

5415
5416
5417
5418
5419
5420
5421
5422
5423
5424
5425
5426
5427
5428
5429
5430
5431

5432
5433
5434
5435
5436
5437
5438
5439







-
+
















-
+
















-
+







	TRACE(("\"%.20s\" => %" TCL_Z_MODIFIER "u\n", O2S(valuePtr), slength));
	NEXT_INST_F(1, 1, 1);

    case INST_STR_UPPER:
	valuePtr = OBJ_AT_TOS;
	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
	if (Tcl_IsShared(valuePtr)) {
	    s1 = TclGetStringFromObj(valuePtr, &slength);
	    s1 = Tcl_GetStringFromObj(valuePtr, &slength);
	    TclNewStringObj(objResultPtr, s1, slength);
	    slength = Tcl_UtfToUpper(TclGetString(objResultPtr));
	    Tcl_SetObjLength(objResultPtr, slength);
	    TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
	    NEXT_INST_F(1, 1, 1);
	} else {
	    slength = Tcl_UtfToUpper(TclGetString(valuePtr));
	    Tcl_SetObjLength(valuePtr, slength);
	    TclFreeInternalRep(valuePtr);
	    TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 0, 0);
	}
    case INST_STR_LOWER:
	valuePtr = OBJ_AT_TOS;
	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
	if (Tcl_IsShared(valuePtr)) {
	    s1 = TclGetStringFromObj(valuePtr, &slength);
	    s1 = Tcl_GetStringFromObj(valuePtr, &slength);
	    TclNewStringObj(objResultPtr, s1, slength);
	    slength = Tcl_UtfToLower(TclGetString(objResultPtr));
	    Tcl_SetObjLength(objResultPtr, slength);
	    TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
	    NEXT_INST_F(1, 1, 1);
	} else {
	    slength = Tcl_UtfToLower(TclGetString(valuePtr));
	    Tcl_SetObjLength(valuePtr, slength);
	    TclFreeInternalRep(valuePtr);
	    TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 0, 0);
	}
    case INST_STR_TITLE:
	valuePtr = OBJ_AT_TOS;
	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
	if (Tcl_IsShared(valuePtr)) {
	    s1 = TclGetStringFromObj(valuePtr, &slength);
	    s1 = Tcl_GetStringFromObj(valuePtr, &slength);
	    TclNewStringObj(objResultPtr, s1, slength);
	    slength = Tcl_UtfToTitle(TclGetString(objResultPtr));
	    Tcl_SetObjLength(objResultPtr, slength);
	    TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
	    NEXT_INST_F(1, 1, 1);
	} else {
	    slength = Tcl_UtfToTitle(TclGetString(valuePtr));
5358
5359
5360
5361
5362
5363
5364








5365
5366
5367
5368
5369
5370
5371







5372
5373
5374
5375
5376
5377
5378
5379
5380
5381
5382
5383











5384
5385
5386
5387
5388
5389
5390
5391
5392
5393
5394
5395
5396
5397













5398
5399
5400
5401
5402
5403
5404
5449
5450
5451
5452
5453
5454
5455
5456
5457
5458
5459
5460
5461
5462
5463







5464
5465
5466
5467
5468
5469
5470
5471











5472
5473
5474
5475
5476
5477
5478
5479
5480
5481
5482
5483













5484
5485
5486
5487
5488
5489
5490
5491
5492
5493
5494
5495
5496
5497
5498
5499
5500
5501
5502
5503







+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+







	TRACE(("\"%.20s\" %.20s => ", O2S(valuePtr), O2S(value2Ptr)));

	/*
	 * Get char length to calculate what 'end' means.
	 */

	slength = Tcl_GetCharLength(valuePtr);
	if (TclObjectHasInterface(valuePtr, string, index)) {
	    int status;
	    status = TclStringIndexInterface(interp, valuePtr, value2Ptr, &objResultPtr);
	    if (status != TCL_OK) {
		TRACE_ERROR(interp);
		goto gotError;
	    }
	} else {
	DECACHE_STACK_INFO();
	if (TclGetIntForIndexM(interp, value2Ptr, slength-1, &index)!=TCL_OK) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	CACHE_STACK_INFO();
	    DECACHE_STACK_INFO();
	    if (TclGetIntForIndexM(interp, value2Ptr, slength-1, &index)!=TCL_OK) {
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    CACHE_STACK_INFO();

	if (index < 0 || index >= slength) {
	    TclNewObj(objResultPtr);
	} else if (TclIsPureByteArray(valuePtr)) {
	    objResultPtr = Tcl_NewByteArrayObj(
		    Tcl_GetBytesFromObj(NULL, valuePtr, (Tcl_Size *)NULL)+index, 1);
	} else if (valuePtr->bytes && slength == valuePtr->length) {
	    objResultPtr = Tcl_NewStringObj((const char *)
		    valuePtr->bytes+index, 1);
	} else {
	    char buf[4] = "";
	    int ch = Tcl_GetUniChar(valuePtr, index);
	    if (index < 0 || index >= slength) {
		TclNewObj(objResultPtr);
	    } else if (TclIsPureByteArray(valuePtr)) {
		objResultPtr = Tcl_NewByteArrayObj(
			Tcl_GetBytesFromObj(NULL, valuePtr, NULL)+index, 1);
	    } else if (valuePtr->bytes && slength == valuePtr->length) {
		objResultPtr = Tcl_NewStringObj((const char *)
			valuePtr->bytes+index, 1);
	    } else {
		char buf[4] = "";
		int ch = Tcl_GetUniChar(valuePtr, index);

	    /*
	     * This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1)
	     * but creating the object as a string seems to be faster in
	     * practical use.
	     */
	    if (ch == -1) {
		TclNewObj(objResultPtr);
	    } else {
		slength = Tcl_UniCharToUtf(ch, buf);
		objResultPtr = Tcl_NewStringObj(buf, slength);
	    }
	}

		/*
		 * This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1)
		 * but creating the object as a string seems to be faster in
		 * practical use.
		 */
		if (ch == -1) {
		    TclNewObj(objResultPtr);
		} else {
		    slength = Tcl_UniCharToUtf(ch, buf);
		    objResultPtr = Tcl_NewStringObj(buf, slength);
		}
	    }
	}
	TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);

    case INST_STR_RANGE:
	TRACE(("\"%.20s\" %.20s %.20s =>",
		O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
	slength = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1;
5433
5434
5435
5436
5437
5438
5439
























5440

5441









5442
5443
5444
5445
5446
5447

































5448
5449
5450
5451
5452
5453
5454
5532
5533
5534
5535
5536
5537
5538
5539
5540
5541
5542
5543
5544
5545
5546
5547
5548
5549
5550
5551
5552
5553
5554
5555
5556
5557
5558
5559
5560
5561
5562

5563
5564
5565
5566
5567
5568
5569
5570
5571
5572
5573






5574
5575
5576
5577
5578
5579
5580
5581
5582
5583
5584
5585
5586
5587
5588
5589
5590
5591
5592
5593
5594
5595
5596
5597
5598
5599
5600
5601
5602
5603
5604
5605
5606
5607
5608
5609
5610
5611
5612
5613







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+

+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








	/* Every range of an empty value is an empty value */
	if (slength == 0) {
	    TRACE_APPEND(("\n"));
	    NEXT_INST_F(9, 0, 0);
	}

	if (TclObjectHasInterface(valuePtr, list, index)) {
	    if ((TclIndexIsFromEnd(toIdx) || TclIndexIsFromEnd(fromIdx))
		&& !Tcl_LengthIsFinite(slength)) {

		fromIdx = TclIndexDecode(fromIdx, TclIndexLast(slength));
		toIdx = TclIndexDecode(toIdx, TclIndexLast(slength));

		if (TclObjectInterfaceCall(valuePtr,
		    string, rangeEnd, valuePtr, fromIdx, toIdx, &objResultPtr)
		    != TCL_OK || objResultPtr == NULL) {
		    TRACE_ERROR(interp);
		    goto gotError;
		}
	    } else {
		fromIdx = TclIndexDecode(fromIdx, TclIndexLast(slength));
		toIdx = TclIndexDecode(toIdx, TclIndexLast(slength));
		if (TclObjectInterfaceCall(valuePtr, string, range, valuePtr,
		    fromIdx, toIdx, &objResultPtr)
		    != TCL_OK || objResultPtr == NULL) {
		    TRACE_ERROR(interp);
		    goto gotError;
		}
	    }
	} else {
	/* Decode index operands. */
	    /* Decode index operands. */

	    /*
	    assert ( toIdx != TCL_INDEX_NONE );
	     *
	     * Extra safety for legacy bytecodes:
	     */
	    if (toIdx == TCL_INDEX_NONE) {
		goto emptyRange;
	    }

	toIdx = TclIndexDecode(toIdx, slength - 1);
	fromIdx = TclIndexDecode(fromIdx, slength - 1);
	if (toIdx == TCL_INDEX_NONE) {
	    TclNewObj(objResultPtr);
	} else {
	    objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
	    toIdx = TclIndexDecode(toIdx, slength - 1);
	    if (toIdx == TCL_INDEX_NONE) {
		goto emptyRange;
	    } else if (toIdx >= slength) {
		toIdx = slength - 1;
	    }

	    assert ( toIdx != TCL_INDEX_NONE && toIdx < slength );

	    /*
	    assert ( fromIdx != TCL_INDEX_NONE );
	     *
	     * Extra safety for legacy bytecodes:
	     */
	    if (fromIdx == TCL_INDEX_NONE) {
		fromIdx = TCL_INDEX_START;
	    }

	    fromIdx = TclIndexDecode(fromIdx, slength - 1);
	    if (fromIdx == TCL_INDEX_NONE) {
		fromIdx = TCL_INDEX_START;
	    }

	    if (fromIdx + 1 <= toIdx + 1) {
		objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
		if (objResultPtr == NULL) {
		    TRACE_ERROR(interp);
		    goto gotError;
		}
	    } else {
	    emptyRange:
		TclNewObj(objResultPtr);
	    }
	}
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_F(9, 1, 1);

    {
	Tcl_UniChar *ustring1, *ustring2, *ustring3, *end, *p;
	Tcl_Size length3;
5653
5654
5655
5656
5657
5658
5659
5660
5661


5662
5663
5664
5665
5666
5667
5668
5669


5670
5671
5672
5673
5674
5675
5676
5677


5678
5679
5680
5681
5682
5683
5684
5812
5813
5814
5815
5816
5817
5818


5819
5820
5821
5822
5823
5824
5825
5826


5827
5828
5829
5830
5831
5832
5833
5834


5835
5836
5837
5838
5839
5840
5841
5842
5843







-
-
+
+






-
-
+
+






-
-
+
+







    {
	const char *string1, *string2;
	Tcl_Size trim1, trim2;

    case INST_STR_TRIM_LEFT:
	valuePtr = OBJ_UNDER_TOS;	/* String */
	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
	string2 = TclGetStringFromObj(value2Ptr, &length2);
	string1 = TclGetStringFromObj(valuePtr, &slength);
	string2 = Tcl_GetStringFromObj(value2Ptr, &length2);
	string1 = Tcl_GetStringFromObj(valuePtr, &slength);
	trim1 = TclTrimLeft(string1, slength, string2, length2);
	trim2 = 0;
	goto createTrimmedString;
    case INST_STR_TRIM_RIGHT:
	valuePtr = OBJ_UNDER_TOS;	/* String */
	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
	string2 = TclGetStringFromObj(value2Ptr, &length2);
	string1 = TclGetStringFromObj(valuePtr, &slength);
	string2 = Tcl_GetStringFromObj(value2Ptr, &length2);
	string1 = Tcl_GetStringFromObj(valuePtr, &slength);
	trim2 = TclTrimRight(string1, slength, string2, length2);
	trim1 = 0;
	goto createTrimmedString;
    case INST_STR_TRIM:
	valuePtr = OBJ_UNDER_TOS;	/* String */
	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
	string2 = TclGetStringFromObj(value2Ptr, &length2);
	string1 = TclGetStringFromObj(valuePtr, &slength);
	string2 = Tcl_GetStringFromObj(value2Ptr, &length2);
	string1 = Tcl_GetStringFromObj(valuePtr, &slength);
	trim1 = TclTrim(string1, slength, string2, length2, &trim2);
    createTrimmedString:
	/*
	 * Careful here; trim set often contains non-ASCII characters so we
	 * take care when printing. [Bug 971cb4f1db]
	 */

5765
5766
5767
5768
5769
5770
5771
5772

5773
5774
5775
5776
5777
5778
5779
5780
5781





5782








5783
5784
5785
5786
5787
5788
5789
5924
5925
5926
5927
5928
5929
5930

5931
5932
5933
5934
5935
5936
5937
5938
5939

5940
5941
5942
5943
5944
5945
5946
5947
5948
5949
5950
5951
5952
5953
5954
5955
5956
5957
5958
5959
5960







-
+








-
+
+
+
+
+

+
+
+
+
+
+
+
+








    case INST_EQ:
    case INST_NEQ:
    case INST_LT:
    case INST_GT:
    case INST_LE:
    case INST_GE: {
	int iResult = 0, compare = 0;
	int isEmpty, iResult = 0, compare = 0, status;

	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;

	/*
	    Try to determine, without triggering generation of a string
	    representation, whether one value is not a number.
	*/
	if (TclCheckEmptyString(valuePtr) > 0 || TclCheckEmptyString(value2Ptr) > 0) {
	status = TclCheckEmptyString(interp, valuePtr, &isEmpty);
	if (status) {
	    goto gotError;
	}
	if (isEmpty > 0) {
	    goto stringCompare;
	} else {
	    status = TclCheckEmptyString(interp, value2Ptr ,&isEmpty);
	    if (status) {
		goto gotError;
	    }
	    if (isEmpty > 0) {
		goto stringCompare;
	    }
	}

	if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK
		|| GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) {
	    /*
	     * At least one non-numeric argument - compare as strings.
	     */
6397
6398
6399
6400
6401
6402
6403
6404

6405
6406
6407
6408
6409
6410
6411
6568
6569
6570
6571
6572
6573
6574

6575
6576
6577
6578
6579
6580
6581
6582







-
+







	if (valuePtr->bytes == NULL) {
	    TRACE_APPEND(("numeric, same Tcl_Obj\n"));
	    NEXT_INST_F(1, 0, 0);
	}
	if (Tcl_IsShared(valuePtr)) {
	    /*
	     * Here we do some surgery within the Tcl_Obj internals. We want
	     * to copy the internalrep, but not the string, so we temporarily hide
	     * to copy the intrep, but not the string, so we temporarily hide
	     * the string so we do not copy it.
	     */

	    char *savedString = valuePtr->bytes;

	    valuePtr->bytes = NULL;
	    objResultPtr = Tcl_DuplicateObj(valuePtr);
6422
6423
6424
6425
6426
6427
6428
6429

6430
6431
6432
6433
6434
6435
6436
6593
6594
6595
6596
6597
6598
6599

6600
6601
6602
6603
6604
6605
6606
6607







-
+







    /*
     *	   End of numeric operator instructions.
     * -----------------------------------------------------------------
     */

    case INST_TRY_CVT_TO_BOOLEAN:
	valuePtr = OBJ_AT_TOS;
	if (TclHasInternalRep(valuePtr,  &tclBooleanType)) {
	if (TclHasInternalRep(valuePtr, tclBooleanTypePtr)) {
	    objResultPtr = TCONST(1);
	} else {
	    int res = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK);
	    objResultPtr = TCONST(res);
	}
	TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr);
	NEXT_INST_F(1, 0, 1);
6491
6492
6493
6494
6495
6496
6497

6498






6499
6500
6501
6502
6503
6504
6505
6662
6663
6664
6665
6666
6667
6668
6669

6670
6671
6672
6673
6674
6675
6676
6677
6678
6679
6680
6681
6682







+
-
+
+
+
+
+
+







	    if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
		CACHE_STACK_INFO();
		TRACE_APPEND(("ERROR converting list %" TCL_Z_MODIFIER "d, \"%s\": %s",
			i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
		goto gotError;
	    }
	    if (Tcl_IsShared(listPtr)) {
		DECACHE_STACK_INFO();
		objPtr = TclListObjCopy(NULL, listPtr);
		objPtr = TclDuplicatePureObj(
		    interp, listPtr, tclListTypePtr);
		CACHE_STACK_INFO();
		if (!objPtr) {
		    goto gotError;
		}
		Tcl_IncrRefCount(objPtr);
		Tcl_DecrRefCount(listPtr);
		OBJ_AT_DEPTH(listTmpDepth) = objPtr;
	    }
	    iterTmp = (listLen + (numVars - 1))/numVars;
	    if (iterTmp > iterMax) {
		iterMax = iterTmp;
6565
6566
6567
6568
6569
6570
6571
6572
6573
6574
6575
6576
6577

6578
6579
6580
6581
6582
6583
6584
6585
6586
6587
6588
6589
6590
6591
6592
6593
6594
6595
6596
6742
6743
6744
6745
6746
6747
6748

6749
6750

6751

6752
6753
6754
6755
6756
6757
6758
6759
6760
6761
6762


6763
6764
6765
6766
6767
6768
6769







-


-

-
+










-
-







	    tmpPtr->internalRep.twoPtrValue.ptr1 =(void *)(iterNum + 1);

	    listTmpDepth = numLists + 1;

	    for (i = 0;  i < numLists;  i++) {
		varListPtr = infoPtr->varLists[i];
		numVars = varListPtr->numVars;
		int hasAbstractList;

		listPtr = OBJ_AT_DEPTH(listTmpDepth);
		hasAbstractList = TclObjTypeHasProc(listPtr, indexProc) != 0;
		DECACHE_STACK_INFO();
		if (hasAbstractList) {
		if (TclObjectHasInterface(listPtr, list, index)) {
		    status = Tcl_ListObjLength(interp, listPtr, &listLen);
		    elements = NULL;
		} else {
		    status = TclListObjGetElements(
			interp, listPtr, &listLen, &elements);
		}
		if (status != TCL_OK) {
		    CACHE_STACK_INFO();
		    goto gotError;
		}
		CACHE_STACK_INFO();

		valIndex = (iterNum * numVars);
		for (j = 0;  j < numVars;  j++) {
		    if (valIndex >= listLen) {
			TclNewObj(valuePtr);
		    } else {
			DECACHE_STACK_INFO();
			if (elements) {
7126
7127
7128
7129
7130
7131
7132
7133

7134
7135
7136
7137
7138
7139
7140
7299
7300
7301
7302
7303
7304
7305

7306
7307
7308
7309
7310
7311
7312
7313







-
+







	TRACE(("%u => ", opnd));
	dictPtr = POP_OBJECT();
	searchPtr = (Tcl_DictSearch *)Tcl_Alloc(sizeof(Tcl_DictSearch));
	if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr,
		&valuePtr, &done) != TCL_OK) {
	    /*
	     * dictPtr is no longer on the stack, and we're not
	     * moving it into the internalrep of an iterator.  We need
	     * moving it into the intrep of an iterator.  We need
	     * to drop the refcount [Tcl Bug 9b352768e6].
	     */

	    Tcl_DecrRefCount(dictPtr);
	    Tcl_Free(searchPtr);
	    TRACE_ERROR(interp);
	    goto gotError;
7739
7740
7741
7742
7743
7744
7745
7746

7747
7748
7749


7750
7751
7752
7753
7754
7755
7756
7912
7913
7914
7915
7916
7917
7918

7919
7920


7921
7922
7923
7924
7925
7926
7927
7928
7929







-
+

-
-
+
+







    iPtr->cmdFramePtr = bcFramePtr->nextPtr;
    TclReleaseByteCode(codePtr);
    TclStackFree(interp, TD);	/* free my stack */

    return result;

    /*
     * INST_START_CMD failure case removed where it doesn't bother that much
     * INST_START_CMD failure case removed where it doesn't bother that much.
     *
     * Remark that if the interpreter is marked for deletion its
     * compileEpoch is modified, so that the epoch check also verifies
     * If the interpreter is marked for deletion, its
     * compileEpoch is modified, Therefore the epoch check also verifies
     * that the interp is not deleted. If no outside call has been made
     * since the last check, it is safe to omit the check.

     * case INST_START_CMD:
     */

	instStartCmdFailed:
8475
8476
8477
8478
8479
8480
8481
8482

8483
8484
8485
8486
8487
8488
8489
8648
8649
8650
8651
8652
8653
8654

8655
8656
8657
8658
8659
8660
8661
8662







-
+







		WIDE_RESULT(wResult);
	    }
	}

    overflowExpon:

	if ((TclGetWideIntFromObj(NULL, value2Ptr, &w2) != TCL_OK)
		|| !TclHasInternalRep(value2Ptr, &tclIntType)
		|| !TclHasInternalRep(value2Ptr, tclIntTypePtr)
		|| (Tcl_WideUInt)w2 >= (1<<28)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "exponent too large", -1));
	    return GENERAL_ARITHMETIC_ERROR;
	}
	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
	err = mp_init(&bigResult);
9106
9107
9108
9109
9110
9111
9112
9113

9114
9115
9116
9117
9118
9119
9120
9121
9122


9123
9124
9125
9126






9127
9128
9129
9130
9131
9132
9133
9279
9280
9281
9282
9283
9284
9285

9286
9287
9288
9289
9290
9291
9292
9293
9294
9295
9296
9297




9298
9299
9300
9301
9302
9303
9304
9305
9306
9307
9308
9309
9310







-
+









+
+
-
-
-
-
+
+
+
+
+
+







	op = "**";
    } else if (opcode <= INST_LNOT) {
	op = operatorStrings[opcode - INST_BITOR];
    }

    if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) {
	Tcl_Size length;
	if (TclHasInternalRep(opndPtr, &tclDictType)) {
	if (TclHasInternalRep(opndPtr, tclDictTypePtr)) {
	    Tcl_DictObjSize(NULL, opndPtr, &length);
	    if (length > 1) {
	    listRep:
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"cannot use a list as %soperand of \"%s\"", ord, op));
		Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "list", (char *)NULL);
		return;
	    }
	}
	if (TclObjectHasInterface(opndPtr ,list ,length)) {
	    int status;
	Tcl_ObjTypeLengthProc *lengthProc = TclObjTypeHasProc(opndPtr, lengthProc);
	if (lengthProc && lengthProc(opndPtr) > 1) {
	    goto listRep;
	}
	    status = Tcl_ListObjLength(interp,opndPtr,&length);
	    if (!status && length > 1) {
		goto listRep;
	    }
	}

	description = "non-numeric string";
    } else if (type == TCL_NUMBER_NAN) {
	description = "non-numeric floating-point value";
    } else if (type == TCL_NUMBER_DOUBLE) {
	description = "floating-point value";
    } else {
	/* TODO: No caller needs this. Eliminate? */
9744
9745
9746
9747
9748
9749
9750
9751

9752
9753
9754
9755
9756
9757
9758
9921
9922
9923
9924
9925
9926
9927

9928
9929
9930
9931
9932
9933
9934
9935







-
+







    strBytesSharedOnce = 0.0;
    for (ui = 0;  ui < globalTablePtr->numBuckets;  ui++) {
	for (entryPtr = globalTablePtr->buckets[i];  entryPtr != NULL;
		entryPtr = entryPtr->nextPtr) {
	    if (TclHasInternalRep(entryPtr->objPtr, &tclByteCodeType)) {
		numByteCodeLits++;
	    }
	    (void) TclGetStringFromObj(entryPtr->objPtr, &length);
	    (void) Tcl_GetStringFromObj(entryPtr->objPtr, &length);
	    refCountSum += entryPtr->refCount;
	    objBytesIfUnshared += (entryPtr->refCount * sizeof(Tcl_Obj));
	    strBytesIfUnshared += (entryPtr->refCount * (length+1));
	    if (entryPtr->refCount > 1) {
		numSharedMultX++;
		strBytesSharedMultX += (length+1);
	    } else {
9970
9971
9972
9973
9974
9975
9976
9977

9978
9979
9980
9981
9982
9983
9984
10147
10148
10149
10150
10151
10152
10153

10154
10155
10156
10157
10158
10159
10160
10161







-
+







#endif
    Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");

    if (objc == 1) {
	Tcl_SetObjResult(interp, objPtr);
    } else {
	Tcl_Channel outChan;
	char *str = TclGetStringFromObj(objv[1], &length);
	char *str = Tcl_GetStringFromObj(objv[1], &length);

	if (length) {
	    if (strcmp(str, "stdout") == 0) {
		outChan = Tcl_GetStdChannel(TCL_STDOUT);
	    } else if (strcmp(str, "stderr") == 0) {
		outChan = Tcl_GetStdChannel(TCL_STDERR);
	    } else {
Changes to generic/tclFCmd.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclFCmd.c
 *
 *	This file implements the generic portion of file manipulation
 *	subcommands of the "file" command.
 *
 * Copyright © 1996-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclFCmd.c
 *
 *	This file implements the generic portion of file manipulation
 *	subcommands of the "file" command.
 */

#include "tclInt.h"
#include "tclFileSystem.h"

/*
 * Declarations for local functions defined in this file:
 */

1442
1443
1444
1445
1446
1447
1448
1449

1450
1451
1452
1453
1454
1455
1456
1453
1454
1455
1456
1457
1458
1459

1460
1461
1462
1463
1464
1465
1466
1467







-
+







    if (objc > 1) {
	nameVarObj = objv[1];
	TclNewObj(nameObj);
    }
    if (objc > 2) {
	Tcl_Size length;
	Tcl_Obj *templateObj = objv[2];
	const char *string = TclGetStringFromObj(templateObj, &length);
	const char *string = Tcl_GetStringFromObj(templateObj, &length);

	/*
	 * Treat an empty string as if it wasn't there.
	 */

	if (length == 0) {
	    goto makeTemporary;
1515
1516
1517
1518
1519
1520
1521
1522

1523
1524
1525
1526
1527
1528
1529
1526
1527
1528
1529
1530
1531
1532

1533
1534
1535
1536
1537
1538
1539
1540







-
+







    }

    /*
     * Create and open the temporary file.
     */

  makeTemporary:
    chan = TclpOpenTemporaryFile(tempDirObj,tempBaseObj,tempExtObj, nameObj);
    chan = TclpOpenTemporaryFile(tempDirObj, tempBaseObj, tempExtObj, nameObj);

    /*
     * If we created pieces of template, get rid of them now.
     */

    if (tempDirObj) {
	TclDecrRefCount(tempDirObj);
1594
1595
1596
1597
1598
1599
1600
1601

1602
1603
1604
1605
1606
1607
1608
1605
1606
1607
1608
1609
1610
1611

1612
1613
1614
1615
1616
1617
1618
1619







-
+







	Tcl_WrongNumArgs(interp, 1, objv, "?template?");
	return TCL_ERROR;
    }

    if (objc > 1) {
	Tcl_Size length;
	Tcl_Obj *templateObj = objv[1];
	const char *string = TclGetStringFromObj(templateObj, &length);
	const char *string = Tcl_GetStringFromObj(templateObj, &length);
	const int onWindows = (tclPlatform == TCL_PLATFORM_WINDOWS);

	/*
	 * Treat an empty string as if it wasn't there.
	 */

	if (length == 0) {
Changes to generic/tclFileName.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
















14
15
16
17
18
19
20
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

-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclFileName.c --
 *
 *	This file contains routines for converting file names betwen native
 *	and network form.
 *
 * Copyright © 1995-1998 Sun Microsystems, Inc.
 * Copyright © 1998-1999 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclFileName.c --
 *
 *	This file contains routines for converting file names betwen native
 *	and network form.
 */

#include "tclInt.h"
#include "tclRegexp.h"
#include "tclFileSystem.h" /* For TclGetPathType() */

/*
 * The following variable is set in the TclPlatformInit call to one of:
 * TCL_PLATFORM_UNIX or TCL_PLATFORM_WINDOWS.
344
345
346
347
348
349
350
351

352
353
354
355
356
357
358
355
356
357
358
359
360
361

362
363
364
365
366
367
368
369







-
+







 */

Tcl_PathType
Tcl_GetPathType(
    const char *path)
{
    Tcl_PathType type;
    Tcl_Obj *tempObj = Tcl_NewStringObj(path,-1);
    Tcl_Obj *tempObj = Tcl_NewStringObj(path, -1);

    Tcl_IncrRefCount(tempObj);
    type = Tcl_FSGetPathType(tempObj);
    Tcl_DecrRefCount(tempObj);
    return type;
}

377
378
379
380
381
382
383
384
385



386
387
388
389
390
391
392
388
389
390
391
392
393
394


395
396
397
398
399
400
401
402
403
404







-
-
+
+
+







 *
 *----------------------------------------------------------------------
 */

Tcl_PathType
TclpGetNativePathType(
    Tcl_Obj *pathPtr,		/* Native path of interest */
    Tcl_Size *driveNameLengthPtr, /* Returns length of drive, if non-NULL and
				   * path was absolute */
    Tcl_Size *driveNameLengthPtr,
				/* Returns length of drive, if non-NULL and
				 * path was absolute */
    Tcl_Obj **driveNameRef)
{
    Tcl_PathType type = TCL_PATH_ABSOLUTE;
    const char *path = TclGetString(pathPtr);

    switch (tclPlatform) {
    case TCL_PLATFORM_UNIX: {
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
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







-
+



















-
+







    /*
     * Calculate space required for the result.
     */

    size = 1;
    for (i = 0; i < *argcPtr; i++) {
	Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
	(void)TclGetStringFromObj(eltPtr, &len);
	(void)Tcl_GetStringFromObj(eltPtr, &len);
	size += len + 1;
    }

    /*
     * Allocate a buffer large enough to hold the contents of all of the list
     * plus the argv pointers and the terminating NULL pointer.
     */

    *argvPtr = (const char **)Tcl_Alloc(
	    ((((*argcPtr) + 1) * sizeof(char *)) + size));

    /*
     * Position p after the last argv pointer and copy the contents of the
     * list in, piece by piece.
     */

    p = (char *) &(*argvPtr)[(*argcPtr) + 1];
    for (i = 0; i < *argcPtr; i++) {
	Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
	str = TclGetStringFromObj(eltPtr, &len);
	str = Tcl_GetStringFromObj(eltPtr, &len);
	memcpy(p, str, len + 1);
	p += len+1;
    }

    /*
     * Now set up the argv pointers.
     */
808
809
810
811
812
813
814
815

816
817
818
819
820
821
822
820
821
822
823
824
825
826

827
828
829
830
831
832
833
834







-
+







{
    int needsSep;
    Tcl_Size length;
    char *dest;
    const char *p;
    const char *start;

    start = TclGetStringFromObj(prefix, &length);
    start = Tcl_GetStringFromObj(prefix, &length);

    /*
     * Remove the ./ from drive-letter prefixed
     * elements on Windows, unless it is the first component.
     */

    p = joining;
836
837
838
839
840
841
842
843

844
845
846
847
848
849
850
848
849
850
851
852
853
854

855
856
857
858
859
860
861
862







-
+







    case TCL_PLATFORM_UNIX:
	/*
	 * Append a separator if needed.
	 */

	if (length > 0 && (start[length-1] != '/')) {
	    Tcl_AppendToObj(prefix, "/", 1);
	    (void)TclGetStringFromObj(prefix, &length);
	    (void)Tcl_GetStringFromObj(prefix, &length);
	}
	needsSep = 0;

	/*
	 * Append the element, eliminating duplicate and trailing slashes.
	 */

872
873
874
875
876
877
878
879

880
881
882
883
884
885
886
884
885
886
887
888
889
890

891
892
893
894
895
896
897
898







-
+







	/*
	 * Check to see if we need to append a separator.
	 */

	if ((length > 0) &&
		(start[length-1] != '/') && (start[length-1] != ':')) {
	    Tcl_AppendToObj(prefix, "/", 1);
	    (void)TclGetStringFromObj(prefix, &length);
	    (void)Tcl_GetStringFromObj(prefix, &length);
	}
	needsSep = 0;

	/*
	 * Append the element, eliminating duplicate and trailing slashes.
	 */

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
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







-
+




















-
-
+
+







    Tcl_IncrRefCount(resultObj);
    Tcl_DecrRefCount(listObj);

    /*
     * Store the result.
     */

    resultStr = TclGetStringFromObj(resultObj, &len);
    resultStr = Tcl_GetStringFromObj(resultObj, &len);
    Tcl_DStringAppend(resultPtr, resultStr, len);
    Tcl_DecrRefCount(resultObj);

    /*
     * Return a pointer to the result.
     */

    return Tcl_DStringValue(resultPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_TranslateFileName --
 *
 *	Converts a file name into a form usable by the native system
 *	interfaces.
 *
 * Results:
 *	The return value is a pointer to a string containing the name.
 *      This may either be the name pointer passed in or space allocated in
 *      bufferPtr. In all cases, if the return value is not NULL, the caller
 *	This may either be the name pointer passed in or space allocated in
 *	bufferPtr. In all cases, if the return value is not NULL, the caller
 *	must call Tcl_DStringFree() to free the space. If there was an
 *	error in processing the name, then an error message is left in the
 *	interp's result (if interp was not NULL) and the return value is NULL.
 *
 * Side effects:
 *	None.
 *
1128
1129
1130
1131
1132
1133
1134
1135

1136
1137
1138
1139
1140
1141
1142
1140
1141
1142
1143
1144
1145
1146

1147
1148
1149
1150
1151
1152
1153
1154







-
+







	"-directory", "-join", "-nocomplain", "-path", "-tails",
	"-types", "--", NULL
    };
    enum globOptionsEnum {
	GLOB_DIR, GLOB_JOIN, GLOB_NOCOMPLAIN, GLOB_PATH, GLOB_TAILS,
	GLOB_TYPE, GLOB_LAST
    } index;
    enum pathDirOptions {PATH_NONE = -1 , PATH_GENERAL = 0, PATH_DIR = 1};
    enum pathDirOptions {PATH_NONE = -1, PATH_GENERAL = 0, PATH_DIR = 1};
    Tcl_GlobTypeData *globTypes = NULL;

    globFlags = 0;
    join = 0;
    dir = PATH_NONE;
    typePtr = NULL;
    for (i = 1; i < objc; i++) {
1189
1190
1191
1192
1193
1194
1195
1196

1197
1198
1199
1200
1201
1202
1203
1201
1202
1203
1204
1205
1206
1207

1208
1209
1210
1211
1212
1213
1214
1215







-
+







	    globFlags |= TCL_GLOBMODE_DIR;
	    pathOrDir = objv[i+1];
	    i++;
	    break;
	case GLOB_JOIN:				/* -join */
	    join = 1;
	    break;
	case GLOB_TAILS:				/* -tails */
	case GLOB_TAILS:			/* -tails */
	    globFlags |= TCL_GLOBMODE_TAILS;
	    break;
	case GLOB_PATH:				/* -path */
	    if (i == (objc-1)) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"missing argument to \"-path\"", -1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (void *)NULL);
1255
1256
1257
1258
1259
1260
1261
1262

1263
1264
1265
1266
1267
1268
1269
1267
1268
1269
1270
1271
1272
1273

1274
1275
1276
1277
1278
1279
1280
1281







-
+







	separators = "/\\:";
	break;
    }

    if (dir == PATH_GENERAL) {
	Tcl_Size pathlength;
	const char *last;
	const char *first = TclGetStringFromObj(pathOrDir,&pathlength);
	const char *first = Tcl_GetStringFromObj(pathOrDir ,&pathlength);

	/*
	 * Find the last path separator in the path
	 */

	last = first + pathlength;
	for (; last != first; last--) {
1362
1363
1364
1365
1366
1367
1368
1369

1370
1371
1372
1373
1374
1375
1376
1374
1375
1376
1377
1378
1379
1380

1381
1382
1383
1384
1385
1386
1387
1388







-
+







	globTypes->macCreator = NULL;

	while (length-- > 0) {
	    Tcl_Size len;
	    const char *str;

	    Tcl_ListObjIndex(interp, typePtr, length, &look);
	    str = TclGetStringFromObj(look, &len);
	    str = Tcl_GetStringFromObj(look, &len);
	    if (strcmp("readonly", str) == 0) {
		globTypes->perm |= TCL_GLOB_PERM_RONLY;
	    } else if (strcmp("hidden", str) == 0) {
		globTypes->perm |= TCL_GLOB_PERM_HIDDEN;
	    } else if (len == 1) {
		switch (str[0]) {
		case 'r':
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
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







-
+

















-
+







	 * If this length has never been set, set it here.
	 */

	if (pathPrefix == NULL) {
	    Tcl_Panic("Called TclGlob with TCL_GLOBMODE_TAILS and pathPrefix==NULL");
	}

	pre = TclGetStringFromObj(pathPrefix, &prefixLen);
	pre = Tcl_GetStringFromObj(pathPrefix, &prefixLen);
	if (prefixLen > 0
		&& (strchr(separators, pre[prefixLen-1]) == NULL)) {
	    /*
	     * If we're on Windows and the prefix is a volume relative one
	     * like 'C:', then there won't be a path separator in between, so
	     * no need to skip it here.
	     */

	    if ((tclPlatform != TCL_PLATFORM_WINDOWS) || (prefixLen != 2)
		    || (pre[1] != ':')) {
		prefixLen++;
	    }
	}

	TclListObjGetElements(NULL, filenamesObj, &objc, &objv);
	for (i = 0; i< objc; i++) {
	    Tcl_Size len;
	    const char *oldStr = TclGetStringFromObj(objv[i], &len);
	    const char *oldStr = Tcl_GetStringFromObj(objv[i], &len);
	    Tcl_Obj *elem;

	    if (len == prefixLen) {
		if ((pattern[0] == '\0')
			|| (strchr(separators, pattern[0]) == NULL)) {
		    TclNewLiteralStringObj(elem, ".");
		} else {
2167
2168
2169
2170
2171
2172
2173
2174

2175
2176
2177
2178
2179
2180
2181
2179
2180
2181
2182
2183
2184
2185

2186
2187
2188
2189
2190
2191
2192
2193







-
+







		    TclListObjLength(NULL, matchesObj, &end);
		    while (repair < end) {
			const char *bytes;
			Tcl_Size numBytes;
			Tcl_Obj *fixme, *newObj;

			Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme);
			bytes = TclGetStringFromObj(fixme, &numBytes);
			bytes = Tcl_GetStringFromObj(fixme, &numBytes);
			newObj = Tcl_NewStringObj(bytes+2, numBytes-2);
			Tcl_ListObjReplace(NULL, matchesObj, repair, 1,
				1, &newObj);
			repair++;
		    }
		    repair = TCL_INDEX_NONE;
		}
2205
2206
2207
2208
2209
2210
2211
2212

2213
2214
2215
2216
2217
2218
2219
2217
2218
2219
2220
2221
2222
2223

2224
2225
2226
2227
2228
2229
2230
2231







-
+







	 * approach).
	 */

	Tcl_DStringInit(&append);
	Tcl_DStringAppend(&append, pattern, p-pattern);

	if (pathPtr != NULL) {
	    (void) TclGetStringFromObj(pathPtr, &length);
	    (void) Tcl_GetStringFromObj(pathPtr, &length);
	} else {
	    length = 0;
	}

	switch (tclPlatform) {
	case TCL_PLATFORM_WINDOWS:
	    if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
2251
2252
2253
2254
2255
2256
2257
2258

2259
2260
2261
2262
2263
2264
2265
2263
2264
2265
2266
2267
2268
2269

2270
2271
2272
2273
2274
2275
2276
2277







-
+







	    joinedPtr = Tcl_DuplicateObj(pathPtr);
	    if (strchr(separators, Tcl_DStringValue(&append)[0]) == NULL) {
		/*
		 * The current prefix must end in a separator.
		 */

		Tcl_Size len;
		const char *joined = TclGetStringFromObj(joinedPtr,&len);
		const char *joined = Tcl_GetStringFromObj(joinedPtr ,&len);

		if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) {
		    Tcl_AppendToObj(joinedPtr, "/", 1);
		}
	    }
	    Tcl_AppendToObj(joinedPtr, Tcl_DStringValue(&append),
		    Tcl_DStringLength(&append));
2288
2289
2290
2291
2292
2293
2294
2295

2296
2297
2298
2299
2300
2301
2302
2300
2301
2302
2303
2304
2305
2306

2307
2308
2309
2310
2311
2312
2313
2314







-
+







	     * volume-relative path. In particular globbing in Windows shares,
	     * when not using -dir or -path, e.g. 'glob [file join
	     * //machine/share/subdir *]' requires adding a separator here.
	     * This behaviour is not currently tested for in the test suite.
	     */

	    Tcl_Size len;
	    const char *joined = TclGetStringFromObj(joinedPtr,&len);
	    const char *joined = Tcl_GetStringFromObj(joinedPtr ,&len);

	    if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) {
		if (Tcl_FSGetPathType(pathPtr) != TCL_PATH_VOLUME_RELATIVE) {
		    Tcl_AppendToObj(joinedPtr, "/", 1);
		}
	    }
	}
Changes to generic/tclFileSystem.h.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclFileSystem.h --
 *
 *	This file contains the common definitions and prototypes for use by
 *	Tcl's filesystem and path handling layers.
 *
 * Copyright (c) 2003 Vince Darley.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclFileSystem.h --
 *
 *	This file contains the common definitions and prototypes for use by
 *	Tcl's filesystem and path handling layers.
 */

#ifndef _TCLFILESYSTEM
#define _TCLFILESYSTEM

#include "tcl.h"

/*
 * The internal TclFS API provides routines for handling and manipulating
Changes to generic/tclGet.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14

















15
16
17
18
19
20
21
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

-
-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclGet.c --
 *
 *	This file contains functions to convert strings into other forms, like
 *	integers or floating-point numbers or booleans, doing syntax checking
 *	along the way.
 *
 * Copyright © 1990-1993 The Regents of the University of California.
 * Copyright © 1994-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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclGet.c --
 *
 *	This file contains functions to convert strings into other forms, like
 *	integers or floating-point numbers or booleans, doing syntax checking
 *	along the way.
 */

#include "tclInt.h"

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetInt --
 *
Deleted generic/tclGetDate.y.
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






































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * 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 © 1992-1995 Karl Lehenbauer & Mark Diekhans.
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 * Copyright © 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}
%define api.pure
 /* %error-verbose would be nice, but our token names are meaningless */
%locations

%{
/*
 * tclDate.c --
 *
 *	This file is generated from a yacc grammar defined in the file
 *	tclGetDate.y. It should not be edited directly.
 *
 * Copyright © 1992-1995 Karl Lehenbauer & Mark Diekhans.
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 * Copyright © 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.
 *
 */
#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 */

#if 0
#define YYDEBUG 1
#endif

/*
 * yyparse will accept a 'struct DateInfo' as its parameter; that's where the
 * parsed fields will be returned.
 */

#include "tclDate.h"

#define YYMALLOC	Tcl_Alloc
#define YYFREE(x)	(Tcl_Free((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.
 */

#define TM_YEAR_BASE	1900

#define HOUR(x)		((60 * (int)(x)))
#define IsLeapYear(x)	(((x) % 4 == 0) && ((x) % 100 != 0 || (x) % 400 == 0))

#define yyIncrFlags(f)				\
    do {					\
	info->errFlags |= (info->flags & (f));	\
	if (info->errFlags) { YYABORT; }	\
	info->flags |= (f);			\
    } while (0);

/*
 * An entry in the lexical lookup table.
 */

typedef struct {
    const char *name;
    int type;
    int value;
} TABLE;

/*
 * Daylight-savings mode: on, off, or not yet known.
 */

typedef enum _DSTMODE {
    DSTon, DSToff, DSTmaybe
} DSTMODE;

%}

%union {
    Tcl_WideInt 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
%token	tID
%token	tMERIDIAN
%token	tMONTH
%token	tMONTH_UNIT
%token	tSTARDATE
%token	tSEC_UNIT
%token	tUNUMBER
%token	tZONE
%token	tZONEwO4
%token	tZONEwO2
%token	tEPOCH
%token	tDST
%token	tISOBAS8
%token	tISOBAS6
%token	tISOBASL
%token	tDAY_UNIT
%token	tNEXT
%token	SP

%type	<Number>	tDAY
%type	<Number>	tDAYZONE
%type	<Number>	tMONTH
%type	<Number>	tMONTH_UNIT
%type	<Number>	tDST
%type	<Number>	tSEC_UNIT
%type	<Number>	tUNUMBER
%type	<Number>	INTNUM
%type	<Number>	tZONE
%type	<Number>	tZONEwO4
%type	<Number>	tZONEwO2
%type	<Number>	tISOBAS8
%type	<Number>	tISOBAS6
%type	<Number>	tISOBASL
%type	<Number>	tDAY_UNIT
%type	<Number>	unit
%type	<Number>	sign
%type	<Number>	tNEXT
%type	<Number>	tSTARDATE
%type	<Meridian>	tMERIDIAN
%type	<Meridian>	o_merid

%%

spec	: /* NULL */
	| spec item
	/* | spec SP item */
	;

item	: time {
	    yyIncrFlags(CLF_TIME);
	}
	| zone {
	    yyIncrFlags(CLF_ZONE);
	}
	| date {
	    yyIncrFlags(CLF_HAVEDATE);
	}
	| ordMonth {
	    yyIncrFlags(CLF_ORDINALMONTH);
	}
	| day {
	    yyIncrFlags(CLF_DAYOFWEEK);
	}
	| relspec {
	    info->flags |= CLF_RELCONV;
	}
	| iso {
	    yyIncrFlags(CLF_TIME|CLF_HAVEDATE);
	}
	| trek {
	    yyIncrFlags(CLF_TIME|CLF_HAVEDATE);
	    info->flags |= CLF_RELCONV;
	}
	| numitem
	;

iextime : tUNUMBER ':' tUNUMBER ':' tUNUMBER {
	    yyHour = $1;
	    yyMinutes = $3;
	    yySeconds = $5;
	}
	| tUNUMBER ':' tUNUMBER {
	    yyHour = $1;
	    yyMinutes = $3;
	    yySeconds = 0;
	}
	;
time	: tUNUMBER tMERIDIAN {
	    yyHour = $1;
	    yyMinutes = 0;
	    yySeconds = 0;
	    yyMeridian = $2;
	}
	| iextime o_merid {
	    yyMeridian = $2;
	}
	;

zone	: tZONE tDST {
	    yyTimezone = $1;
	    yyDSTmode = DSTon;
	}
	| tZONE {
	    yyTimezone = $1;
	    yyDSTmode = DSToff;
	}
	| tDAYZONE {
	    yyTimezone = $1;
	    yyDSTmode = DSTon;
	}
	| tZONEwO4 sign INTNUM { /* GMT+0100, GMT-1000, etc. */
	    yyTimezone = $1 - $2*($3 % 100 + ($3 / 100) * 60);
	    yyDSTmode = DSToff;
	}
	| tZONEwO2 sign INTNUM { /* GMT+1, GMT-10, etc. */
	    yyTimezone = $1 - $2*($3 * 60);
	    yyDSTmode = DSToff;
	}
	| sign INTNUM { /* +0100, -0100 */
	    yyTimezone = -$1*($2 % 100 + ($2 / 100) * 60);
	    yyDSTmode = DSToff;
	}
	;

comma	: ','
	| ',' SP
	;

day	: tDAY {
	    yyDayOrdinal = 1;
	    yyDayOfWeek = $1;
	}
	| tDAY comma {
	    yyDayOrdinal = 1;
	    yyDayOfWeek = $1;
	}
	| tUNUMBER tDAY {
	    yyDayOrdinal = $1;
	    yyDayOfWeek = $2;
	}
	| sign SP tUNUMBER tDAY {
	    yyDayOrdinal = $1 * $3;
	    yyDayOfWeek = $4;
	}
	| sign tUNUMBER tDAY {
	    yyDayOrdinal = $1 * $2;
	    yyDayOfWeek = $3;
	}
	| tNEXT tDAY {
	    yyDayOrdinal = 2;
	    yyDayOfWeek = $2;
	}
	;

iexdate	: tUNUMBER '-' tUNUMBER '-' tUNUMBER {
	    yyMonth = $3;
	    yyDay = $5;
	    yyYear = $1;
	}
	;
date	: tUNUMBER '/' tUNUMBER {
	    yyMonth = $1;
	    yyDay = $3;
	}
	| tUNUMBER '/' tUNUMBER '/' tUNUMBER {
	    yyMonth = $1;
	    yyDay = $3;
	    yyYear = $5;
	}
	| isodate
	| tUNUMBER '-' tMONTH '-' tUNUMBER {
	    yyDay = $1;
	    yyMonth = $3;
	    yyYear = $5;
	}
	| tMONTH tUNUMBER {
	    yyMonth = $1;
	    yyDay = $2;
	}
	| tMONTH tUNUMBER comma tUNUMBER {
	    yyMonth = $1;
	    yyDay = $2;
	    yyYear = $4;
	}
	| tUNUMBER tMONTH {
	    yyMonth = $2;
	    yyDay = $1;
	}
	| tEPOCH {
	    yyMonth = 1;
	    yyDay = 1;
	    yyYear = EPOCH;
	}
	| tUNUMBER tMONTH tUNUMBER {
	    yyMonth = $2;
	    yyDay = $1;
	    yyYear = $3;
	}
	;

ordMonth: tNEXT tMONTH {
	    yyMonthOrdinalIncr = 1;
	    yyMonthOrdinal = $2;
	}
	| tNEXT tUNUMBER tMONTH {
	    yyMonthOrdinalIncr = $2;
	    yyMonthOrdinal = $3;
	}
	;

isosep	: 'T'|SP
	;
isodate	: tISOBAS8 { /* YYYYMMDD */
	    yyYear = $1 / 10000;
	    yyMonth = ($1 % 10000)/100;
	    yyDay = $1 % 100;
	}
	| tISOBAS6 { /* YYMMDD */
	    yyYear = $1 / 10000;
	    yyMonth = ($1 % 10000)/100;
	    yyDay = $1 % 100;
	}
	| iexdate
	;
isotime	: tISOBAS6 {
	    yyHour = $1 / 10000;
	    yyMinutes = ($1 % 10000)/100;
	    yySeconds = $1 % 100;
	}
	| iextime
	;
iso	: isodate isosep isotime
	| tISOBASL tISOBAS6 { /* YYYYMMDDhhmmss */
	    yyYear = $1 / 10000;
	    yyMonth = ($1 % 10000)/100;
	    yyDay = $1 % 100;
	    yyHour = $2 / 10000;
	    yyMinutes = ($2 % 10000)/100;
	    yySeconds = $2 % 100;
	}
	| tISOBASL tUNUMBER { /* YYYYMMDDhhmm */
	    if (yyDigitCount != 4) YYABORT; /* normally unreached */
	    yyYear = $1 / 10000;
	    yyMonth = ($1 % 10000)/100;
	    yyDay = $1 % 100;
	    yyHour = $2 / 100;
	    yyMinutes = ($2 % 100);
	    yySeconds = 0;
	}
	;

trek	: tSTARDATE INTNUM '.' tUNUMBER {
	    /*
	     * Offset computed year by -377 so that the returned years will be
	     * in a range accessible with a 32 bit clock seconds value.
	     */

	    yyYear = $2/1000 + 2323 - 377;
	    yyDay  = 1;
	    yyMonth = 1;
	    yyRelDay += (($2%1000)*(365 + IsLeapYear(yyYear)))/1000;
	    yyRelSeconds += $4 * (144LL * 60LL);
	}
	;

relspec : relunits tAGO {
	    yyRelSeconds *= -1;
	    yyRelMonth *= -1;
	    yyRelDay *= -1;
	}
	| relunits
	;

relunits : sign SP INTNUM unit {
	    *yyRelPointer += $1 * $3 * $4;
	}
	| sign INTNUM unit {
	    *yyRelPointer += $1 * $2 * $3;
	}
	| INTNUM unit {
	    *yyRelPointer += $1 * $2;
	}
	| tNEXT unit {
	    *yyRelPointer += $2;
	}
	| tNEXT INTNUM unit {
	    *yyRelPointer += $2 * $3;
	}
	| unit {
	    *yyRelPointer += $1;
	}
	;

sign	: '-' {
	    $$ = -1;
	}
	| '+' {
	    $$ =  1;
	}
	;

unit	: tSEC_UNIT {
	    $$ = $1;
	    yyRelPointer = &yyRelSeconds;
	}
	| tDAY_UNIT {
	    $$ = $1;
	    yyRelPointer = &yyRelDay;
	}
	| tMONTH_UNIT {
	    $$ = $1;
	    yyRelPointer = &yyRelMonth;
	}
	;

INTNUM	: tUNUMBER {
	    $$ = $1;
	}
	| tISOBAS6 {
	    $$ = $1;
	}
	| tISOBAS8 {
	    $$ = $1;
	}
	;

numitem	: tUNUMBER {
	    if ((info->flags & (CLF_TIME|CLF_HAVEDATE|CLF_RELCONV)) == (CLF_TIME|CLF_HAVEDATE)) {
		yyYear = $1;
	    } else {
		yyIncrFlags(CLF_TIME);
		if (yyDigitCount <= 2) {
		    yyHour = $1;
		    yyMinutes = 0;
		} else {
		    yyHour = $1 / 100;
		    yyMinutes = $1 % 100;
		}
		yySeconds = 0;
		yyMeridian = MER24;
	    }
	}
	;

o_merid : /* NULL */ {
	    $$ = MER24;
	}
	| tMERIDIAN {
	    $$ = $1;
	}
	;

%%
/*
 * Month and day table.
 */

static const TABLE MonthDayTable[] = {
    { "january",	tMONTH,	 1 },
    { "february",	tMONTH,	 2 },
    { "march",		tMONTH,	 3 },
    { "april",		tMONTH,	 4 },
    { "may",		tMONTH,	 5 },
    { "june",		tMONTH,	 6 },
    { "july",		tMONTH,	 7 },
    { "august",		tMONTH,	 8 },
    { "september",	tMONTH,	 9 },
    { "sept",		tMONTH,	 9 },
    { "october",	tMONTH, 10 },
    { "november",	tMONTH, 11 },
    { "december",	tMONTH, 12 },
    { "sunday",		tDAY, 7 },
    { "monday",		tDAY, 1 },
    { "tuesday",	tDAY, 2 },
    { "tues",		tDAY, 2 },
    { "wednesday",	tDAY, 3 },
    { "wednes",		tDAY, 3 },
    { "thursday",	tDAY, 4 },
    { "thur",		tDAY, 4 },
    { "thurs",		tDAY, 4 },
    { "friday",		tDAY, 5 },
    { "saturday",	tDAY, 6 },
    { NULL, 0, 0 }
};

/*
 * Time units table.
 */

static const TABLE UnitsTable[] = {
    { "year",		tMONTH_UNIT,	12 },
    { "month",		tMONTH_UNIT,	 1 },
    { "fortnight",	tDAY_UNIT,	14 },
    { "week",		tDAY_UNIT,	 7 },
    { "day",		tDAY_UNIT,	 1 },
    { "hour",		tSEC_UNIT, 60 * 60 },
    { "minute",		tSEC_UNIT,	60 },
    { "min",		tSEC_UNIT,	60 },
    { "second",		tSEC_UNIT,	 1 },
    { "sec",		tSEC_UNIT,	 1 },
    { NULL, 0, 0 }
};

/*
 * Assorted relative-time words.
 */

static const TABLE OtherTable[] = {
    { "tomorrow",	tDAY_UNIT,	1 },
    { "yesterday",	tDAY_UNIT,	-1 },
    { "today",		tDAY_UNIT,	0 },
    { "now",		tSEC_UNIT,	0 },
    { "last",		tUNUMBER,	-1 },
    { "this",		tSEC_UNIT,	0 },
    { "next",		tNEXT,		1 },
    { "ago",		tAGO,		1 },
    { "epoch",		tEPOCH,		0 },
    { "stardate",	tSTARDATE,	0 },
    { NULL, 0, 0 }
};

/*
 * The timezone table. (Note: This table was modified to not use any floating
 * point constants to work around an SGI compiler bug).
 */

static const TABLE TimezoneTable[] = {
    { "gmt",	tZONE,	   HOUR( 0) },	    /* Greenwich Mean */
    { "ut",	tZONE,	   HOUR( 0) },	    /* Universal (Coordinated) */
    { "utc",	tZONE,	   HOUR( 0) },
    { "uct",	tZONE,	   HOUR( 0) },	    /* Universal Coordinated Time */
    { "wet",	tZONE,	   HOUR( 0) },	    /* Western European */
    { "bst",	tDAYZONE,  HOUR( 0) },	    /* British Summer */
    { "wat",	tZONE,	   HOUR( 1) },	    /* West Africa */
    { "at",	tZONE,	   HOUR( 2) },	    /* Azores */
#if	0
    /* For completeness.  BST is also British Summer, and GST is
     * also Guam Standard. */
    { "bst",	tZONE,	   HOUR( 3) },	    /* Brazil Standard */
    { "gst",	tZONE,	   HOUR( 3) },	    /* Greenland Standard */
#endif
    { "nft",	tZONE,	   HOUR( 7/2) },    /* Newfoundland */
    { "nst",	tZONE,	   HOUR( 7/2) },    /* Newfoundland Standard */
    { "ndt",	tDAYZONE,  HOUR( 7/2) },    /* Newfoundland Daylight */
    { "ast",	tZONE,	   HOUR( 4) },	    /* Atlantic Standard */
    { "adt",	tDAYZONE,  HOUR( 4) },	    /* Atlantic Daylight */
    { "est",	tZONE,	   HOUR( 5) },	    /* Eastern Standard */
    { "edt",	tDAYZONE,  HOUR( 5) },	    /* Eastern Daylight */
    { "cst",	tZONE,	   HOUR( 6) },	    /* Central Standard */
    { "cdt",	tDAYZONE,  HOUR( 6) },	    /* Central Daylight */
    { "mst",	tZONE,	   HOUR( 7) },	    /* Mountain Standard */
    { "mdt",	tDAYZONE,  HOUR( 7) },	    /* Mountain Daylight */
    { "pst",	tZONE,	   HOUR( 8) },	    /* Pacific Standard */
    { "pdt",	tDAYZONE,  HOUR( 8) },	    /* Pacific Daylight */
    { "yst",	tZONE,	   HOUR( 9) },	    /* Yukon Standard */
    { "ydt",	tDAYZONE,  HOUR( 9) },	    /* Yukon Daylight */
    { "akst",	tZONE,	   HOUR( 9) },	    /* Alaska Standard */
    { "akdt",	tDAYZONE,  HOUR( 9) },	    /* Alaska Daylight */
    { "hst",	tZONE,	   HOUR(10) },	    /* Hawaii Standard */
    { "hdt",	tDAYZONE,  HOUR(10) },	    /* Hawaii Daylight */
    { "cat",	tZONE,	   HOUR(10) },	    /* Central Alaska */
    { "ahst",	tZONE,	   HOUR(10) },	    /* Alaska-Hawaii Standard */
    { "nt",	tZONE,	   HOUR(11) },	    /* Nome */
    { "idlw",	tZONE,	   HOUR(12) },	    /* International Date Line West */
    { "cet",	tZONE,	  -HOUR( 1) },	    /* Central European */
    { "cest",	tDAYZONE, -HOUR( 1) },	    /* Central European Summer */
    { "met",	tZONE,	  -HOUR( 1) },	    /* Middle European */
    { "mewt",	tZONE,	  -HOUR( 1) },	    /* Middle European Winter */
    { "mest",	tDAYZONE, -HOUR( 1) },	    /* Middle European Summer */
    { "swt",	tZONE,	  -HOUR( 1) },	    /* Swedish Winter */
    { "sst",	tDAYZONE, -HOUR( 1) },	    /* Swedish Summer */
    { "fwt",	tZONE,	  -HOUR( 1) },	    /* French Winter */
    { "fst",	tDAYZONE, -HOUR( 1) },	    /* French Summer */
    { "eet",	tZONE,	  -HOUR( 2) },	    /* Eastern Europe, USSR Zone 1 */
    { "bt",	tZONE,	  -HOUR( 3) },	    /* Baghdad, USSR Zone 2 */
    { "it",	tZONE,	  -HOUR( 7/2) },    /* Iran */
    { "zp4",	tZONE,	  -HOUR( 4) },	    /* USSR Zone 3 */
    { "zp5",	tZONE,	  -HOUR( 5) },	    /* USSR Zone 4 */
    { "ist",	tZONE,	  -HOUR(11/2) },    /* Indian Standard */
    { "zp6",	tZONE,	  -HOUR( 6) },	    /* USSR Zone 5 */
#if	0
    /* For completeness.  NST is also Newfoundland Standard, and SST is
     * also Swedish Summer. */
    { "nst",	tZONE,	  -HOUR(13/2) },    /* North Sumatra */
    { "sst",	tZONE,	  -HOUR( 7) },	    /* South Sumatra, USSR Zone 6 */
#endif	/* 0 */
    { "wast",	tZONE,	  -HOUR( 7) },	    /* West Australian Standard */
    { "wadt",	tDAYZONE, -HOUR( 7) },	    /* West Australian Daylight */
    { "jt",	tZONE,	  -HOUR(15/2) },    /* Java (3pm in Cronusland!) */
    { "cct",	tZONE,	  -HOUR( 8) },	    /* China Coast, USSR Zone 7 */
    { "jst",	tZONE,	  -HOUR( 9) },	    /* Japan Standard, USSR Zone 8 */
    { "jdt",	tDAYZONE, -HOUR( 9) },	    /* Japan Daylight */
    { "kst",	tZONE,	  -HOUR( 9) },	    /* Korea Standard */
    { "kdt",	tDAYZONE, -HOUR( 9) },	    /* Korea Daylight */
    { "cast",	tZONE,	  -HOUR(19/2) },    /* Central Australian Standard */
    { "cadt",	tDAYZONE, -HOUR(19/2) },    /* Central Australian Daylight */
    { "east",	tZONE,	  -HOUR(10) },	    /* Eastern Australian Standard */
    { "eadt",	tDAYZONE, -HOUR(10) },	    /* Eastern Australian Daylight */
    { "gst",	tZONE,	  -HOUR(10) },	    /* Guam Standard, USSR Zone 9 */
    { "nzt",	tZONE,	  -HOUR(12) },	    /* New Zealand */
    { "nzst",	tZONE,	  -HOUR(12) },	    /* New Zealand Standard */
    { "nzdt",	tDAYZONE, -HOUR(12) },	    /* New Zealand Daylight */
    { "idle",	tZONE,	  -HOUR(12) },	    /* International Date Line East */
    /* ADDED BY Marco Nijdam */
    { "dst",	tDST,	  HOUR( 0) },	    /* DST on (hour is ignored) */
    /* End ADDED */
    { NULL, 0, 0 }
};

/*
 * Military timezone table.
 */

static const TABLE MilitaryTable[] = {
    { "a",	tZONE,	-HOUR( 1) },
    { "b",	tZONE,	-HOUR( 2) },
    { "c",	tZONE,	-HOUR( 3) },
    { "d",	tZONE,	-HOUR( 4) },
    { "e",	tZONE,	-HOUR( 5) },
    { "f",	tZONE,	-HOUR( 6) },
    { "g",	tZONE,	-HOUR( 7) },
    { "h",	tZONE,	-HOUR( 8) },
    { "i",	tZONE,	-HOUR( 9) },
    { "k",	tZONE,	-HOUR(10) },
    { "l",	tZONE,	-HOUR(11) },
    { "m",	tZONE,	-HOUR(12) },
    { "n",	tZONE,	HOUR(  1) },
    { "o",	tZONE,	HOUR(  2) },
    { "p",	tZONE,	HOUR(  3) },
    { "q",	tZONE,	HOUR(  4) },
    { "r",	tZONE,	HOUR(  5) },
    { "s",	tZONE,	HOUR(  6) },
    { "t",	tZONE,	HOUR(  7) },
    { "u",	tZONE,	HOUR(  8) },
    { "v",	tZONE,	HOUR(  9) },
    { "w",	tZONE,	HOUR( 10) },
    { "x",	tZONE,	HOUR( 11) },
    { "y",	tZONE,	HOUR( 12) },
    { "z",	tZONE,	HOUR( 0) },
    { NULL, 0, 0 }
};

static inline const char *
bypassSpaces(
    const char *s)
{
    while (TclIsSpaceProc(*s)) {
	s++;
    }
    return s;
}

/*
 * Dump error messages in the bit bucket.
 */

static void
TclDateerror(
    YYLTYPE* location,
    DateInfo* infoPtr,
    const char *s)
{
    Tcl_Obj* t;
    if (!infoPtr->messages) {
	TclNewObj(infoPtr->messages);
    }
    Tcl_AppendToObj(infoPtr->messages, infoPtr->separatrix, -1);
    Tcl_AppendToObj(infoPtr->messages, s, -1);
    Tcl_AppendToObj(infoPtr->messages, " (characters ", -1);
    TclNewIntObj(t, location->first_column);
    Tcl_IncrRefCount(t);
    Tcl_AppendObjToObj(infoPtr->messages, t);
    Tcl_DecrRefCount(t);
    Tcl_AppendToObj(infoPtr->messages, "-", -1);
    TclNewIntObj(t, location->last_column);
    Tcl_IncrRefCount(t);
    Tcl_AppendObjToObj(infoPtr->messages, t);
    Tcl_DecrRefCount(t);
    Tcl_AppendToObj(infoPtr->messages, ")", -1);
    infoPtr->separatrix = "\n";
}

int
ToSeconds(
    int Hours,
    int Minutes,
    int Seconds,
    MERIDIAN Meridian)
{
    switch (Meridian) {
    case MER24:
	return (Hours * 60 + Minutes) * 60 + Seconds;
    case MERam:
	return ((Hours % 12) * 60 + Minutes) * 60 + Seconds;
    case MERpm:
	return (((Hours % 12) + 12) * 60 + Minutes) * 60 + Seconds;
    }
    return -1;			/* Should never be reached */
}

static int
LookupWord(
    YYSTYPE* yylvalPtr,
    char *buff)
{
    char *p;
    char *q;
    const TABLE *tp;
    int i, abbrev;

    /*
     * Make it lowercase.
     */

    Tcl_UtfToLower(buff);

    if (*buff == 'a' && (strcmp(buff, "am") == 0 || strcmp(buff, "a.m.") == 0)) {
	yylvalPtr->Meridian = MERam;
	return tMERIDIAN;
    }
    if (*buff == 'p' && (strcmp(buff, "pm") == 0 || strcmp(buff, "p.m.") == 0)) {
	yylvalPtr->Meridian = MERpm;
	return tMERIDIAN;
    }

    /*
     * See if we have an abbreviation for a month.
     */

    if (strlen(buff) == 3) {
	abbrev = 1;
    } else if (strlen(buff) == 4 && buff[3] == '.') {
	abbrev = 1;
	buff[3] = '\0';
    } else {
	abbrev = 0;
    }

    for (tp = MonthDayTable; tp->name; tp++) {
	if (abbrev) {
	    if (strncmp(buff, tp->name, 3) == 0) {
		yylvalPtr->Number = tp->value;
		return tp->type;
	    }
	} else if (strcmp(buff, tp->name) == 0) {
	    yylvalPtr->Number = tp->value;
	    return tp->type;
	}
    }

    for (tp = TimezoneTable; tp->name; tp++) {
	if (strcmp(buff, tp->name) == 0) {
	    yylvalPtr->Number = tp->value;
	    return tp->type;
	}
    }

    for (tp = UnitsTable; tp->name; tp++) {
	if (strcmp(buff, tp->name) == 0) {
	    yylvalPtr->Number = tp->value;
	    return tp->type;
	}
    }

    /*
     * Strip off any plural and try the units table again.
     */

    i = strlen(buff) - 1;
    if (i > 0 && buff[i] == 's') {
	buff[i] = '\0';
	for (tp = UnitsTable; tp->name; tp++) {
	    if (strcmp(buff, tp->name) == 0) {
		yylvalPtr->Number = tp->value;
		return tp->type;
	    }
	}
    }

    for (tp = OtherTable; tp->name; tp++) {
	if (strcmp(buff, tp->name) == 0) {
	    yylvalPtr->Number = tp->value;
	    return tp->type;
	}
    }

    /*
     * Military timezones.
     */

    if (buff[1] == '\0' && !(*buff & 0x80)
	    && isalpha(UCHAR(*buff))) {			/* INTL: ISO only */
	for (tp = MilitaryTable; tp->name; tp++) {
	    if (strcmp(buff, tp->name) == 0) {
		yylvalPtr->Number = tp->value;
		return tp->type;
	    }
	}
    }

    /*
     * Drop out any periods and try the timezone table again.
     */

    for (i = 0, p = q = buff; *q; q++) {
	if (*q != '.') {
	    *p++ = *q;
	} else {
	    i++;
	}
    }
    *p = '\0';
    if (i) {
	for (tp = TimezoneTable; tp->name; tp++) {
	    if (strcmp(buff, tp->name) == 0) {
		yylvalPtr->Number = tp->value;
		return tp->type;
	    }
	}
    }

    return tID;
}

static int
TclDatelex(
    YYSTYPE* yylvalPtr,
    YYLTYPE* location,
    DateInfo *info)
{
    char c;
    char *p;
    char buff[20];
    int Count;
    const char *tokStart;

    location->first_column = yyInput - info->dateStart;
    for ( ; ; ) {

	if (isspace(UCHAR(*yyInput))) {
	    yyInput = bypassSpaces(yyInput);
	    /* ignore space at end of text and before some words */
	    c = *yyInput;
	    if (c != '\0' && !isalpha(UCHAR(c))) {
		return SP;
	    }
	}
	tokStart = yyInput;

	if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */

	    /*
	     * Count the number of digits.
	     */
	    p = (char *)yyInput;
	    while (isdigit(UCHAR(*++p))) {};
	    yyDigitCount = p - yyInput;
	    /*
	     * A number with 12 or 14 digits is considered an ISO 8601 date.
	     */
	    if (yyDigitCount == 14 || yyDigitCount == 12) {
		/* long form of ISO 8601 (without separator), either
		 * YYYYMMDDhhmmss or YYYYMMDDhhmm, so reduce to date
		 * (8 chars is isodate) */
		p = (char *)yyInput+8;
		if (TclAtoWIe(&yylvalPtr->Number, yyInput, p, 1) != TCL_OK) {
		    return tID; /* overflow*/
		}
		yyDigitCount = 8;
		yyInput = p;
		location->last_column = yyInput - info->dateStart - 1;
		return tISOBASL;
	    }
	    /*
	     * Convert the string into a number
	     */
	    if (TclAtoWIe(&yylvalPtr->Number, yyInput, p, 1) != TCL_OK) {
		return tID; /* overflow*/
	    }
	    yyInput = p;
	    /*
	     * A number with 6 or more digits is considered an ISO 8601 base.
	     */
	    location->last_column = yyInput - info->dateStart - 1;
	    if (yyDigitCount >= 6) {
		if (yyDigitCount == 8) {
		    return tISOBAS8;
		}
		if (yyDigitCount == 6) {
		    return tISOBAS6;
		}
	    }
	    /* ignore spaces after digits (optional) */
	    yyInput = bypassSpaces(yyInput);
	    return tUNUMBER;
	}
	if (!(c & 0x80) && isalpha(UCHAR(c))) {		  /* INTL: ISO only. */
	    int ret;
	    for (p = buff; isalpha(UCHAR(c = *yyInput++)) /* INTL: ISO only. */
		     || c == '.'; ) {
		if (p < &buff[sizeof(buff) - 1]) {
		    *p++ = c;
		}
	    }
	    *p = '\0';
	    yyInput--;
	    location->last_column = yyInput - info->dateStart - 1;
	    ret = LookupWord(yylvalPtr, buff);
	    /*
	     * lookahead:
	     *	for spaces to consider word boundaries (for instance
	     *	literal T in isodateTisotimeZ is not a TZ, but Z is UTC);
	     *	for +/- digit, to differentiate between "GMT+1000 day" and "GMT +1000 day";
	     * bypass spaces after token (but ignore by TZ+OFFS), because should
	     * recognize next SP token, if TZ only.
	     */
	    if (ret == tZONE || ret == tDAYZONE) {
		c = *yyInput;
		if (isdigit(UCHAR(c))) { /* literal not a TZ  */
		    yyInput = tokStart;
		    return *yyInput++;
		}
		if ((c == '+' || c == '-') && isdigit(UCHAR(*(yyInput+1)))) {
		    if ( !isdigit(UCHAR(*(yyInput+2)))
		      || !isdigit(UCHAR(*(yyInput+3)))) {
			/* GMT+1, GMT-10, etc. */
			return tZONEwO2;
		    }
		    if ( isdigit(UCHAR(*(yyInput+4)))
		      && !isdigit(UCHAR(*(yyInput+5)))) {
			/* GMT+1000, etc. */
			return tZONEwO4;
		    }
		}
	    }
	    yyInput = bypassSpaces(yyInput);
	    return ret;

	}
	if (c != '(') {
	    location->last_column = yyInput - info->dateStart;
	    return *yyInput++;
	}
	Count = 0;
	do {
	    c = *yyInput++;
	    if (c == '\0') {
		location->last_column = yyInput - info->dateStart - 1;
		return c;
	    } else if (c == '(') {
		Count++;
	    } else if (c == ')') {
		Count--;
	    }
	} while (Count > 0);
    }
}

int
TclClockFreeScan(
    Tcl_Interp *interp,		/* Tcl interpreter */
    DateInfo *info)		/* Input and result parameters */
{
    int status;

  #if YYDEBUG
    /* enable debugging if compiled with YYDEBUG */
    yydebug = 1;
  #endif

    /*
     * yyInput = stringToParse;
     *
     * ClockInitDateInfo(info) should be executed to pre-init info;
     */

    yyDSTmode = DSTmaybe;

    info->separatrix = "";

    info->dateStart = yyInput;

    /* ignore spaces at begin */
    yyInput = bypassSpaces(yyInput);

    /* parse */
    status = yyparse(info);
    if (status == 1) {
	const char *msg = NULL;
	if (info->errFlags & CLF_HAVEDATE) {
	    msg = "more than one date in string";
	} else if (info->errFlags & CLF_TIME) {
	    msg = "more than one time of day in string";
	} else if (info->errFlags & CLF_ZONE) {
	    msg = "more than one time zone in string";
	} else if (info->errFlags & CLF_DAYOFWEEK) {
	    msg = "more than one weekday in string";
	} else if (info->errFlags & CLF_ORDINALMONTH) {
	    msg = "more than one ordinal month in string";
	}
	if (msg) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL);
	} else {
	    Tcl_SetObjResult(interp,
		info->messages ? info->messages : Tcl_NewObj());
	    info->messages = NULL;
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", (char *)NULL);
	}
	status = TCL_ERROR;
    } else if (status == 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1));
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL);
	status = 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_SetErrorCode(interp, "TCL", "BUG", (char *)NULL);
	status = TCL_ERROR;
    }
    if (info->messages) {
	Tcl_DecrRefCount(info->messages);
    }
    return status;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Added generic/tclGetDateClassic.y.

































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * Copyright (c) 1992-1995 Karl Lehenbauer & 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * 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.
 */

%parse-param {DateInfo* info}
%lex-param {DateInfo* info}
%define api.pure
 /* %error-verbose would be nice, but our token names are meaningless */
%locations

%{
/*
 * 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 & 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.
 *
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" 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 */

/*
 * Meridian: am, pm, or 24-hour style.
 */

typedef enum _MERIDIAN {
    MERam, MERpm, MER24
} MERIDIAN;

/*
 * yyparse will accept a 'struct DateInfo' as its parameter; that's where the
 * parsed fields will be returned.
 */

typedef struct DateInfo {

    Tcl_Obj* messages;		/* Error messages */
    const char* separatrix;	/* String separating messages */

    time_t dateYear;
    time_t dateMonth;
    time_t dateDay;
    int dateHaveDate;

    time_t dateHour;
    time_t dateMinutes;
    time_t dateSeconds;
    MERIDIAN dateMeridian;
    int dateHaveTime;

    time_t dateTimezone;
    int dateDSTmode;
    int dateHaveZone;

    time_t dateRelMonth;
    time_t dateRelDay;
    time_t dateRelSeconds;
    int dateHaveRel;

    time_t dateMonthOrdinal;
    int dateHaveOrdinalMonth;

    time_t dateDayOrdinal;
    time_t dateDayNumber;
    int dateHaveDay;

    const char *dateStart;
    const char *dateInput;
    time_t *dateRelPointer;

    int dateDigitCount;
} DateInfo;

#define YYMALLOC	Tcl_Alloc
#define YYFREE(x)	(Tcl_Free((void*) (x)))

#define yyDSTmode	(info->dateDSTmode)
#define yyDayOrdinal	(info->dateDayOrdinal)
#define yyDayNumber	(info->dateDayNumber)
#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 yyDay		(info->dateDay)
#define yyMonth		(info->dateMonth)
#define yyYear		(info->dateYear)
#define yyHour		(info->dateHour)
#define yyMinutes	(info->dateMinutes)
#define yySeconds	(info->dateSeconds)
#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 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.
 */

#define TM_YEAR_BASE	1900

#define HOUR(x)		((int) (60 * (x)))
#define SECSPERDAY	(24L * 60L * 60L)
#define IsLeapYear(x)	(((x) % 4 == 0) && ((x) % 100 != 0 || (x) % 400 == 0))

/*
 * An entry in the lexical lookup table.
 */

typedef struct _TABLE {
    const char *name;
    int type;
    time_t value;
} TABLE;

/*
 * 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);
static time_t		ToSeconds(time_t Hours, time_t Minutes,
			    time_t Seconds, MERIDIAN Meridian);
MODULE_SCOPE int	yyparse(DateInfo*);

%}

%token	tAGO
%token	tDAY
%token	tDAYZONE
%token	tID
%token	tMERIDIAN
%token	tMONTH
%token	tMONTH_UNIT
%token	tSTARDATE
%token	tSEC_UNIT
%token	tSNUMBER
%token	tUNUMBER
%token	tZONE
%token	tEPOCH
%token	tDST
%token	tISOBASE
%token	tDAY_UNIT
%token	tNEXT

%type	<Number>	tDAY
%type	<Number>	tDAYZONE
%type	<Number>	tMONTH
%type	<Number>	tMONTH_UNIT
%type	<Number>	tDST
%type	<Number>	tSEC_UNIT
%type	<Number>	tSNUMBER
%type	<Number>	tUNUMBER
%type	<Number>	tZONE
%type	<Number>	tISOBASE
%type	<Number>	tDAY_UNIT
%type	<Number>	unit
%type	<Number>	sign
%type	<Number>	tNEXT
%type	<Number>	tSTARDATE
%type	<Meridian>	tMERIDIAN
%type	<Meridian>	o_merid

%%

spec	: /* NULL */
	| spec item
	;

item	: time {
	    yyHaveTime++;
	}
	| zone {
	    yyHaveZone++;
	}
	| date {
	    yyHaveDate++;
	}
	| ordMonth {
	    yyHaveOrdinalMonth++;
	}
	| day {
	    yyHaveDay++;
	}
	| relspec {
	    yyHaveRel++;
	}
	| iso {
	    yyHaveTime++;
	    yyHaveDate++;
	}
	| trek {
	    yyHaveTime++;
	    yyHaveDate++;
	    yyHaveRel++;
	}
	| number
	;

time	: tUNUMBER tMERIDIAN {
	    yyHour = $1;
	    yyMinutes = 0;
	    yySeconds = 0;
	    yyMeridian = $2;
	}
	| tUNUMBER ':' tUNUMBER o_merid {
	    yyHour = $1;
	    yyMinutes = $3;
	    yySeconds = 0;
	    yyMeridian = $4;
	}
	| tUNUMBER ':' tUNUMBER ':' tUNUMBER o_merid {
	    yyHour = $1;
	    yyMinutes = $3;
	    yySeconds = $5;
	    yyMeridian = $6;
	}
	;

zone	: tZONE tDST {
	    yyTimezone = $1;
	    if (yyTimezone > HOUR( 12)) yyTimezone -= HOUR(100);
	    yyDSTmode = DSTon;
	}
	| tZONE {
	    yyTimezone = $1;
	    if (yyTimezone > HOUR( 12)) yyTimezone -= HOUR(100);
	    yyDSTmode = DSToff;
	}
	| tDAYZONE {
	    yyTimezone = $1;
	    yyDSTmode = DSTon;
	}
	| sign tUNUMBER {
	    yyTimezone = -$1*($2 % 100 + ($2 / 100) * 60);
	    yyDSTmode = DSToff;
	}
	;

day	: tDAY {
	    yyDayOrdinal = 1;
	    yyDayNumber = $1;
	}
	| tDAY ',' {
	    yyDayOrdinal = 1;
	    yyDayNumber = $1;
	}
	| tUNUMBER tDAY {
	    yyDayOrdinal = $1;
	    yyDayNumber = $2;
	}
	| sign tUNUMBER tDAY {
	    yyDayOrdinal = $1 * $2;
	    yyDayNumber = $3;
	}
	| tNEXT tDAY {
	    yyDayOrdinal = 2;
	    yyDayNumber = $2;
	}
	;

date	: tUNUMBER '/' tUNUMBER {
	    yyMonth = $1;
	    yyDay = $3;
	}
	| tUNUMBER '/' tUNUMBER '/' tUNUMBER {
	    yyMonth = $1;
	    yyDay = $3;
	    yyYear = $5;
	}
	| tISOBASE {
	    yyYear = $1 / 10000;
	    yyMonth = ($1 % 10000)/100;
	    yyDay = $1 % 100;
	}
	| tUNUMBER '-' tMONTH '-' tUNUMBER {
	    yyDay = $1;
	    yyMonth = $3;
	    yyYear = $5;
	}
	| tUNUMBER '-' tUNUMBER '-' tUNUMBER {
	    yyMonth = $3;
	    yyDay = $5;
	    yyYear = $1;
	}
	| tMONTH tUNUMBER {
	    yyMonth = $1;
	    yyDay = $2;
	}
	| tMONTH tUNUMBER ',' tUNUMBER {
	    yyMonth = $1;
	    yyDay = $2;
	    yyYear = $4;
	}
	| tUNUMBER tMONTH {
	    yyMonth = $2;
	    yyDay = $1;
	}
	| tEPOCH {
	    yyMonth = 1;
	    yyDay = 1;
	    yyYear = EPOCH;
	}
	| tUNUMBER tMONTH tUNUMBER {
	    yyMonth = $2;
	    yyDay = $1;
	    yyYear = $3;
	}
	;

ordMonth: tNEXT tMONTH {
	    yyMonthOrdinal = 1;
	    yyMonth = $2;
	}
	| tNEXT tUNUMBER tMONTH {
	    yyMonthOrdinal = $2;
	    yyMonth = $3;
	}
	;

iso	: tUNUMBER '-' tUNUMBER '-' tUNUMBER tZONE
		tUNUMBER ':' tUNUMBER ':' tUNUMBER {
	    if ($6 != HOUR( 7) + HOUR(100)) YYABORT;
	    yyYear = $1;
	    yyMonth = $3;
	    yyDay = $5;
	    yyHour = $7;
	    yyMinutes = $9;
	    yySeconds = $11;
	}
	| tISOBASE tZONE tISOBASE {
	    if ($2 != HOUR( 7) + HOUR(100)) YYABORT;
	    yyYear = $1 / 10000;
	    yyMonth = ($1 % 10000)/100;
	    yyDay = $1 % 100;
	    yyHour = $3 / 10000;
	    yyMinutes = ($3 % 10000)/100;
	    yySeconds = $3 % 100;
	}
	| tISOBASE tZONE tUNUMBER ':' tUNUMBER ':' tUNUMBER {
	    if ($2 != HOUR( 7) + HOUR(100)) YYABORT;
	    yyYear = $1 / 10000;
	    yyMonth = ($1 % 10000)/100;
	    yyDay = $1 % 100;
	    yyHour = $3;
	    yyMinutes = $5;
	    yySeconds = $7;
	}
	| tISOBASE tISOBASE {
	    yyYear = $1 / 10000;
	    yyMonth = ($1 % 10000)/100;
	    yyDay = $1 % 100;
	    yyHour = $2 / 10000;
	    yyMinutes = ($2 % 10000)/100;
	    yySeconds = $2 % 100;
	}
	;

trek	: tSTARDATE tUNUMBER '.' tUNUMBER {
	    /*
	     * Offset computed year by -377 so that the returned years will be
	     * in a range accessible with a 32 bit clock seconds value.
	     */

	    yyYear = $2/1000 + 2323 - 377;
	    yyDay  = 1;
	    yyMonth = 1;
	    yyRelDay += (($2%1000)*(365 + IsLeapYear(yyYear)))/1000;
	    yyRelSeconds += $4 * 144 * 60;
	}
	;

relspec : relunits tAGO {
	    yyRelSeconds *= -1;
	    yyRelMonth *= -1;
	    yyRelDay *= -1;
	}
	| relunits
	;

relunits : sign tUNUMBER unit {
	    *yyRelPointer += $1 * $2 * $3;
	}
	| tUNUMBER unit {
	    *yyRelPointer += $1 * $2;
	}
	| tNEXT unit {
	    *yyRelPointer += $2;
	}
	| tNEXT tUNUMBER unit {
	    *yyRelPointer += $2 * $3;
	}
	| unit {
	    *yyRelPointer += $1;
	}
	;

sign	: '-' {
	    $$ = -1;
	}
	| '+' {
	    $$ =  1;
	}
	;

unit	: tSEC_UNIT {
	    $$ = $1;
	    yyRelPointer = &yyRelSeconds;
	}
	| tDAY_UNIT {
	    $$ = $1;
	    yyRelPointer = &yyRelDay;
	}
	| tMONTH_UNIT {
	    $$ = $1;
	    yyRelPointer = &yyRelMonth;
	}
	;

number	: tUNUMBER {
	    if (yyHaveTime && yyHaveDate && !yyHaveRel) {
		yyYear = $1;
	    } else {
		yyHaveTime++;
		if (yyDigitCount <= 2) {
		    yyHour = $1;
		    yyMinutes = 0;
		} else {
		    yyHour = $1 / 100;
		    yyMinutes = $1 % 100;
		}
		yySeconds = 0;
		yyMeridian = MER24;
	    }
	}
	;

o_merid : /* NULL */ {
	    $$ = MER24;
	}
	| tMERIDIAN {
	    $$ = $1;
	}
	;

%%
/*
 * Month and day table.
 */

static const TABLE MonthDayTable[] = {
    { "january",	tMONTH,	 1 },
    { "february",	tMONTH,	 2 },
    { "march",		tMONTH,	 3 },
    { "april",		tMONTH,	 4 },
    { "may",		tMONTH,	 5 },
    { "june",		tMONTH,	 6 },
    { "july",		tMONTH,	 7 },
    { "august",		tMONTH,	 8 },
    { "september",	tMONTH,	 9 },
    { "sept",		tMONTH,	 9 },
    { "october",	tMONTH, 10 },
    { "november",	tMONTH, 11 },
    { "december",	tMONTH, 12 },
    { "sunday",		tDAY, 0 },
    { "monday",		tDAY, 1 },
    { "tuesday",	tDAY, 2 },
    { "tues",		tDAY, 2 },
    { "wednesday",	tDAY, 3 },
    { "wednes",		tDAY, 3 },
    { "thursday",	tDAY, 4 },
    { "thur",		tDAY, 4 },
    { "thurs",		tDAY, 4 },
    { "friday",		tDAY, 5 },
    { "saturday",	tDAY, 6 },
    { NULL, 0, 0 }
};

/*
 * Time units table.
 */

static const TABLE UnitsTable[] = {
    { "year",		tMONTH_UNIT,	12 },
    { "month",		tMONTH_UNIT,	 1 },
    { "fortnight",	tDAY_UNIT,	14 },
    { "week",		tDAY_UNIT,	 7 },
    { "day",		tDAY_UNIT,	 1 },
    { "hour",		tSEC_UNIT, 60 * 60 },
    { "minute",		tSEC_UNIT,	60 },
    { "min",		tSEC_UNIT,	60 },
    { "second",		tSEC_UNIT,	 1 },
    { "sec",		tSEC_UNIT,	 1 },
    { NULL, 0, 0 }
};

/*
 * Assorted relative-time words.
 */

static const TABLE OtherTable[] = {
    { "tomorrow",	tDAY_UNIT,	1 },
    { "yesterday",	tDAY_UNIT,	-1 },
    { "today",		tDAY_UNIT,	0 },
    { "now",		tSEC_UNIT,	0 },
    { "last",		tUNUMBER,	-1 },
    { "this",		tSEC_UNIT,	0 },
    { "next",		tNEXT,		1 },
#if 0
    { "first",		tUNUMBER,	1 },
    { "second",		tUNUMBER,	2 },
    { "third",		tUNUMBER,	3 },
    { "fourth",		tUNUMBER,	4 },
    { "fifth",		tUNUMBER,	5 },
    { "sixth",		tUNUMBER,	6 },
    { "seventh",	tUNUMBER,	7 },
    { "eighth",		tUNUMBER,	8 },
    { "ninth",		tUNUMBER,	9 },
    { "tenth",		tUNUMBER,	10 },
    { "eleventh",	tUNUMBER,	11 },
    { "twelfth",	tUNUMBER,	12 },
#endif
    { "ago",		tAGO,		1 },
    { "epoch",		tEPOCH,		0 },
    { "stardate",	tSTARDATE,	0 },
    { NULL, 0, 0 }
};

/*
 * The timezone table. (Note: This table was modified to not use any floating
 * point constants to work around an SGI compiler bug).
 */

static const TABLE TimezoneTable[] = {
    { "gmt",	tZONE,	   HOUR( 0) },	    /* Greenwich Mean */
    { "ut",	tZONE,	   HOUR( 0) },	    /* Universal (Coordinated) */
    { "utc",	tZONE,	   HOUR( 0) },
    { "uct",	tZONE,	   HOUR( 0) },	    /* Universal Coordinated Time */
    { "wet",	tZONE,	   HOUR( 0) },	    /* Western European */
    { "bst",	tDAYZONE,  HOUR( 0) },	    /* British Summer */
    { "wat",	tZONE,	   HOUR( 1) },	    /* West Africa */
    { "at",	tZONE,	   HOUR( 2) },	    /* Azores */
#if	0
    /* For completeness.  BST is also British Summer, and GST is
     * also Guam Standard. */
    { "bst",	tZONE,	   HOUR( 3) },	    /* Brazil Standard */
    { "gst",	tZONE,	   HOUR( 3) },	    /* Greenland Standard */
#endif
    { "nft",	tZONE,	   HOUR( 7/2) },    /* Newfoundland */
    { "nst",	tZONE,	   HOUR( 7/2) },    /* Newfoundland Standard */
    { "ndt",	tDAYZONE,  HOUR( 7/2) },    /* Newfoundland Daylight */
    { "ast",	tZONE,	   HOUR( 4) },	    /* Atlantic Standard */
    { "adt",	tDAYZONE,  HOUR( 4) },	    /* Atlantic Daylight */
    { "est",	tZONE,	   HOUR( 5) },	    /* Eastern Standard */
    { "edt",	tDAYZONE,  HOUR( 5) },	    /* Eastern Daylight */
    { "cst",	tZONE,	   HOUR( 6) },	    /* Central Standard */
    { "cdt",	tDAYZONE,  HOUR( 6) },	    /* Central Daylight */
    { "mst",	tZONE,	   HOUR( 7) },	    /* Mountain Standard */
    { "mdt",	tDAYZONE,  HOUR( 7) },	    /* Mountain Daylight */
    { "pst",	tZONE,	   HOUR( 8) },	    /* Pacific Standard */
    { "pdt",	tDAYZONE,  HOUR( 8) },	    /* Pacific Daylight */
    { "yst",	tZONE,	   HOUR( 9) },	    /* Yukon Standard */
    { "ydt",	tDAYZONE,  HOUR( 9) },	    /* Yukon Daylight */
    { "akst",	tZONE,	   HOUR( 9) },	    /* Alaska Standard */
    { "akdt",	tDAYZONE,  HOUR( 9) },	    /* Alaska Daylight */
    { "hst",	tZONE,	   HOUR(10) },	    /* Hawaii Standard */
    { "hdt",	tDAYZONE,  HOUR(10) },	    /* Hawaii Daylight */
    { "cat",	tZONE,	   HOUR(10) },	    /* Central Alaska */
    { "ahst",	tZONE,	   HOUR(10) },	    /* Alaska-Hawaii Standard */
    { "nt",	tZONE,	   HOUR(11) },	    /* Nome */
    { "idlw",	tZONE,	   HOUR(12) },	    /* International Date Line West */
    { "cet",	tZONE,	  -HOUR( 1) },	    /* Central European */
    { "cest",	tDAYZONE, -HOUR( 1) },	    /* Central European Summer */
    { "met",	tZONE,	  -HOUR( 1) },	    /* Middle European */
    { "mewt",	tZONE,	  -HOUR( 1) },	    /* Middle European Winter */
    { "mest",	tDAYZONE, -HOUR( 1) },	    /* Middle European Summer */
    { "swt",	tZONE,	  -HOUR( 1) },	    /* Swedish Winter */
    { "sst",	tDAYZONE, -HOUR( 1) },	    /* Swedish Summer */
    { "fwt",	tZONE,	  -HOUR( 1) },	    /* French Winter */
    { "fst",	tDAYZONE, -HOUR( 1) },	    /* French Summer */
    { "eet",	tZONE,	  -HOUR( 2) },	    /* Eastern Europe, USSR Zone 1 */
    { "bt",	tZONE,	  -HOUR( 3) },	    /* Baghdad, USSR Zone 2 */
    { "it",	tZONE,	  -HOUR( 7/2) },    /* Iran */
    { "zp4",	tZONE,	  -HOUR( 4) },	    /* USSR Zone 3 */
    { "zp5",	tZONE,	  -HOUR( 5) },	    /* USSR Zone 4 */
    { "ist",	tZONE,	  -HOUR(11/2) },    /* Indian Standard */
    { "zp6",	tZONE,	  -HOUR( 6) },	    /* USSR Zone 5 */
#if	0
    /* For completeness.  NST is also Newfoundland Standard, and SST is
     * also Swedish Summer. */
    { "nst",	tZONE,	  -HOUR(13/2) },    /* North Sumatra */
    { "sst",	tZONE,	  -HOUR( 7) },	    /* South Sumatra, USSR Zone 6 */
#endif	/* 0 */
    { "wast",	tZONE,	  -HOUR( 7) },	    /* West Australian Standard */
    { "wadt",	tDAYZONE, -HOUR( 7) },	    /* West Australian Daylight */
    { "jt",	tZONE,	  -HOUR(15/2) },    /* Java (3pm in Cronusland!) */
    { "cct",	tZONE,	  -HOUR( 8) },	    /* China Coast, USSR Zone 7 */
    { "jst",	tZONE,	  -HOUR( 9) },	    /* Japan Standard, USSR Zone 8 */
    { "jdt",	tDAYZONE, -HOUR( 9) },	    /* Japan Daylight */
    { "kst",	tZONE,	  -HOUR( 9) },	    /* Korea Standard */
    { "kdt",	tDAYZONE, -HOUR( 9) },	    /* Korea Daylight */
    { "cast",	tZONE,	  -HOUR(19/2) },    /* Central Australian Standard */
    { "cadt",	tDAYZONE, -HOUR(19/2) },    /* Central Australian Daylight */
    { "east",	tZONE,	  -HOUR(10) },	    /* Eastern Australian Standard */
    { "eadt",	tDAYZONE, -HOUR(10) },	    /* Eastern Australian Daylight */
    { "gst",	tZONE,	  -HOUR(10) },	    /* Guam Standard, USSR Zone 9 */
    { "nzt",	tZONE,	  -HOUR(12) },	    /* New Zealand */
    { "nzst",	tZONE,	  -HOUR(12) },	    /* New Zealand Standard */
    { "nzdt",	tDAYZONE, -HOUR(12) },	    /* New Zealand Daylight */
    { "idle",	tZONE,	  -HOUR(12) },	    /* International Date Line East */
    /* ADDED BY Marco Nijdam */
    { "dst",	tDST,	  HOUR( 0) },	    /* DST on (hour is ignored) */
    /* End ADDED */
    { NULL, 0, 0 }
};

/*
 * Military timezone table.
 */

static const TABLE MilitaryTable[] = {
    { "a",	tZONE,	-HOUR( 1) + HOUR(100) },
    { "b",	tZONE,	-HOUR( 2) + HOUR(100) },
    { "c",	tZONE,	-HOUR( 3) + HOUR(100) },
    { "d",	tZONE,	-HOUR( 4) + HOUR(100) },
    { "e",	tZONE,	-HOUR( 5) + HOUR(100) },
    { "f",	tZONE,	-HOUR( 6) + HOUR(100) },
    { "g",	tZONE,	-HOUR( 7) + HOUR(100) },
    { "h",	tZONE,	-HOUR( 8) + HOUR(100) },
    { "i",	tZONE,	-HOUR( 9) + HOUR(100) },
    { "k",	tZONE,	-HOUR(10) + HOUR(100) },
    { "l",	tZONE,	-HOUR(11) + HOUR(100) },
    { "m",	tZONE,	-HOUR(12) + HOUR(100) },
    { "n",	tZONE,	HOUR(  1) + HOUR(100) },
    { "o",	tZONE,	HOUR(  2) + HOUR(100) },
    { "p",	tZONE,	HOUR(  3) + HOUR(100) },
    { "q",	tZONE,	HOUR(  4) + HOUR(100) },
    { "r",	tZONE,	HOUR(  5) + HOUR(100) },
    { "s",	tZONE,	HOUR(  6) + HOUR(100) },
    { "t",	tZONE,	HOUR(  7) + HOUR(100) },
    { "u",	tZONE,	HOUR(  8) + HOUR(100) },
    { "v",	tZONE,	HOUR(  9) + HOUR(100) },
    { "w",	tZONE,	HOUR( 10) + HOUR(100) },
    { "x",	tZONE,	HOUR( 11) + HOUR(100) },
    { "y",	tZONE,	HOUR( 12) + HOUR(100) },
    { "z",	tZONE,	HOUR( 0)  + HOUR(100) },
    { NULL, 0, 0 }
};

/*
 * Dump error messages in the bit bucket.
 */

static void
TclDateerror(
    YYLTYPE* location,
    DateInfo* infoPtr,
    const char *s)
{
    Tcl_Obj* t;
    Tcl_AppendToObj(infoPtr->messages, infoPtr->separatrix, -1);
    Tcl_AppendToObj(infoPtr->messages, s, -1);
    Tcl_AppendToObj(infoPtr->messages, " (characters ", -1);
    TclNewIntObj(t, location->first_column);
    Tcl_IncrRefCount(t);
    Tcl_AppendObjToObj(infoPtr->messages, t);
    Tcl_DecrRefCount(t);
    Tcl_AppendToObj(infoPtr->messages, "-", -1);
    TclNewIntObj(t, location->last_column);
    Tcl_IncrRefCount(t);
    Tcl_AppendObjToObj(infoPtr->messages, t);
    Tcl_DecrRefCount(t);
    Tcl_AppendToObj(infoPtr->messages, ")", -1);
    infoPtr->separatrix = "\n";
}

static time_t
ToSeconds(
    time_t Hours,
    time_t Minutes,
    time_t Seconds,
    MERIDIAN Meridian)
{
    if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59) {
	return -1;
    }
    switch (Meridian) {
    case MER24:
	if (Hours < 0 || Hours > 23) {
	    return -1;
	}
	return (Hours * 60L + Minutes) * 60L + Seconds;
    case MERam:
	if (Hours < 1 || Hours > 12) {
	    return -1;
	}
	return ((Hours % 12) * 60L + Minutes) * 60L + Seconds;
    case MERpm:
	if (Hours < 1 || Hours > 12) {
	    return -1;
	}
	return (((Hours % 12) + 12) * 60L + Minutes) * 60L + Seconds;
    }
    return -1;			/* Should never be reached */
}

static int
LookupWord(
    YYSTYPE* yylvalPtr,
    char *buff)
{
    char *p;
    char *q;
    const TABLE *tp;
    int i, abbrev;

    /*
     * Make it lowercase.
     */

    Tcl_UtfToLower(buff);

    if (strcmp(buff, "am") == 0 || strcmp(buff, "a.m.") == 0) {
	yylvalPtr->Meridian = MERam;
	return tMERIDIAN;
    }
    if (strcmp(buff, "pm") == 0 || strcmp(buff, "p.m.") == 0) {
	yylvalPtr->Meridian = MERpm;
	return tMERIDIAN;
    }

    /*
     * See if we have an abbreviation for a month.
     */

    if (strlen(buff) == 3) {
	abbrev = 1;
    } else if (strlen(buff) == 4 && buff[3] == '.') {
	abbrev = 1;
	buff[3] = '\0';
    } else {
	abbrev = 0;
    }

    for (tp = MonthDayTable; tp->name; tp++) {
	if (abbrev) {
	    if (strncmp(buff, tp->name, 3) == 0) {
		yylvalPtr->Number = tp->value;
		return tp->type;
	    }
	} else if (strcmp(buff, tp->name) == 0) {
	    yylvalPtr->Number = tp->value;
	    return tp->type;
	}
    }

    for (tp = TimezoneTable; tp->name; tp++) {
	if (strcmp(buff, tp->name) == 0) {
	    yylvalPtr->Number = tp->value;
	    return tp->type;
	}
    }

    for (tp = UnitsTable; tp->name; tp++) {
	if (strcmp(buff, tp->name) == 0) {
	    yylvalPtr->Number = tp->value;
	    return tp->type;
	}
    }

    /*
     * Strip off any plural and try the units table again.
     */

    i = strlen(buff) - 1;
    if (i > 0 && buff[i] == 's') {
	buff[i] = '\0';
	for (tp = UnitsTable; tp->name; tp++) {
	    if (strcmp(buff, tp->name) == 0) {
		yylvalPtr->Number = tp->value;
		return tp->type;
	    }
	}
    }

    for (tp = OtherTable; tp->name; tp++) {
	if (strcmp(buff, tp->name) == 0) {
	    yylvalPtr->Number = tp->value;
	    return tp->type;
	}
    }

    /*
     * Military timezones.
     */

    if (buff[1] == '\0' && !(*buff & 0x80)
	    && isalpha(UCHAR(*buff))) {			/* INTL: ISO only */
	for (tp = MilitaryTable; tp->name; tp++) {
	    if (strcmp(buff, tp->name) == 0) {
		yylvalPtr->Number = tp->value;
		return tp->type;
	    }
	}
    }

    /*
     * Drop out any periods and try the timezone table again.
     */

    for (i = 0, p = q = buff; *q; q++) {
	if (*q != '.') {
	    *p++ = *q;
	} else {
	    i++;
	}
    }
    *p = '\0';
    if (i) {
	for (tp = TimezoneTable; tp->name; tp++) {
	    if (strcmp(buff, tp->name) == 0) {
		yylvalPtr->Number = tp->value;
		return tp->type;
	    }
	}
    }

    return tID;
}

static int
TclDatelex(
    YYSTYPE* yylvalPtr,
    YYLTYPE* location,
    DateInfo *info)
{
    char c;
    char *p;
    char buff[20];
    int Count;

    location->first_column = yyInput - info->dateStart;
    for ( ; ; ) {
	while (TclIsSpaceProcM(*yyInput)) {
	    yyInput++;
	}

	if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */
	    /*
	     * Convert the string into a number; count the number of digits.
	     */

	    Count = 0;
	    for (yylvalPtr->Number = 0;
		    isdigit(UCHAR(c = *yyInput++)); ) {	  /* INTL: digit */
		yylvalPtr->Number = 10 * yylvalPtr->Number + c - '0';
		Count++;
	    }
	    yyInput--;
	    yyDigitCount = Count;

	    /*
	     * A number with 6 or more digits is considered an ISO 8601 base.
	     */

	    if (Count >= 6) {
		location->last_column = yyInput - info->dateStart - 1;
		return tISOBASE;
	    } else {
		location->last_column = yyInput - info->dateStart - 1;
		return tUNUMBER;
	    }
	}
	if (!(c & 0x80) && isalpha(UCHAR(c))) {		  /* INTL: ISO only. */
	    for (p = buff; isalpha(UCHAR(c = *yyInput++)) /* INTL: ISO only. */
		     || c == '.'; ) {
		if (p < &buff[sizeof buff - 1]) {
		    *p++ = c;
		}
	    }
	    *p = '\0';
	    yyInput--;
	    location->last_column = yyInput - info->dateStart - 1;
	    return LookupWord(yylvalPtr, buff);
	}
	if (c != '(') {
	    location->last_column = yyInput - info->dateStart;
	    return *yyInput++;
	}
	Count = 0;
	do {
	    c = *yyInput++;
	    if (c == '\0') {
		location->last_column = yyInput - info->dateStart - 1;
		return c;
	    } else if (c == '(') {
		Count++;
	    } else if (c == ')') {
		Count--;
	    }
	} while (Count > 0);
    }
}

int
TclClockOldscanObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Count of parameters */
    Tcl_Obj *const *objv)	/* Parameters */
{
    Tcl_Obj *result, *resultElement;
    int yr, mo, da;
    DateInfo dateInfo;
    DateInfo* info = &dateInfo;
    int status;

    if (objc != 5) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"stringToParse baseYear baseMonth baseDay" );
	return TCL_ERROR;
    }

    yyInput = TclGetString(objv[1]);
    dateInfo.dateStart = yyInput;

    yyHaveDate = 0;
    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;

    yyHaveTime = 0;
    yyHour = 0; yyMinutes = 0; yySeconds = 0; yyMeridian = MER24;

    yyHaveZone = 0;
    yyTimezone = 0; yyDSTmode = DSTmaybe;

    yyHaveOrdinalMonth = 0;
    yyMonthOrdinal = 0;

    yyHaveDay = 0;
    yyDayOrdinal = 0; yyDayNumber = 0;

    yyHaveRel = 0;
    yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL;

    TclNewObj(dateInfo.messages);
    dateInfo.separatrix = "";
    Tcl_IncrRefCount(dateInfo.messages);

    status = yyparse(&dateInfo);
    if (status == 1) {
	Tcl_SetObjResult(interp, dateInfo.messages);
	Tcl_DecrRefCount(dateInfo.messages);
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", (char *)NULL);
	return TCL_ERROR;
    } else if (status == 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1));
	Tcl_DecrRefCount(dateInfo.messages);
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)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(dateInfo.messages);
	Tcl_SetErrorCode(interp, "TCL", "BUG", (char *)NULL);
	return TCL_ERROR;
    }
    Tcl_DecrRefCount(dateInfo.messages);

    if (yyHaveDate > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one date in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL);
	return TCL_ERROR;
    }
    if (yyHaveTime > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one time of day in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL);
	return TCL_ERROR;
    }
    if (yyHaveZone > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one time zone in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL);
	return TCL_ERROR;
    }
    if (yyHaveDay > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one weekday in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL);
	return TCL_ERROR;
    }
    if (yyHaveOrdinalMonth > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one ordinal month in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL);
	return TCL_ERROR;
    }

    TclNewObj(result);
    TclNewObj(resultElement);
    if (yyHaveDate) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyYear));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyMonth));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyDay));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    if (yyHaveTime) {
	Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(
		ToSeconds(yyHour, yyMinutes, yySeconds, (MERIDIAN)yyMeridian)));
    } else {
	TclNewObj(resultElement);
	Tcl_ListObjAppendElement(interp, result, resultElement);
    }

    TclNewObj(resultElement);
    if (yyHaveZone) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(-yyTimezone));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(1 - yyDSTmode));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    TclNewObj(resultElement);
    if (yyHaveRel) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyRelMonth));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyRelDay));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyRelSeconds));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    TclNewObj(resultElement);
    if (yyHaveDay && !yyHaveDate) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyDayOrdinal));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyDayNumber));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    TclNewObj(resultElement);
    if (yyHaveOrdinalMonth) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyMonthOrdinal));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyMonth));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    Tcl_SetObjResult(interp, result);
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclHash.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
















14
15
16
17
18
19
20
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

-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclHash.c --
 *
 *	Implementation of in-memory hash tables for Tcl and Tcl-based
 *	applications.
 *
 * Copyright © 1991-1993 The Regents of the University of California.
 * Copyright © 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclHash.c --
 *
 *	Implementation of in-memory hash tables for Tcl and Tcl-based
 *	applications.
 */

#include "tclInt.h"

/*
 * When there are this many entries per bucket, on average, rebuild the hash
 * table to make it larger.
 */

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
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







-
-
-
-
-
-
+
+
+
+
+
+



-
-
-
-
-
-
+
+
+
+
+
+







			    int *newPtr);
static Tcl_HashEntry *	CreateHashEntry(Tcl_HashTable *tablePtr, const char *key,
			    int *newPtr);
static Tcl_HashEntry *	FindHashEntry(Tcl_HashTable *tablePtr, const char *key);
static void		RebuildTable(Tcl_HashTable *tablePtr);

const Tcl_HashKeyType tclArrayHashKeyType = {
    TCL_HASH_KEY_TYPE_VERSION,		/* version */
    TCL_HASH_KEY_RANDOMIZE_HASH,	/* flags */
    HashArrayKey,			/* hashKeyProc */
    CompareArrayKeys,			/* compareKeysProc */
    AllocArrayEntry,			/* allocEntryProc */
    NULL				/* freeEntryProc */
    TCL_HASH_KEY_TYPE_VERSION,	/* version */
    TCL_HASH_KEY_RANDOMIZE_HASH,/* flags */
    HashArrayKey,		/* hashKeyProc */
    CompareArrayKeys,		/* compareKeysProc */
    AllocArrayEntry,		/* allocEntryProc */
    NULL			/* freeEntryProc */
};

const Tcl_HashKeyType tclOneWordHashKeyType = {
    TCL_HASH_KEY_TYPE_VERSION,		/* version */
    0,					/* flags */
    NULL, /* HashOneWordKey, */		/* hashProc */
    NULL, /* CompareOneWordKey, */	/* compareProc */
    NULL, /* AllocOneWordKey, */	/* allocEntryProc */
    NULL  /* FreeOneWordKey, */		/* freeEntryProc */
    TCL_HASH_KEY_TYPE_VERSION,	/* version */
    0,				/* flags */
    NULL, /* HashOneWordKey, */	/* hashProc */
    NULL, /* CompareOneWordKey,	 * compareProc */
    NULL, /* AllocOneWordKey, *//* allocEntryProc */
    NULL  /* FreeOneWordKey, */	/* freeEntryProc */
};

const Tcl_HashKeyType tclStringHashKeyType = {
    TCL_HASH_KEY_TYPE_VERSION,		/* version */
    0,					/* flags */
    TclHashStringKey,			/* hashKeyProc */
    TclCompareStringKeys,		/* compareKeysProc */
100
101
102
103
104
105
106
107
108

109
110
111
112
113
114
115
111
112
113
114
115
116
117


118
119
120
121
122
123
124
125







-
-
+







 *	Tcl_CreateHashEntry.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_InitHashTable(
    Tcl_HashTable *tablePtr,
				/* Pointer to table record, which is supplied
    Tcl_HashTable *tablePtr,	/* Pointer to table record, which is supplied
				 * by the caller. */
    int keyType)		/* Type of keys to use in table:
				 * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, or an
				 * integer >= 2. */
{
    /*
     * Use a special value to inform the extended version that it must not
138
139
140
141
142
143
144
145
146

147
148
149
150
151
152


153
154
155
156
157
158
159
148
149
150
151
152
153
154


155
156
157
158
159
160

161
162
163
164
165
166
167
168
169







-
-
+





-
+
+







 *	Tcl_CreateHashEntry.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_InitCustomHashTable(
    Tcl_HashTable *tablePtr,
				/* Pointer to table record, which is supplied
    Tcl_HashTable *tablePtr,	/* Pointer to table record, which is supplied
				 * by the caller. */
    int keyType,		/* Type of keys to use in table:
				 * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
				 * TCL_CUSTOM_TYPE_KEYS, TCL_CUSTOM_PTR_KEYS,
				 * or an integer >= 2. */
    const Tcl_HashKeyType *typePtr) /* Pointer to structure which defines the
    const Tcl_HashKeyType *typePtr)
				/* Pointer to structure which defines the
				 * behaviour of this table. */
{
#if (TCL_SMALL_HASH_TABLE != 4)
    Tcl_Panic("Tcl_InitCustomHashTable: TCL_SMALL_HASH_TABLE is %d, not 4",
	    TCL_SMALL_HASH_TABLE);
#endif

279
280
281
282
283
284
285
286

287
288
289
290
291
292
293
289
290
291
292
293
294
295

296
297
298
299
300
301
302
303







-
+







	    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
		    hPtr = hPtr->nextPtr) {
		if (hash != hPtr->hash) {
		    continue;
		}
		/* if keys pointers or values are equal */
		if ((key == hPtr->key.oneWordValue)
		    || compareKeysProc((void *) key, hPtr)) {
			|| compareKeysProc((void *) key, hPtr)) {
		    if (newPtr) {
			*newPtr = 0;
		    }
		    return hPtr;
		}
	    }
	} else { /* no direct compare - compare key addresses only */
Changes to generic/tclHistory.c.

















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-
-







/*
 * Copyright © 1990-1993 The Regents of the University of California.
 * Copyright © 1994-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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclHistory.c --
 *
 *	This module and the Tcl library file history.tcl together implement
 *	Tcl command history. Tcl_RecordAndEval(Obj) can be called to record
 *	commands ("events") before they are executed. Commands defined in
 *	history.tcl may be used to perform history substitutions.
 *
 * Copyright © 1990-1993 The Regents of the University of California.
 * Copyright © 1994-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"

/*
 * Type of the assocData structure used to hold the reference to the [history
 * add] subcommand, used in Tcl_RecordAndEvalObj.
Changes to generic/tclIO.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
















15
16
17
18
19
20
21
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

-
-
-
-
-








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclIO.c --
 *
 *	This file provides the generic portions (those that are the same on
 *	all platforms and for all channel types) of Tcl's IO facilities.
 *
 * Copyright © 1998-2000 Ajuba Solutions
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 * Contributions from Don Porter, NIST, 2014. (not subject to US copyright)
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclIO.c --
 *
 *	This file provides the generic portions (those that are the same on
 *	all platforms and for all channel types) of Tcl's IO facilities.
 */

#include "tclInt.h"
#include "tclIO.h"
#include <assert.h>

/*
 * For each channel handler registered in a call to Tcl_CreateChannelHandler,
 * there is one record of the following type. All of records for a specific
164
165
166
167
168
169
170

171
172
173
174
175
176
177
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189







+







static int		CheckChannelErrors(ChannelState *statePtr,
			    int direction);
static int		CheckForDeadChannel(Tcl_Interp *interp,
			    ChannelState *statePtr);
static void		CheckForStdChannelsBeingClosed(Tcl_Channel chan);
static void		CleanupChannelHandlers(Tcl_Interp *interp,
			    Channel *chanPtr);
static void		CleanupTimerHandler(ChannelState *statePtr);
static int		CloseChannel(Tcl_Interp *interp, Channel *chanPtr,
			    int errorCode);
static int		CloseChannelPart(Tcl_Interp *interp, Channel *chanPtr,
			    int errorCode, int flags);
static int		CloseWrite(Tcl_Interp *interp, Channel *chanPtr);
static void		CommonGetsCleanup(Channel *chanPtr);
static int		CopyData(CopyState *csPtr, int mask);
227
228
229
230
231
232
233
234

235
236
237

238
239

240
241
242
243
244
245
246
239
240
241
242
243
244
245

246
247
248

249
250

251
252
253
254
255
256
257
258







-
+


-
+

-
+







			    const char *src, int *dstLenPtr, int *srcLenPtr);
static void		UpdateInterest(Channel *chanPtr);
static Tcl_Size		Write(Channel *chanPtr, const char *src,
			    Tcl_Size srcLen, Tcl_Encoding encoding);
static Tcl_Obj *	FixLevelCode(Tcl_Obj *msg);
static void		SpliceChannel(Tcl_Channel chan);
static void		CutChannel(Tcl_Channel chan);
static int	      WillRead(Channel *chanPtr);
static int		WillRead(Channel *chanPtr);

#define WriteChars(chanPtr, src, srcLen) \
			Write(chanPtr, src, srcLen, chanPtr->state->encoding)
	Write(chanPtr, src, srcLen, chanPtr->state->encoding)
#define WriteBytes(chanPtr, src, srcLen) \
			Write(chanPtr, src, srcLen, tclIdentityEncoding)
	Write(chanPtr, src, srcLen, tclIdentityEncoding)

/*
 * Simplifying helper macros. All may use their argument(s) multiple times.
 * The ANSI C "prototypes" for the macros are listed below, together with a
 * short description of what the macro does.
 *
 * --------------------------------------------------------------------------
310
311
312
313
314
315
316
317

318
319
320
321
322
323
324
322
323
324
325
326
327
328

329
330
331
332
333
334
335
336







-
+







 * Macro for testing whether a string (in optionName, length len) matches a
 * value (prefix matching rules). Arguments are the minimum length to match
 * and the value to match against. (Can't use Tcl_GetIndexFromObj as this is
 * used in a situation where no objects are available.)
 */

#define HaveOpt(minLength, nameString) \
	((len > (minLength)) && (optionName[1] == (nameString)[1]) \
	((len > (minLength)) && (optionName[1] == (nameString)[1])	\
		&& (strncmp(optionName, (nameString), len) == 0))

/*
 * The ChannelObjType type.  Used to store the result of looking up
 * a channel name in the context of an interp.  Saves the lookup
 * result and values needed to check its continued validity.
 */
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
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







-
-
+
+


-
+


-
+





-
+


-
+

-
+

+
-
+


-
-
-
+
+
+







} ResolvedChanName;

static void		DupChannelInternalRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static void		FreeChannelInternalRep(Tcl_Obj *objPtr);

static const Tcl_ObjType chanObjType = {
    "channel",			/* name for this type */
    FreeChannelInternalRep,		/* freeIntRepProc */
    DupChannelInternalRep,		/* dupIntRepProc */
    FreeChannelInternalRep,	/* freeIntRepProc */
    DupChannelInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    NULL,			/* setFromAnyProc */
    TCL_OBJTYPE_V0
	0
};

#define ChanSetInternalRep(objPtr, resPtr)					\
#define ChanSetInternalRep(objPtr, resPtr)				\
    do {								\
	Tcl_ObjInternalRep ir;						\
	(resPtr)->refCount++;						\
	ir.twoPtrValue.ptr1 = (resPtr);					\
	ir.twoPtrValue.ptr2 = NULL;					\
	Tcl_StoreInternalRep((objPtr), &chanObjType, &ir);			\
	Tcl_StoreInternalRep((objPtr), &chanObjType, &ir);		\
    } while (0)

#define ChanGetInternalRep(objPtr, resPtr)					\
#define ChanGetInternalRep(objPtr, resPtr) \
    do {								\
	const Tcl_ObjInternalRep *irPtr;					\
	const Tcl_ObjInternalRep *irPtr;				\
	irPtr = TclFetchInternalRep((objPtr), &chanObjType);		\
	(resPtr) = irPtr						\
	(resPtr) = irPtr ? (ResolvedChanName *)irPtr->twoPtrValue.ptr1 : NULL;		\
	    ? (ResolvedChanName *)irPtr->twoPtrValue.ptr1 : NULL;	\
    } while (0)

#define BUSY_STATE(st, fl) \
     ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \
      (((st)->csPtrW) && ((fl) & TCL_WRITABLE)))
#define BUSY_STATE(statePtr, flags) \
     ((((statePtr)->csPtrR) && ((flags) & TCL_READABLE)) ||		\
      (((statePtr)->csPtrW) && ((flags) & TCL_WRITABLE)))

#define MAX_CHANNEL_BUFFER_SIZE (1024*1024)

/*
 *---------------------------------------------------------------------------
 *
 * ChanClose, ChanRead, ChanSeek, ChanThreadAction, ChanWatch, ChanWrite --
843
844
845
846
847
848
849
850

851
852
853
854
855
856
857
856
857
858
859
860
861
862

863
864
865
866
867
868
869
870







-
+








void
Tcl_CreateCloseHandler(
    Tcl_Channel chan,		/* The channel for which to create the close
				 * callback. */
    Tcl_CloseProc *proc,	/* The callback routine to call when the
				 * channel will be closed. */
    void *clientData)	/* Arbitrary data to pass to the close
    void *clientData)		/* Arbitrary data to pass to the close
				 * callback. */
{
    ChannelState *statePtr = ((Channel *) chan)->state;
    CloseCallback *cbPtr;

    cbPtr = (CloseCallback *)Tcl_Alloc(sizeof(CloseCallback));
    cbPtr->proc = proc;
881
882
883
884
885
886
887
888

889
890
891
892
893
894
895
894
895
896
897
898
899
900

901
902
903
904
905
906
907
908







-
+








void
Tcl_DeleteCloseHandler(
    Tcl_Channel chan,		/* The channel for which to cancel the close
				 * callback. */
    Tcl_CloseProc *proc,	/* The procedure for the callback to
				 * remove. */
    void *clientData)	/* The callback data for the callback to
    void *clientData)		/* The callback data for the callback to
				 * remove. */
{
    ChannelState *statePtr = ((Channel *) chan)->state;
    CloseCallback *cbPtr, *cbPrevPtr;

    for (cbPtr = statePtr->closeCbPtr, cbPrevPtr = NULL;
	    cbPtr != NULL; cbPtr = cbPtr->nextPtr) {
980
981
982
983
984
985
986
987

988
989
990
991
992
993
994
993
994
995
996
997
998
999

1000
1001
1002
1003
1004
1005
1006
1007







-
+







 *	registered in this interpreter.
 *
 *----------------------------------------------------------------------
 */

static void
DeleteChannelTable(
    void *clientData,	/* The per-interpreter data structure. */
    void *clientData,		/* The per-interpreter data structure. */
    Tcl_Interp *interp)		/* The interpreter being deleted. */
{
    Tcl_HashTable *hTblPtr;	/* The hash table. */
    Tcl_HashSearch hSearch;	/* Search variable. */
    Tcl_HashEntry *hPtr;	/* Search variable. */
    Channel *chanPtr;		/* Channel being deleted. */
    ChannelState *statePtr;	/* State of Channel being deleted. */
1590
1591
1592
1593
1594
1595
1596
1597


1598
1599
1600
1601
1602
1603
1604
1603
1604
1605
1606
1607
1608
1609

1610
1611
1612
1613
1614
1615
1616
1617
1618







-
+
+







 *	Creates a new Tcl_Channel instance and inserts it into the hash table.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_CreateChannel(
    const Tcl_ChannelType *typePtr, /* The channel type record. */
    const Tcl_ChannelType *typePtr,
				/* The channel type record. */
    const char *chanName,	/* Name of channel to record. */
    void *instanceData,		/* Instance specific data. */
    int mask)			/* TCL_READABLE & TCL_WRITABLE to indicate if
				 * the channel is readable, writable. */
{
    Channel *chanPtr;		/* The channel structure newly created. */
    ChannelState *statePtr;	/* The stack-level independent state info for
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







+
+
+
+







	strcpy(tmp, chanName);
    } else {
	tmp = (char *)Tcl_Alloc(7);
	tmp[0] = '\0';
    }
    statePtr->channelName = tmp;
    statePtr->flags = mask;
	/* uncomment this to make default encoding error handling strict */
	/*
    statePtr->flags |= CHANNEL_ENCODING_STRICT;
	*/
    statePtr->maxPerms = mask; /* Save max privileges for close callback */

    /*
     * Set the channel to system default encoding.
     */

    name = Tcl_GetEncodingName(NULL);
2394
2395
2396
2397
2398
2399
2400
2401

2402
2403
2404
2405
2406
2407
2408
2412
2413
2414
2415
2416
2417
2418

2419
2420
2421
2422
2423
2424
2425
2426







-
+







 *----------------------------------------------------------------------
 */

int
Tcl_GetChannelHandle(
    Tcl_Channel chan,		/* The channel to get file from. */
    int direction,		/* TCL_WRITABLE or TCL_READABLE. */
    void **handlePtr)	/* Where to store handle */
    void **handlePtr)		/* Where to store handle */
{
    Channel *chanPtr;		/* The actual channel. */
    void *handle;
    int result;

    chanPtr = ((Channel *) chan)->state->bottomChanPtr;
    if (!chanPtr->typePtr->getHandleProc) {
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443




2444
2445
2446
2447
2448
2449
2450
2452
2453
2454
2455
2456
2457
2458



2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469







-
-
-
+
+
+
+







 *	May leave an error message in the interp.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_RemoveChannelMode(
     Tcl_Interp *interp,	/* The interp for an error message. Allowed to be NULL. */
     Tcl_Channel chan,		/* The channel which is modified. */
     int mode)			/* The access mode to drop from the channel */
    Tcl_Interp *interp,		/* The interp for an error message. Allowed to
				 * be NULL. */
    Tcl_Channel chan,		/* The channel which is modified. */
    int mode)			/* The access mode to drop from the channel */
{
    const char* emsg;
    ChannelState *statePtr = ((Channel *) chan)->state;
				/* State of actual channel. */

    if ((mode != TCL_READABLE) && (mode != TCL_WRITABLE)) {
	emsg = "Illegal mode value.";
2489
2490
2491
2492
2493
2494
2495
2496

2497
2498
2499
2500
2501
2502
2503
2508
2509
2510
2511
2512
2513
2514

2515
2516
2517
2518
2519
2520
2521
2522







-
+







 *	None.
 *
 *---------------------------------------------------------------------------
 */

static ChannelBuffer *
AllocChannelBuffer(
    Tcl_Size length)			/* Desired length of channel buffer. */
    Tcl_Size length)		/* Desired length of channel buffer. */
{
    ChannelBuffer *bufPtr;
    Tcl_Size n;

    n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;
    bufPtr = (ChannelBuffer *)Tcl_Alloc(n);
    bufPtr->nextAdded	= BUFFER_PADDING;
3440
3441
3442
3443
3444
3445
3446
3447

3448
3449
3450
3451
3452
3453
3454
3459
3460
3461
3462
3463
3464
3465

3466
3467
3468
3469
3470
3471
3472
3473







-
+







				 * referenced in any interpreter. May be NULL,
				 * in which case this is a no-op. */
{
    CloseCallback *cbPtr;	/* Iterate over close callbacks for this
				 * channel. */
    Channel *chanPtr;		/* The real IO channel. */
    ChannelState *statePtr;	/* State of real IO channel. */
    int result = 0;			/* Of calling FlushChannel. */
    int result = 0;		/* Of calling FlushChannel. */
    int flushcode;
    int stickyError;

    if (chan == NULL) {
	return TCL_OK;
    }

3519
3520
3521
3522
3523
3524
3525





3526
3527
3528
3529
3530
3531
3532
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556







+
+
+
+
+







	    TclDecrRefCount(statePtr->chanMsg);
	    statePtr->chanMsg = NULL;
	}
    }

    Tcl_ClearChannelHandlers(chan);

    /*
     * Cancel any outstanding timer.
     */
    DeleteTimerHandler(statePtr);

    /*
     * Invoke the registered close callbacks and delete their records.
     */

    while (statePtr->closeCbPtr != NULL) {
	cbPtr = statePtr->closeCbPtr;
	statePtr->closeCbPtr = cbPtr->nextPtr;
4058
4059
4060
4061
4062
4063
4064
4065
4066


4067
4068
4069
4070
4071
4072
4073
4082
4083
4084
4085
4086
4087
4088


4089
4090
4091
4092
4093
4094
4095
4096
4097







-
-
+
+







 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_Write(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    const char *src,		/* Data to queue in output buffer. */
    Tcl_Size srcLen)			/* Length of data in bytes, or TCL_INDEX_NONE for
				 * strlen(). */
    Tcl_Size srcLen)		/* Length of data in bytes, or TCL_INDEX_NONE
				 * for strlen(). */
{
    /*
     * Always use the topmost channel of the stack
     */

    Channel *chanPtr;
    ChannelState *statePtr;	/* State info for channel */
4170
4171
4172
4173
4174
4175
4176
4177
4178


4179
4180
4181
4182
4183
4184
4185
4194
4195
4196
4197
4198
4199
4200


4201
4202
4203
4204
4205
4206
4207
4208
4209







-
-
+
+







 */

Tcl_Size
Tcl_WriteChars(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    const char *src,		/* UTF-8 characters to queue in output
				 * buffer. */
    Tcl_Size len)			/* Length of string in bytes, or TCL_INDEX_NONE for
				 * strlen(). */
    Tcl_Size len)		/* Length of string in bytes, or TCL_INDEX_NONE
				 * for strlen(). */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;	/* State info for channel */
    Tcl_Size result;
    Tcl_Obj *objPtr;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
4271
4272
4273
4274
4275
4276
4277
4278

4279
4280
4281
4282
4283
4284
4285
4295
4296
4297
4298
4299
4300
4301

4302
4303
4304
4305
4306
4307
4308
4309







-
+







	    Tcl_SetErrno(EILSEQ);
	    result = TCL_INDEX_NONE;
	} else {
	    result = WriteBytes(chanPtr, src, srcLen);
	}
	return result;
    } else {
	src = TclGetStringFromObj(objPtr, &srcLen);
	src = Tcl_GetStringFromObj(objPtr, &srcLen);
	return WriteChars(chanPtr, src, srcLen);
    }
}

static void
WillWrite(
    Channel *chanPtr)
4665
4666
4667
4668
4669
4670
4671
4672

4673
4674
4675
4676
4677
4678
4679
4689
4690
4691
4692
4693
4694
4695

4696
4697
4698
4699
4700
4701
4702
4703







-
+







    encoding = statePtr->encoding;

    /*
     * Preserved so we can restore the channel's state in case we don't find a
     * newline in the available input.
     */

    (void)TclGetStringFromObj(objPtr, &oldLength);
    (void)Tcl_GetStringFromObj(objPtr, &oldLength);
    oldFlags = statePtr->inputEncodingFlags;
    oldState = statePtr->inputEncodingState;
    oldRemoved = BUFFER_PADDING;
    if (bufPtr != NULL) {
	oldRemoved = bufPtr->nextRemoved;
    }

5231
5232
5233
5234
5235
5236
5237
5238
5239
5240
5241

5242
5243
5244
5245
5246
5247
5248
5255
5256
5257
5258
5259
5260
5261

5262
5263
5264
5265
5266
5267
5268
5269
5270
5271
5272







-



+







    byteArray = Tcl_SetByteArrayLength(objPtr, byteLen + rawLen);
    memcpy(byteArray + byteLen, dst, rawLen);
    byteLen += rawLen;
    bufPtr->nextRemoved += rawLen + skip;

    /*
     * Convert the buffer if there was an encoding.
     * XXX - unimplemented.
     */

    if (statePtr->encoding != GetBinaryEncoding()) {
	// XXX - unimplemented!
    }

    /*
     * Recycle all the emptied buffers.
     */

    CommonGetsCleanup(chanPtr);
5711
5712
5713
5714
5715
5716
5717
5718

5719
5720
5721
5722
5723
5724
5725
5735
5736
5737
5738
5739
5740
5741

5742
5743
5744
5745
5746
5747
5748
5749







-
+







 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_Read(
    Tcl_Channel chan,		/* The channel from which to read. */
    char *dst,			/* Where to store input read. */
    Tcl_Size bytesToRead)		/* Maximum number of bytes to read. */
    Tcl_Size bytesToRead)	/* Maximum number of bytes to read. */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */

    /*
     * This operation should occur at the top of a channel stack.
5756
5757
5758
5759
5760
5761
5762
5763

5764
5765
5766
5767
5768
5769
5770
5780
5781
5782
5783
5784
5785
5786

5787
5788
5789
5790
5791
5792
5793
5794







-
+







 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_ReadRaw(
    Tcl_Channel chan,		/* The channel from which to read. */
    char *readBuf,		/* Where to store input read. */
    Tcl_Size bytesToRead)		/* Maximum number of bytes to read. */
    Tcl_Size bytesToRead)	/* Maximum number of bytes to read. */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    int copied = 0;

    assert(bytesToRead > 0);
5953
5954
5955
5956
5957
5958
5959

5960
5961
5962
5963
5964
5965
5966
5977
5978
5979
5980
5981
5982
5983
5984
5985
5986
5987
5988
5989
5990
5991







+







#define UTF_EXPANSION_FACTOR	1024
    int factor = UTF_EXPANSION_FACTOR;

    if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) {
	ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR);
	/* TODO: UpdateInterest not needed here? */
	UpdateInterest(chanPtr);

	Tcl_SetErrno(EILSEQ);
	return -1;
    }

    /*
     * Early out when next read will see eofchar.
     *
6054
6055
6056
6057
6058
6059
6060

6061
6062
6063
6064
6065
6066
6067
6079
6080
6081
6082
6083
6084
6085
6086
6087
6088
6089
6090
6091
6092
6093







+







	     * after the EOF character was encountered, so it doesn't count as
	     * a real error.
	     */

	    if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)
		    && !GotFlag(statePtr, CHANNEL_STICKY_EOF)
		    && (!GotFlag(statePtr, CHANNEL_NONBLOCKING))) {
		copied = -1;
		goto finish;
	    }
	}

	if (copiedNow < 0) {
	    if (GotFlag(statePtr, CHANNEL_EOF)) {
		break;
6132
6133
6134
6135
6136
6137
6138



6139
6140
6141
6142
6143
6144
6145
6158
6159
6160
6161
6162
6163
6164
6165
6166
6167
6168
6169
6170
6171
6172
6173
6174







+
+
+







	 * like [read] can also return an error.
	*/
	ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR);
	Tcl_SetErrno(EILSEQ);
	copied = -1;
    }
    TclChannelRelease((Tcl_Channel)chanPtr);
    if (copied == TCL_INDEX_NONE) {
	ResetFlag(statePtr, CHANNEL_ENCODING_ERROR|CHANNEL_EOF);
    }
    return copied;
}

/*
 *---------------------------------------------------------------------------
 *
 * ReadBytes --
6266
6267
6268
6269
6270
6271
6272
6273

6274
6275
6276
6277
6278
6279
6280
6295
6296
6297
6298
6299
6300
6301

6302
6303
6304
6305
6306
6307
6308
6309







-
+








    int factor = *factorPtr;
    int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;

    if (dstLimit <= 0) {
	dstLimit = INT_MAX; /* avoid overflow */
    }
    (void)TclGetStringFromObj(objPtr, &numBytes);
    (void) Tcl_GetStringFromObj(objPtr, &numBytes);
    TclAppendUtfToUtf(objPtr, NULL, dstLimit);
    if (toRead == srcLen) {
	Tcl_Size size;

	dst = TclGetStringStorage(objPtr, &size) + numBytes;
	dstLimit = (size - numBytes) > INT_MAX ? INT_MAX : (size - numBytes);
    } else {
6807
6808
6809
6810
6811
6812
6813
6814

6815
6816
6817
6818
6819
6820
6821
6836
6837
6838
6839
6840
6841
6842

6843
6844
6845
6846
6847
6848
6849
6850







-
+







 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_Ungets(
    Tcl_Channel chan,		/* The channel for which to add the input. */
    const char *str,		/* The input itself. */
    Tcl_Size len,			/* The length of the input. */
    Tcl_Size len,		/* The length of the input. */
    int atEnd)			/* If non-zero, add at end of queue; otherwise
				 * add at head of queue. */
{
    Channel *chanPtr;		/* The real IO channel. */
    ChannelState *statePtr;	/* State of actual channel. */
    ChannelBuffer *bufPtr;	/* Buffer to contain the data. */
    int flags;
7780
7781
7782
7783
7784
7785
7786
7787

7788
7789
7790
7791
7792
7793
7794
7809
7810
7811
7812
7813
7814
7815

7816
7817
7818
7819
7820
7821
7822
7823







-
+







 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetChannelBufferSize(
    Tcl_Channel chan,		/* The channel whose buffer size to set. */
    Tcl_Size sz)			/* The size to set. */
    Tcl_Size sz)		/* The size to set. */
{
    ChannelState *statePtr;	/* State of real channel structure. */

    /*
     * Clip the buffer size to force it into the [1,1M] range
     */

8289
8290
8291
8292
8293
8294
8295
8296
8297
8298
8299
8300
8301
8302
8303
8304
8305
8318
8319
8320
8321
8322
8323
8324

8325

8326
8327
8328
8329
8330
8331
8332







-

-







	statePtr->outputEncodingFlags = TCL_ENCODING_START;
	ENCODING_PROFILE_SET(statePtr->outputEncodingFlags, profile); /* Same as input */
	ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA|CHANNEL_ENCODING_ERROR);
	UpdateInterest(chanPtr);
	return TCL_OK;
    } else if (HaveOpt(2, "-eofchar")) {
	if (!newValue[0] || (!(newValue[0] & 0x80) && (!newValue[1]
#ifndef TCL_NO_DEPRECATED
		|| !strcmp(newValue+1, " {}")
#endif
		))) {
	    if (GotFlag(statePtr, TCL_READABLE)) {
		statePtr->inEofChar = newValue[0];
	    }
	} else {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
8756
8757
8758
8759
8760
8761
8762















8763
8764
8765
8766
8767
8768
8769
8783
8784
8785
8786
8787
8788
8789
8790
8791
8792
8793
8794
8795
8796
8797
8798
8799
8800
8801
8802
8803
8804
8805
8806
8807
8808
8809
8810
8811







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







		TclChannelPreserve((Tcl_Channel)chanPtr);
		statePtr->timerChanPtr = chanPtr;
		statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
			ChannelTimerProc, chanPtr);
	    }
	}
    }

    if (!statePtr->timer
	    && (mask & TCL_WRITABLE)
	    && GotFlag(statePtr, CHANNEL_NONBLOCKING)
	    && ( statePtr->curOutPtr
		&& !IsBufferEmpty(statePtr->curOutPtr)
		&& !IsBufferFull(statePtr->curOutPtr)
	    )
	) {
	    TclChannelPreserve((Tcl_Channel)chanPtr);
	    statePtr->timerChanPtr = chanPtr;
	    statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME
		,ChannelTimerProc ,chanPtr);
    }

    ChanWatch(chanPtr, mask);
}

/*
 *----------------------------------------------------------------------
 *
 * ChannelTimerProc --
8783
8784
8785
8786
8787
8788
8789
8790






8791
8792

8793
8794
8795
8796
8797
8798
8799





8800
8801
8802
8803
8804
8805
8806
8807

















8808
8809
8810
8811



8812
8813
8814






8815
8816
8817
8818
8819
8820
8821
8822
8823





8824
8825
8826
8827






8828
8829
8830
8831
8832
8833
8834
8835
8825
8826
8827
8828
8829
8830
8831
8832
8833
8834
8835
8836
8837
8838
8839

8840


8841




8842
8843
8844
8845
8846
8847
8848
8849
8850
8851



8852
8853
8854
8855
8856
8857
8858
8859
8860
8861
8862
8863
8864
8865
8866
8867
8868




8869
8870
8871



8872
8873
8874
8875
8876
8877
8878
8879
8880
8881
8882
8883
8884
8885
8886
8887
8888
8889
8890
8891




8892
8893
8894
8895
8896
8897

8898
8899
8900
8901
8902
8903
8904








+
+
+
+
+
+

-
+
-
-

-
-
-
-
+
+
+
+
+





-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
-
-
-
+
+
+
+
+
+









+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
-







static void
ChannelTimerProc(
    void *clientData)
{
    Channel *chanPtr = (Channel *)clientData;
    /* State info for channel */
    ChannelState *statePtr = chanPtr->state;

    /* TclChannelPreserve() must be called before the current function was
     * scheduled, is already in effect.  In this function it guards against
     * deallocation in Tcl_NotifyChannel and also keps the channel preserved
     * until ChannelTimerProc is later called again.
     */

    if (chanPtr->typePtr == NULL) {
	statePtr->timer = NULL;
	CleanupTimerHandler(statePtr);
	TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr);
	statePtr->timerChanPtr = NULL;
    } else {
	if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)
		&& (statePtr->interestMask & TCL_READABLE)
		&& (statePtr->inQueueHead != NULL)
		&& IsBufferReady(statePtr->inQueueHead)) {
	Tcl_Preserve(statePtr);
	statePtr->timer = NULL;
	if (statePtr->interestMask & TCL_WRITABLE
		&& GotFlag(statePtr, CHANNEL_NONBLOCKING)
		&& !GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
	    /*
	     * Restart the timer in case a channel handler reenters the event loop
	     * before UpdateInterest gets called by Tcl_NotifyChannel.
	     */
	    statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
		ChannelTimerProc,chanPtr);
	    Tcl_Preserve(statePtr);
	    Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE);
		    ChannelTimerProc, chanPtr);
	    Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_WRITABLE);
	} else {
	    /* The channel may have just been closed from within Tcl_NotifyChannel */
	    if (!GotFlag(statePtr, CHANNEL_INCLOSE)) {
		if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)
			&& (statePtr->interestMask & TCL_READABLE)
			&& (statePtr->inQueueHead != NULL)
			&& IsBufferReady(statePtr->inQueueHead)) {
		    /*
		     * Restart the timer in case a channel handler reenters the event loop
		     * before UpdateInterest gets called by Tcl_NotifyChannel.
		     */

		    statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
			    ChannelTimerProc, chanPtr);
		    Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE);
	    Tcl_Release(statePtr);
	} else {
	    statePtr->timer = NULL;
	    UpdateInterest(chanPtr);
		} else {
		    CleanupTimerHandler(statePtr);
		    UpdateInterest(chanPtr);
	    TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr);
	    statePtr->timerChanPtr = NULL;
	}
		}
	    } else {
		CleanupTimerHandler(statePtr);
	    }
	}
	Tcl_Release(statePtr);
    }
}

static void
DeleteTimerHandler(
    ChannelState *statePtr)
{
    if (statePtr->timer != NULL) {
	Tcl_DeleteTimerHandler(statePtr->timer);
	CleanupTimerHandler(statePtr);
    }
}
static void
CleanupTimerHandler(
	statePtr->timer = NULL;
	TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr);
	statePtr->timerChanPtr = NULL;
    }
    ChannelState *statePtr)
{
    TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr);
    statePtr->timer = NULL;
    statePtr->timerChanPtr = NULL;
}
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateChannelHandler --
 *
 *	Arrange for a given procedure to be invoked whenever the channel
8854
8855
8856
8857
8858
8859
8860
8861

8862
8863
8864
8865
8866
8867
8868
8923
8924
8925
8926
8927
8928
8929

8930
8931
8932
8933
8934
8935
8936
8937







-
+







    int mask,			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION: indicates
				 * conditions under which proc should be
				 * called. Use 0 to disable a registered
				 * handler. */
    Tcl_ChannelProc *proc,	/* Procedure to call for each selected
				 * event. */
    void *clientData)	/* Arbitrary data to pass to proc. */
    void *clientData)		/* Arbitrary data to pass to proc. */
{
    ChannelHandler *chPtr;
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */

    /*
8926
8927
8928
8929
8930
8931
8932
8933

8934
8935
8936
8937
8938
8939
8940
8995
8996
8997
8998
8999
9000
9001

9002
9003
9004
9005
9006
9007
9008
9009







-
+







 */

void
Tcl_DeleteChannelHandler(
    Tcl_Channel chan,		/* The channel for which to remove the
				 * callback. */
    Tcl_ChannelProc *proc,	/* The procedure in the callback to delete. */
    void *clientData)	/* The client data in the callback to
    void *clientData)		/* The client data in the callback to
				 * delete. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ChannelHandler *chPtr, *prevChPtr;
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
9132
9133
9134
9135
9136
9137
9138
9139

9140
9141
9142
9143
9144
9145
9146
9201
9202
9203
9204
9205
9206
9207

9208
9209
9210
9211
9212
9213
9214
9215







-
+







 *	Whatever the script does.
 *
 *----------------------------------------------------------------------
 */

void
TclChannelEventScriptInvoker(
    void *clientData,	/* The script+interp record. */
    void *clientData,		/* The script+interp record. */
    TCL_UNUSED(int) /*mask*/)
{
    EventScriptRecord *esPtr = (EventScriptRecord *)clientData;
				/* The event script + interpreter to eval it
				 * in. */
    Channel *chanPtr = esPtr->chanPtr;
				/* The channel for which this handler is
9775
9776
9777
9778
9779
9780
9781
9782

9783
9784
9785
9786


9787
9788
9789
9790
9791
9792
9793
9794
9795
9796
9797
9798
9799

9800
9801
9802
9803
9804
9805
9806
9844
9845
9846
9847
9848
9849
9850

9851
9852
9853


9854
9855
9856
9857
9858
9859
9860
9861
9862
9863
9864
9865
9866
9867

9868
9869
9870
9871
9872
9873
9874
9875







-
+


-
-
+
+












-
+







		sizeb = csPtr->bufSize;
	    } else {
		sizeb = csPtr->toRead;
	    }

	    if (moveBytes) {
		size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb,
			      !GotFlag(inStatePtr, CHANNEL_NONBLOCKING));
			!GotFlag(inStatePtr, CHANNEL_NONBLOCKING));
	    } else {
		size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb,
			!GotFlag(inStatePtr, CHANNEL_NONBLOCKING)
			,0 /* No append */);
			!GotFlag(inStatePtr, CHANNEL_NONBLOCKING),
			0 /* No append */);
		/*
		 * In case of a recoverable encoding error, any data before
		 * the error should be written. This data is in the bufObj.
		 * Program flow for this case:
		 * - Check, if there are any remaining bytes to write
		 * - If yes, simulate a successful read to write them out
		 * - Come back here by the outer loop and read again
		 * - Do not enter in the if below, as there are no pending
		 *  writes
		 * - Fail below with a read error
		 */
		if (size < 0 && Tcl_GetErrno() == EILSEQ) {
		    TclGetStringFromObj(bufObj, &sizePart);
		    Tcl_GetStringFromObj(bufObj, &sizePart);
		    if (sizePart > 0) {
			size = sizePart;
		    }
		}
	    }
	    underflow = (size >= 0) && (size < sizeb);	/* Input underflow */
	}
9861
9862
9863
9864
9865
9866
9867
9868

9869
9870
9871
9872
9873
9874
9875
9930
9931
9932
9933
9934
9935
9936

9937
9938
9939
9940
9941
9942
9943
9944







-
+







	 * Now write the buffer out.
	 */

	if (moveBytes) {
	    buffer = csPtr->buffer;
	    sizeb = WriteBytes(outStatePtr->topChanPtr, buffer, size);
	} else {
	    buffer = TclGetStringFromObj(bufObj, &sizeb);
	    buffer = Tcl_GetStringFromObj(bufObj, &sizeb);
	    sizeb = WriteChars(outStatePtr->topChanPtr, buffer, sizeb);
	}

	/*
	 * [Bug 2895565]. At this point 'size' still contains the number of
	 * characters which have been read. We keep this to later to
	 * update the totals and toRead information, see marker (UP) below. We
10048
10049
10050
10051
10052
10053
10054
10055

10056
10057
10058
10059
10060
10061
10062
10117
10118
10119
10120
10121
10122
10123

10124
10125
10126
10127
10128
10129
10130
10131







-
+







 *----------------------------------------------------------------------
 */

static Tcl_Size
DoRead(
    Channel *chanPtr,		/* The channel from which to read. */
    char *dst,			/* Where to store input read. */
    Tcl_Size bytesToRead,		/* Maximum number of bytes to read. */
    Tcl_Size bytesToRead,	/* Maximum number of bytes to read. */
    int allowShortReads)	/* Allow half-blocking (pipes,sockets) */
{
    ChannelState *statePtr = chanPtr->state;
    char *p = dst;

    /*
     * Early out when we know a read will get the eofchar.
11438
11439
11440
11441
11442
11443
11444
11445

11446
11447

11448
11449
11450
11451
11452
11453
11454
11507
11508
11509
11510
11511
11512
11513

11514
11515

11516
11517
11518
11519
11520
11521
11522
11523







-
+

-
+







 *	representation.
 *
 *----------------------------------------------------------------------
 */

static void
DupChannelInternalRep(
    Tcl_Obj *srcPtr,	/* Object with internal rep to copy. Must have
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. Must have
				 * an internal rep of type "Channel". */
    Tcl_Obj *copyPtr)	/* Object with internal rep to set. Must not
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. Must not
				 * currently have an internal rep.*/
{
    ResolvedChanName *resPtr;

    ChanGetInternalRep(srcPtr, resPtr);
    assert(resPtr);
    ChanSetInternalRep(copyPtr, resPtr);
11495
11496
11497
11498
11499
11500
11501
11502

11503
11504
11505
11506
11507
11508
11509
11564
11565
11566
11567
11568
11569
11570

11571
11572
11573
11574
11575
11576
11577
11578







-
+







DumpFlags(
    char *str,
    int flags)
{
    int i = 0;
    char buf[24];

#define ChanFlag(chr, bit)      (buf[i++] = ((flags & (bit)) ? (chr) : '_'))
#define ChanFlag(chr, bit)	(buf[i++] = ((flags & (bit)) ? (chr) : '_'))

    ChanFlag('r', TCL_READABLE);
    ChanFlag('w', TCL_WRITABLE);
    ChanFlag('n', CHANNEL_NONBLOCKING);
    ChanFlag('l', CHANNEL_LINEBUFFERED);
    ChanFlag('u', CHANNEL_UNBUFFERED);
    ChanFlag('F', BG_FLUSH_SCHEDULED);
Changes to generic/tclIO.h.
1
2
3
4
5
6
7
8
9
10
11
12
13
















14
15
16
17
18
19
20
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

-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclIO.h --
 *
 *	This file provides the generic portions (those that are the same on
 *	all platforms and for all channel types) of Tcl's IO facilities.
 *
 * Copyright (c) 1998-2000 Ajuba Solutions
 * 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclIO.h --
 *
 *	This file provides the generic portions (those that are the same on
 *	all platforms and for all channel types) of Tcl's IO facilities.
 */

/*
 * Make sure that both EAGAIN and EWOULDBLOCK are defined. This does not
 * compile on systems where neither is defined. We want both defined so that
 * we can test safely for both. In the code we still have to test for both
 * because there may be systems on which both are defined and have different
 * values.
 */
94
95
96
97
98
99
100
101


102
103
104
105
106
107
108
105
106
107
108
109
110
111

112
113
114
115
116
117
118
119
120







-
+
+







 * specific) instance data, and at a channel type structure.
 */

typedef struct Channel {
    struct ChannelState *state; /* Split out state information */
    void *instanceData;		/* Instance-specific data provided by creator
				 * of channel. */
    const Tcl_ChannelType *typePtr; /* Pointer to channel type structure. */
    const Tcl_ChannelType *typePtr;
				/* Pointer to channel type structure. */
    struct Channel *downChanPtr;/* Refers to channel this one was stacked
				 * upon. This reference is NULL for normal
				 * channels. See Tcl_StackChannel. */
    struct Channel *upChanPtr;	/* Refers to the channel above stacked this
				 * one. NULL for the top most channel. */

    /*
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
166
167
168
169
170
171
172





173
174
175
176
177
178
179







-
-
-
-
-







				/* What translation to apply for end of line
				 * sequences on input? */
    TclEolTranslation outputTranslation;
				/* What translation to use for generating end
				 * of line sequences in output? */
    int inEofChar;		/* If nonzero, use this as a signal of EOF on
				 * input. */
#if TCL_MAJOR_VERSION < 9
    int outEofChar;		/* If nonzero, append this to the channel when
				 * it is closed if it is open for writing.
				 * For Tcl 8.x only */
#endif
    int unreportedError;	/* Non-zero if an error report was deferred
				 * because it happened in the background. The
				 * value is the POSIX error code. */
    Tcl_Size refCount;		/* How many interpreters hold references to
				 * this IO channel? */
    struct CloseCallback *closeCbPtr;
				/* Callbacks registered to be called when the
Changes to generic/tclIOCmd.c.
1
2
3
4
5
6
7
8
9
10
11















12
13
14
15
16
17
18
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

-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclIOCmd.c --
 *
 *	Contains the definitions of most of the Tcl commands relating to IO.
 *
 * Copyright © 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclIOCmd.c --
 *
 *	Contains the definitions of most of the Tcl commands relating to IO.
 */

#include "tclInt.h"
#include "tclIO.h"
#include "tclTomMath.h"

/*
 * Callback structure for accept callback in a TCP server.
 */
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
314
315
316
317
318
319
320

321
322
323
324
325
326
327







-







    }

    TclChannelPreserve(chan);
    TclNewObj(linePtr);
    lineLen = Tcl_GetsObj(chan, linePtr);
    if (lineLen == TCL_IO_FAILURE) {
	if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
	    Tcl_DecrRefCount(linePtr);

	    /*
	     * TIP #219.
	     * Capture error messages put by the driver into the bypass area
	     * and put them into the regular interpreter result. Fall back to
	     * the regular message if nothing was found in the bypass.
	     */
365
366
367
368
369
370
371
372
373


374
375


376
377
378
379
380
381
382
375
376
377
378
379
380
381


382
383
384

385
386
387
388
389
390
391
392
393







-
-
+
+

-
+
+







    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;		/* The channel to read from. */
    int newline, i;		/* Discard newline at end? */
    Tcl_WideInt toRead;			/* How many bytes to read? */
    Tcl_Size charactersRead;		/* How many characters were read? */
    Tcl_WideInt toRead;		/* How many bytes to read? */
    Tcl_Size charactersRead;	/* How many characters were read? */
    int mode;			/* Mode in which channel is opened. */
    Tcl_Obj *resultPtr, *chanObjPtr;
    Tcl_Obj *resultPtr, *resultDictPtr, *returnOptsPtr, *chanObjPtr;
    int res, status;

    if ((objc != 2) && (objc != 3)) {
	Interp *iPtr;

    argerror:
	iPtr = (Interp *) interp;
	Tcl_WrongNumArgs(interp, 1, objv, "channel ?numChars?");
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
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







-
-
-
-
-
-
-
-












-
-
+
+
+
+
+
+
+
+

+
+

+

-
+









-
+







	}
    }

    TclNewObj(resultPtr);
    TclChannelPreserve(chan);
    charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
    if (charactersRead == TCL_IO_FAILURE) {
	Tcl_Obj *returnOptsPtr = NULL;
	if (TclChannelGetBlockingMode(chan)) {
	    returnOptsPtr = Tcl_NewDictObj();
	    Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-data", -1),
		    resultPtr);
	} else {
	    Tcl_DecrRefCount(resultPtr);
	}
	/*
	 * TIP #219.
	 * Capture error messages put by the driver into the bypass area and
	 * put them into the regular interpreter result. Fall back to the
	 * regular message if nothing was found in the bypass.
	 */

	if (!TclChanCaughtErrorBypass(interp, chan)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error reading \"%s\": %s",
		    TclGetString(chanObjPtr), Tcl_PosixError(interp)));
	}
	TclChannelRelease(chan);
	if (returnOptsPtr) {
	status = TclCheckEmptyString(interp, resultPtr, &res);
	if (!status && !res) {
	    resultDictPtr = Tcl_NewDictObj();
	    Tcl_DictObjPut(NULL, resultDictPtr, Tcl_NewStringObj("read", -1)
		, resultPtr);
	    returnOptsPtr = Tcl_NewDictObj();
	    Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-result", -1)
		, resultDictPtr);
	    Tcl_SetReturnOptions(interp, returnOptsPtr);
	} else {
		Tcl_DecrRefCount(resultPtr);
	}
	TclChannelRelease(chan);
	return TCL_ERROR;
    }
   }

    /*
     * If requested, remove the last newline in the channel if at EOF.
     */

    if ((charactersRead > 0) && (newline != 0)) {
	const char *result;
	Tcl_Size length;

	result = TclGetStringFromObj(resultPtr, &length);
	result = Tcl_GetStringFromObj(resultPtr, &length);
	if (result[length - 1] == '\n') {
	    Tcl_SetObjLength(resultPtr, length - 1);
	}
    }
    Tcl_SetObjResult(interp, resultPtr);
    TclChannelRelease(chan);
    return TCL_OK;
710
711
712
713
714
715
716
717

718
719
720
721
722
723
724
722
723
724
725
726
727
728

729
730
731
732
733
734
735
736







-
+







	const char *string;
	Tcl_Size len;

	if (Tcl_IsShared(resultPtr)) {
	    resultPtr = Tcl_DuplicateObj(resultPtr);
	    Tcl_SetObjResult(interp, resultPtr);
	}
	string = TclGetStringFromObj(resultPtr, &len);
	string = Tcl_GetStringFromObj(resultPtr, &len);
	if ((len > 0) && (string[len - 1] == '\n')) {
	    Tcl_SetObjLength(resultPtr, len - 1);
	}
	return TCL_ERROR;
    }

    return TCL_OK;
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
994
995
996
997
998
999
1000





1001
1002
1003
1004
1005
1006
1007







-
-
-
-
-








    TclStackFree(interp, (void *) argv);

    if (chan == NULL) {
	return TCL_ERROR;
    }

    /* Bug [0f1ddc0df7] - encoding errors - use replace profile */
    if (Tcl_SetChannelOption(NULL, chan, "-profile", "replace") != TCL_OK) {
	return TCL_ERROR;
    }

    if (background) {
	/*
	 * Store the list of PIDs from the pipeline in interp's result and
	 * detach the PIDs (instead of waiting for them).
	 */

	TclGetAndDetachPids(interp, chan);
1035
1036
1037
1038
1039
1040
1041
1042

1043
1044
1045
1046
1047
1048
1049
1042
1043
1044
1045
1046
1047
1048

1049
1050
1051
1052
1053
1054
1055
1056







-
+








    /*
     * If the last character of the result is a newline, then remove the
     * newline character.
     */

    if (keepNewline == 0) {
	string = TclGetStringFromObj(resultPtr, &length);
	string = Tcl_GetStringFromObj(resultPtr, &length);
	if ((length > 0) && (string[length - 1] == '\n')) {
	    Tcl_SetObjLength(resultPtr, length - 1);
	}
    }
    Tcl_SetObjResult(interp, resultPtr);

    return result;
1235
1236
1237
1238
1239
1240
1241
1242

1243
1244
1245
1246
1247
1248
1249
1242
1243
1244
1245
1246
1247
1248

1249
1250
1251
1252
1253
1254
1255
1256







-
+







 *	subsequently to eval accept scripts.
 *
 *----------------------------------------------------------------------
 */

static void
TcpAcceptCallbacksDeleteProc(
    void *clientData,	/* Data which was passed when the assocdata
    void *clientData,		/* Data which was passed when the assocdata
				 * was registered. */
    TCL_UNUSED(Tcl_Interp *))
{
    Tcl_HashTable *hTblPtr = (Tcl_HashTable *)clientData;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch hSearch;

1363
1364
1365
1366
1367
1368
1369
1370

1371
1372
1373
1374
1375
1376
1377
1370
1371
1372
1373
1374
1375
1376

1377
1378
1379
1380
1381
1382
1383
1384







-
+







 *	Whatever the script does.
 *
 *----------------------------------------------------------------------
 */

static void
AcceptCallbackProc(
    void *callbackData,	/* The data stored when the callback was
    void *callbackData,		/* The data stored when the callback was
				 * created in the call to
				 * Tcl_OpenTcpServer. */
    Tcl_Channel chan,		/* Channel for the newly accepted
				 * connection. */
    char *address,		/* Address of client that was accepted. */
    int port)			/* Port of client that was accepted. */
{
1454
1455
1456
1457
1458
1459
1460
1461

1462
1463
1464
1465
1466
1467
1468
1461
1462
1463
1464
1465
1466
1467

1468
1469
1470
1471
1472
1473
1474
1475







-
+







 *	longer be informed.
 *
 *----------------------------------------------------------------------
 */

static void
TcpServerCloseProc(
    void *callbackData)	/* The data passed in the call to
    void *callbackData)		/* The data passed in the call to
				 * Tcl_CreateCloseHandler. */
{
    AcceptCallback *acceptCallbackPtr = (AcceptCallback *)callbackData;
				/* The actual data. */

    if (acceptCallbackPtr->interp != NULL) {
	UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
Changes to generic/tclIOGT.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
















14
15
16
17
18
19
20
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

-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclIOGT.c --
 *
 *	Implements a generic transformation exposing the underlying API at the
 *	script level. Contributed by Andreas Kupries.
 *
 * Copyright © 2000 Ajuba Solutions
 * Copyright © 1999-2000 Andreas Kupries (a.kupries@westend.com)
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclIOGT.c --
 *
 *	Implements a generic transformation exposing the underlying API at the
 *	script level. Contributed by Andreas Kupries.
 */

#include "tclInt.h"
#include "tclIO.h"

/*
 * Forward declarations of internal procedures. First the driver procedures of
 * the transformation.
 */
375
376
377
378
379
380
381
382





383
384
385
386
387
388
389
386
387
388
389
390
391
392

393
394
395
396
397
398
399
400
401
402
403
404







-
+
+
+
+
+







				 * interpreters. */
{
    Tcl_Obj *resObj;		/* See below, switch (transmit). */
    Tcl_Size resLen = 0;
    unsigned char *resBuf;
    Tcl_InterpState state = NULL;
    int res = TCL_OK;
    Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command);
    Tcl_Obj *command = TclDuplicatePureObj(
	interp, dataPtr->command, tclListTypePtr);
    if (!command) {
	return TCL_ERROR;
    }
    Tcl_Interp *eval = dataPtr->interp;

    Tcl_Preserve(eval);

    /*
     * Step 1, create the complete command to execute. Do this by appending
     * operation and buffer to operate upon to a copy of the callback
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







-
+







 *	0 if successful, errno when failed.
 *
 *----------------------------------------------------------------------
 */

static int
TransformBlockModeProc(
    void *instanceData,	/* State of transformation. */
    void *instanceData,		/* State of transformation. */
    int mode)			/* New blocking mode. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;

    if (mode == TCL_MODE_NONBLOCKING) {
	dataPtr->flags |= CHANNEL_ASYNC;
    } else {
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







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
TransformWatchProc(
    void *instanceData,	/* Channel to watch. */
    void *instanceData,		/* Channel to watch. */
    int mask)			/* Events of interest. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    Tcl_Channel downChan;

    /*
     * The caller expressed interest in events occurring for this channel. We
1087
1088
1089
1090
1091
1092
1093
1094

1095
1096

1097
1098
1099
1100
1101
1102
1103
1102
1103
1104
1105
1106
1107
1108

1109
1110

1111
1112
1113
1114
1115
1116
1117
1118







-
+

-
+







 *	The appropriate Tcl_File or NULL if not present.
 *
 *----------------------------------------------------------------------
 */

static int
TransformGetFileHandleProc(
    void *instanceData,	/* Channel to query. */
    void *instanceData,		/* Channel to query. */
    int direction,		/* Direction of interest. */
    void **handlePtr)	/* Place to store the handle into. */
    void **handlePtr)		/* Place to store the handle into. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;

    /*
     * Return the handle belonging to parent channel. IOW, pass the request
     * down and the result up.
     */
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







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TransformNotifyProc(
    void *clientData,	/* The state of the notified
    void *clientData,		/* The state of the notified
				 * transformation. */
    int mask)			/* The mask of occurring events. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)clientData;

    /*
     * An event occurred in the underlying channel. This transformation doesn't
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







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
TransformChannelHandlerTimer(
    void *clientData)	/* Transformation to query. */
    void *clientData)		/* Transformation to query. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)clientData;

    dataPtr->timer = NULL;
    if (!(dataPtr->watchMask&TCL_READABLE) || ResultEmpty(&dataPtr->result)) {
	/*
	 * The timer fired, but either is there no (more) interest in the
Changes to generic/tclIORChan.c.
















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+











-
-
-
-
-







/*
 * Copyright © 2004-2005 ActiveState, a division of Sophos
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclIORChan.c --
 *
 *	This file contains the implementation of Tcl's generic channel
 *	reflection code, which allows the implementation of Tcl channels in
 *	Tcl code.
 *
 *	Parts of this file are based on code contributed by Jean-Claude
 *	Wippler.
 *
 *	See TIP #219 for the specification of this functionality.
 *
 * Copyright © 2004-2005 ActiveState, a division of Sophos
 *
 * 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 "tclIO.h"
#include <assert.h>

#ifndef EINVAL
50
51
52
53
54
55
56


57
58
59
60
61
62
63
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76







+
+







			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static int		ReflectSetOption(void *clientData,
			    Tcl_Interp *interp, const char *optionName,
			    const char *newValue);
static int		ReflectTruncate(void *clientData,
			    long long length);
static void		TimerRunRead(void *clientData);
static void		TimerRunWrite(void *clientData);

/*
 * The C layer channel type/driver definition used by the reflection.
 */

static const Tcl_ChannelType reflectedChannelType = {
    "tclrchannel",
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
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







+
+
+
+
+
+
+









-
-
-
+
-
-
+
+







    int mode;			/* Mask of R/W mode */
    int interest;		/* Mask of events the channel is interested
				 * in. */

    int dead;			/* Boolean signal that some operations
				 * should no longer be attempted. */

    Tcl_TimerToken readTimer;   /* A token for the timer that is scheduled in
				 * order to call Tcl_NotifyChannel when the
				 * channel is readable */
    Tcl_TimerToken writeTimer;  /* A token for the timer that is scheduled in
				 * order to call Tcl_NotifyChannel when the
				 * channel is writable */

    /*
     * Note regarding the usage of timers.
     *
     * Most channel implementations need a timer in the C level to ensure that
     * data in buffers is flushed out through the generation of fake file
     * events.
     *
     * See 'refchan', 'memchan', etc.
     *
     * Here this is _not_ required. Interest in events is posted to the Tcl
     * level via 'watch'. And posting of events is possible from the Tcl level
     * as well, via 'chan postevent'. This means that the generation of all
     * A timer is used here as well in order to ensure at least on pass through
     * events, fake or not, timer based or not, is completely in the hands of
     * the Tcl level. Therefore no timer here.
     * the event loop when a channel becomes ready. See issues 67a5eabbd3d1 and
     * ef28eb1f1516.
     */
} ReflectedChannel;

/*
 * Structure of the table mapping from channel handles to reflected
 * channels. Each interpreter which has the handler command for one or more
 * reflected channels records them in such a table, so that 'chan postevent'
194
195
196
197
198
199
200
201

202
203

204
205
206
207
208
209
210
212
213
214
215
216
217
218

219


220
221
222
223
224
225
226
227







-
+
-
-
+







	(FLAG(METH_BLOCKING) | FLAG(METH_SEEK) | \
	FLAG(METH_CONFIGURE) | FLAG(METH_CGET) | \
	FLAG(METH_CGETALL)   | FLAG(METH_TRUNCATE))

#define RANDW \
	(TCL_READABLE | TCL_WRITABLE)

#define IMPLIES(a,b)	((!(a)) || (b))
#define IMPLIES(a, b)	((!(a)) || (b))
#define NEGIMPL(a,b)
#define HAS(x,f)	((x) & FLAG(f))
#define HAS(x, f)	((x) & FLAG(f))

#if TCL_THREADS
/*
 * Thread specific types and structures.
 *
 * We are here essentially creating a very specific implementation of 'thread
 * send'.
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
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







-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








-
-
+
+







 */

static void		ForwardOpToHandlerThread(ReflectedChannel *rcPtr,
			    ForwardedOperation op, const void *param);
static int		ForwardProc(Tcl_Event *evPtr, int mask);
static void		SrcExitProc(void *clientData);

#define FreeReceivedError(p) \
	if ((p)->base.mustFree) {                               \
	    Tcl_Free((p)->base.msgStr);                           \
#define FreeReceivedError(fwdParam) \
	if ((fwdParam)->base.mustFree) {				\
	    Tcl_Free((fwdParam)->base.msgStr);				\
	}
#define PassReceivedErrorInterp(i,p) \
	if ((i) != NULL) {                                      \
	    Tcl_SetChannelErrorInterp((i),                      \
		    Tcl_NewStringObj((p)->base.msgStr, -1));    \
	}                                                       \
	FreeReceivedError(p)
#define PassReceivedError(c,p) \
	Tcl_SetChannelError((c), Tcl_NewStringObj((p)->base.msgStr, -1)); \
	FreeReceivedError(p)
#define ForwardSetStaticError(p,emsg) \
	(p)->base.code = TCL_ERROR;                             \
	(p)->base.mustFree = 0;                                 \
	(p)->base.msgStr = (char *) (emsg)
#define ForwardSetDynamicError(p,emsg) \
	(p)->base.code = TCL_ERROR;                             \
	(p)->base.mustFree = 1;                                 \
	(p)->base.msgStr = (char *) (emsg)
#define PassReceivedErrorInterp(interp, fwdParam) \
	if ((interp) != NULL) {						\
	    Tcl_SetChannelErrorInterp((interp),				\
		    Tcl_NewStringObj((fwdParam)->base.msgStr, -1));	\
	}								\
	FreeReceivedError(fwdParam)
#define PassReceivedError(chan, fwdParam) \
	Tcl_SetChannelError((chan),					\
		Tcl_NewStringObj((fwdParam)->base.msgStr, -1));		\
	FreeReceivedError(fwdParam)
#define ForwardSetStaticError(fwdParam, emsg) \
	(fwdParam)->base.code = TCL_ERROR;				\
	(fwdParam)->base.mustFree = 0;					\
	(fwdParam)->base.msgStr = (char *) (emsg)
#define ForwardSetDynamicError(fwdParam, emsg) \
	(fwdParam)->base.code = TCL_ERROR;				\
	(fwdParam)->base.mustFree = 1;					\
	(fwdParam)->base.msgStr = (char *) (emsg)

static void		ForwardSetObjError(ForwardParam *p, Tcl_Obj *objPtr);

static ReflectedChannelMap *	GetThreadReflectedChannelMap(void);
static Tcl_ExitProc	DeleteThreadReflectedChannelMap;

#endif /* TCL_THREADS */

#define SetChannelErrorStr(c,msgStr) \
	Tcl_SetChannelError((c), Tcl_NewStringObj((msgStr), -1))
#define SetChannelErrorStr(chan, msgStr) \
	Tcl_SetChannelError((chan), Tcl_NewStringObj((msgStr), -1))

static Tcl_Obj *	MarshallError(Tcl_Interp *interp);
static void		UnmarshallErrorResult(Tcl_Interp *interp,
			    Tcl_Obj *msgObj);

/*
 * Static functions for this file:
932
933
934
935
936
937
938
939












940
941
942
943
944
945
946
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







-
+
+
+
+
+
+
+
+
+
+
+
+







    /*
     * We have the channel and the events to post.
     */

#if TCL_THREADS
    if (rcPtr->owner == rcPtr->thread) {
#endif
	Tcl_NotifyChannel(chan, events);
	if (events & TCL_READABLE) {
	    if (rcPtr->readTimer == NULL) {
		rcPtr->readTimer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
			TimerRunRead, rcPtr);
	    }
	}
	if (events & TCL_WRITABLE) {
	    if (rcPtr->writeTimer == NULL) {
		rcPtr->writeTimer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
			TimerRunWrite, rcPtr);
	    }
	}
#if TCL_THREADS
    } else {
	ReflectEvent *ev = (ReflectEvent *)Tcl_Alloc(sizeof(ReflectEvent));

	ev->header.proc = ReflectEventRun;
	ev->events = events;
	ev->rcPtr = rcPtr;
976
977
978
979
980
981
982


















983
984
985
986
987
988
989
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    /*
     * Squash interp results left by the event script.
     */

    Tcl_ResetResult(interp);
    return TCL_OK;
}

static void
TimerRunRead(
    void *clientData)
{
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    rcPtr->readTimer = NULL;
    Tcl_NotifyChannel(rcPtr->chan, TCL_READABLE);
}

static void
TimerRunWrite(
    void *clientData)
{
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    rcPtr->writeTimer = NULL;
    Tcl_NotifyChannel(rcPtr->chan, TCL_WRITABLE);
}

/*
 * Channel error message marshalling utilities.
 */

static Tcl_Obj *
MarshallError(
1175
1176
1177
1178
1179
1180
1181






1182
1183
1184
1185
1186
1187
1188
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241







+
+
+
+
+
+







#endif

	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
	if (tctPtr && tctPtr != &reflectedChannelType) {
	    Tcl_Free((void *)tctPtr);
	    ((Channel *)rcPtr->chan)->typePtr = NULL;
	}
	if (rcPtr->readTimer != NULL) {
	    Tcl_DeleteTimerHandler(rcPtr->readTimer);
	}
	if (rcPtr->writeTimer != NULL) {
	    Tcl_DeleteTimerHandler(rcPtr->writeTimer);
	}
	Tcl_EventuallyFree(rcPtr, FreeReflectedChannel);
	return EOK;
    }

    /*
     * Are we in the correct thread?
     */
1244
1245
1246
1247
1248
1249
1250






1251
1252
1253
1254
1255
1256
1257
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316







+
+
+
+
+
+







    }
#endif
    tctPtr = ((Channel *)rcPtr->chan)->typePtr;
    if (tctPtr && tctPtr != &reflectedChannelType) {
	Tcl_Free((void *)tctPtr);
	((Channel *)rcPtr->chan)->typePtr = NULL;
    }
    if (rcPtr->readTimer != NULL) {
	Tcl_DeleteTimerHandler(rcPtr->readTimer);
    }
    if (rcPtr->writeTimer != NULL) {
	Tcl_DeleteTimerHandler(rcPtr->writeTimer);
    }
    Tcl_EventuallyFree(rcPtr, FreeReflectedChannel);
    return (result == TCL_OK) ? EOK : EINVAL;
}

/*
 *----------------------------------------------------------------------
 *
1704
1705
1706
1707
1708
1709
1710
1711

1712
1713
1714
1715
1716
1717
1718
1763
1764
1765
1766
1767
1768
1769

1770
1771
1772
1773
1774
1775
1776
1777







-
+







#endif

    blockObj = Tcl_NewBooleanObj(!nonblocking);
    Tcl_IncrRefCount(blockObj);

    Tcl_Preserve(rcPtr);

    if (InvokeTclMethod(rcPtr,METH_BLOCKING,blockObj,NULL,&resObj)!=TCL_OK) {
    if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL, &resObj)!=TCL_OK) {
	Tcl_SetChannelError(rcPtr->chan, resObj);
	errorNum = EINVAL;
    } else {
	errorNum = EOK;
    }

    Tcl_DecrRefCount(blockObj);
1774
1775
1776
1777
1778
1779
1780
1781

1782
1783
1784
1785
1786
1787
1788
1833
1834
1835
1836
1837
1838
1839

1840
1841
1842
1843
1844
1845
1846
1847







-
+







 *	Arbitrary, as it calls upon a Tcl script.
 *
 *----------------------------------------------------------------------
 */

static int
ReflectSetOption(
    void *clientData,	/* Channel to query */
    void *clientData,		/* Channel to query */
    Tcl_Interp *interp,		/* Interpreter to leave error messages in */
    const char *optionName,	/* Name of requested option */
    const char *newValue)	/* The new value */
{
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    Tcl_Obj *optionObj, *valueObj;
    int result;			/* Result code for 'configure' */
1816
1817
1818
1819
1820
1821
1822
1823

1824
1825
1826
1827
1828
1829
1830
1875
1876
1877
1878
1879
1880
1881

1882
1883
1884
1885
1886
1887
1888
1889







-
+








    optionObj = Tcl_NewStringObj(optionName, -1);
    valueObj = Tcl_NewStringObj(newValue, -1);

    Tcl_IncrRefCount(optionObj);
    Tcl_IncrRefCount(valueObj);

    result = InvokeTclMethod(rcPtr, METH_CONFIGURE,optionObj,valueObj, &resObj);
    result = InvokeTclMethod(rcPtr, METH_CONFIGURE, optionObj, valueObj, &resObj);
    if (result != TCL_OK) {
	UnmarshallErrorResult(interp, resObj);
    }

    Tcl_DecrRefCount(optionObj);
    Tcl_DecrRefCount(valueObj);
    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
1846
1847
1848
1849
1850
1851
1852
1853

1854
1855
1856
1857
1858
1859
1860
1905
1906
1907
1908
1909
1910
1911

1912
1913
1914
1915
1916
1917
1918
1919







-
+







 *	Arbitrary, as it calls upon a Tcl script.
 *
 *----------------------------------------------------------------------
 */

static int
ReflectGetOption(
    void *clientData,	/* Channel to query */
    void *clientData,		/* Channel to query */
    Tcl_Interp *interp,		/* Interpreter to leave error messages in */
    const char *optionName,	/* Name of reuqested option */
    Tcl_DString *dsPtr)		/* String to place the result into */
{
    /*
     * This code is special. It has regular passing of Tcl result, and errors.
     * The bypass functions are not required.
1958
1959
1960
1961
1962
1963
1964
1965

1966
1967
1968
1969
1970
1971
1972
2017
2018
2019
2020
2021
2022
2023

2024
2025
2026
2027
2028
2029
2030
2031







-
+







	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"Expected list with even number of "
		"elements, got %" TCL_SIZE_MODIFIER "d element%s instead", listc,
		(listc == 1 ? "" : "s")));
	goto error;
    } else {
	Tcl_Size len;
	const char *str = TclGetStringFromObj(resObj, &len);
	const char *str = Tcl_GetStringFromObj(resObj, &len);

	if (len) {
	    TclDStringAppendLiteral(dsPtr, " ");
	    Tcl_DStringAppend(dsPtr, str, len);
	}
	goto ok;
    }
1999
2000
2001
2002
2003
2004
2005
2006

2007
2008
2009
2010
2011
2012
2013
2058
2059
2060
2061
2062
2063
2064

2065
2066
2067
2068
2069
2070
2071
2072







-
+







 *	Arbitrary, as it calls upon a Tcl script.
 *
 *----------------------------------------------------------------------
 */

static int
ReflectTruncate(
    void *clientData,	/* Channel to query */
    void *clientData,		/* Channel to query */
    long long length)		/* Length to truncate to. */
{
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    Tcl_Obj *lenObj;
    int errorNum;		/* EINVAL or EOK (success). */
    Tcl_Obj *resObj;		/* Result for 'truncate' */

2035
2036
2037
2038
2039
2040
2041
2042

2043
2044
2045
2046
2047
2048
2049
2094
2095
2096
2097
2098
2099
2100

2101
2102
2103
2104
2105
2106
2107
2108







-
+







    /* ASSERT: rcPtr->method & FLAG(METH_TRUNCATE) */

    Tcl_Preserve(rcPtr);

    lenObj  = Tcl_NewWideIntObj(length);
    Tcl_IncrRefCount(lenObj);

    if (InvokeTclMethod(rcPtr,METH_TRUNCATE,lenObj,NULL,&resObj)!=TCL_OK) {
    if (InvokeTclMethod(rcPtr, METH_TRUNCATE, lenObj, NULL, &resObj)!=TCL_OK) {
	Tcl_SetChannelError(rcPtr->chan, resObj);
	errorNum = EINVAL;
    } else {
	errorNum = EOK;
    }

    Tcl_DecrRefCount(lenObj);
2082
2083
2084
2085
2086
2087
2088
2089

2090
2091
2092
2093
2094
2095
2096
2141
2142
2143
2144
2145
2146
2147

2148
2149
2150
2151
2152
2153
2154
2155







-
+







EncodeEventMask(
    Tcl_Interp *interp,
    const char *objName,
    Tcl_Obj *obj,
    int *mask)
{
    int events;			/* Mask of events to post */
    Tcl_Size listc;			/* #elements in eventspec list */
    Tcl_Size listc;		/* #elements in eventspec list */
    Tcl_Obj **listv;		/* Elements of eventspec list */
    int evIndex;		/* Id of event for an element of the eventspec
				 * list. */

    if (TclListObjGetElements(interp, obj, &listc, &listv) != TCL_OK) {
	return TCL_ERROR;
    }
2192
2193
2194
2195
2196
2197
2198


2199
2200
2201
2202
2203
2204

2205



2206
2207
2208
2209
2210
2211
2212
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







+
+






+
-
+
+
+







    rcPtr = (ReflectedChannel *)Tcl_Alloc(sizeof(ReflectedChannel));

    /* rcPtr->chan: Assigned by caller. Dummy data here. */

    rcPtr->chan = NULL;
    rcPtr->interp = interp;
    rcPtr->dead = 0;
    rcPtr->readTimer = 0;
    rcPtr->writeTimer = 0;
#if TCL_THREADS
    rcPtr->thread = Tcl_GetCurrentThread();
#endif
    rcPtr->mode = mode;
    rcPtr->interest = 0;		/* Initially no interest registered */

    rcPtr->cmd = TclDuplicatePureObj(interp, cmdpfxObj, tclListTypePtr);
    rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
    if (!rcPtr->cmd) {
	return NULL;
    }
    Tcl_IncrRefCount(rcPtr->cmd);
    rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL);
    while (mn <= (int)METH_WRITE) {
	Tcl_ListObjAppendElement(NULL, rcPtr->methods,
		Tcl_NewStringObj(methodNames[mn++], -1));
    }
    Tcl_IncrRefCount(rcPtr->methods);
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
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







-
+

















-
+
+
+
+







    if (rcPtr->dead) {
	/*
	 * The channel is marked as dead. Bail out immediately, with an
	 * appropriate error.
	 */

	if (resultObjPtr != NULL) {
	    resObj = Tcl_NewStringObj(msg_dstlost,-1);
	    resObj = Tcl_NewStringObj(msg_dstlost, -1);
	    *resultObjPtr = resObj;
	    Tcl_IncrRefCount(resObj);
	}

	/*
	 * Not touching argOneObj, argTwoObj, they have not been used.
	 * See the contract as well.
	 */

	return TCL_ERROR;
    }

    /*
     * Insert method into the callback command, after the command prefix,
     * before the channel id.
     */

    cmd = TclListObjCopy(NULL, rcPtr->cmd);
    cmd = TclDuplicatePureObj(NULL, rcPtr->cmd, tclListTypePtr);
    if (!cmd) {
	return TCL_ERROR;
    }
    Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj);
    Tcl_ListObjAppendElement(NULL, cmd, methObj);
    Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name);

    /*
     * Append the additional argument containing method specific details
     * behind the channel id. If specified.
2405
2406
2407
2408
2409
2410
2411
2412

2413
2414
2415
2416
2417
2418
2419
2472
2473
2474
2475
2476
2477
2478

2479
2480
2481
2482
2483
2484
2485
2486







-
+







	     *
	     * This is complex and ugly, and would be completely unnecessary
	     * if we only added support for a TCL_FORBID_EXCEPTIONS flag.
	     */

	    if (result != TCL_ERROR) {
		Tcl_Size cmdLen;
		const char *cmdString = TclGetStringFromObj(cmd, &cmdLen);
		const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);

		Tcl_IncrRefCount(cmd);
		Tcl_ResetResult(rcPtr->interp);
		Tcl_SetObjResult(rcPtr->interp, Tcl_ObjPrintf(
			"chan handler returned bad code: %d", result));
		Tcl_LogCommandInfo(rcPtr->interp, cmdString, cmdString,
			cmdLen);
2559
2560
2561
2562
2563
2564
2565
2566

2567
2568
2569
2570
2571
2572


2573
2574
2575
2576
2577
2578
2579
2626
2627
2628
2629
2630
2631
2632

2633
2634
2635
2636
2637


2638
2639
2640
2641
2642
2643
2644
2645
2646







-
+




-
-
+
+







    }
    CleanRefChannelInstance(rcPtr);
    rcPtr->dead = 1;
}

static void
DeleteReflectedChannelMap(
    void *clientData,	/* The per-interpreter data structure. */
    void *clientData,		/* The per-interpreter data structure. */
    Tcl_Interp *interp)		/* The interpreter being deleted. */
{
    ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)clientData;
				/* The map */
    Tcl_HashSearch hSearch;	 /* Search variable. */
    Tcl_HashEntry *hPtr;	 /* Search variable. */
    Tcl_HashSearch hSearch;	/* Search variable. */
    Tcl_HashEntry *hPtr;	/* Search variable. */
    ReflectedChannel *rcPtr;
    Tcl_Channel chan;
#if TCL_THREADS
    ForwardingResult *resultPtr;
    ForwardingEvent *evPtr;
    ForwardParam *paramPtr;
#endif
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
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







-
+















-
+







		snprintf(buf, 200,
			"{Expected list with even number of elements, got %" TCL_SIZE_MODIFIER "d %s instead}",
			listc, (listc == 1 ? "element" : "elements"));

		ForwardSetDynamicError(paramPtr, buf);
	    } else {
		Tcl_Size len;
		const char *str = TclGetStringFromObj(resObj, &len);
		const char *str = Tcl_GetStringFromObj(resObj, &len);

		if (len) {
		    TclDStringAppendLiteral(paramPtr->getOpt.value, " ");
		    Tcl_DStringAppend(paramPtr->getOpt.value, str, len);
		}
	    }
	}
	Tcl_Release(rcPtr);
	break;

    case ForwardedTruncate: {
	Tcl_Obj *lenObj = Tcl_NewWideIntObj(paramPtr->truncate.length);

	Tcl_IncrRefCount(lenObj);
	Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr,METH_TRUNCATE,lenObj,NULL,&resObj)!=TCL_OK) {
	if (InvokeTclMethod(rcPtr, METH_TRUNCATE, lenObj, NULL, &resObj)!=TCL_OK) {
	    ForwardSetObjError(paramPtr, resObj);
	}
	Tcl_Release(rcPtr);
	Tcl_DecrRefCount(lenObj);
	break;
    }

3381
3382
3383
3384
3385
3386
3387
3388

3389
3390
3391
3392
3393
3394
3395
3448
3449
3450
3451
3452
3453
3454

3455
3456
3457
3458
3459
3460
3461
3462







-
+








static void
ForwardSetObjError(
    ForwardParam *paramPtr,
    Tcl_Obj *obj)
{
    Tcl_Size len;
    const char *msgStr = TclGetStringFromObj(obj, &len);
    const char *msgStr = Tcl_GetStringFromObj(obj, &len);

    len++;
    ForwardSetDynamicError(paramPtr, Tcl_Alloc(len));
    memcpy(paramPtr->base.msgStr, msgStr, len);
}
#endif

Changes to generic/tclIORTrans.c.
















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+











-
-
-
-
-







/*
 * Copyright © 2007-2008 ActiveState.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclIORTrans.c --
 *
 *	This file contains the implementation of Tcl's generic transformation
 *	reflection code, which allows the implementation of Tcl channel
 *	transformations in Tcl code.
 *
 *	Parts of this file are based on code contributed by Jean-Claude
 *	Wippler.
 *
 *	See TIP #230 for the specification of this functionality.
 *
 * Copyright © 2007-2008 ActiveState.
 *
 * 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 "tclIO.h"
#include <assert.h>

#ifndef EINVAL
205
206
207
208
209
210
211
212
213
214



215
216
217
218
219
220
221
216
217
218
219
220
221
222



223
224
225
226
227
228
229
230
231
232







-
-
-
+
+
+








#define FLAG(m) (1 << (m))
#define REQUIRED_METHODS \
	(FLAG(METH_INIT) | FLAG(METH_FINAL))
#define RANDW \
	(TCL_READABLE | TCL_WRITABLE)

#define IMPLIES(a,b)	((!(a)) || (b))
#define NEGIMPL(a,b)
#define HAS(x,f)	((x) & FLAG(f))
#define IMPLIES(a, b)	((!(a)) || (b))
#define NEGIMPL(a, b)
#define HAS(x, f)	((x) & FLAG(f))

#if TCL_THREADS
/*
 * Thread specific types and structures.
 *
 * We are here essentially creating a very specific implementation of 'thread
 * send'.
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
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







-
+

-
-
+
+


-
+

-
-
-
+
+
+

-
+

-
+

-
-
-
+
+
+

-
+

-
-
-
+
+
+

-
+

-
-
-
+
+
+









-
-
+
+







 */

static void		ForwardOpToOwnerThread(ReflectedTransform *rtPtr,
			    ForwardedOperation op, const void *param);
static int		ForwardProc(Tcl_Event *evPtr, int mask);
static void		SrcExitProc(void *clientData);

#define FreeReceivedError(p) \
#define FreeReceivedError(fwdParam) \
	do {								\
	    if ((p)->base.mustFree) {					\
		Tcl_Free((p)->base.msgStr);				\
	    if ((fwdParam)->base.mustFree) {				\
		Tcl_Free((fwdParam)->base.msgStr);			\
	    }								\
	} while (0)
#define PassReceivedErrorInterp(i,p) \
#define PassReceivedErrorInterp(interp, fwdParam) \
	do {								\
	    if ((i) != NULL) {						\
		Tcl_SetChannelErrorInterp((i),				\
			Tcl_NewStringObj((p)->base.msgStr, -1));	\
	    if ((interp) != NULL) {					\
		Tcl_SetChannelErrorInterp((interp),			\
			Tcl_NewStringObj((fwdParam)->base.msgStr, -1));	\
	    }								\
	    FreeReceivedError(p);					\
	    FreeReceivedError(fwdParam);				\
	} while (0)
#define PassReceivedError(c,p) \
#define PassReceivedError(chan, fwdParam) \
	do {								\
	    Tcl_SetChannelError((c),					\
		    Tcl_NewStringObj((p)->base.msgStr, -1));		\
	    FreeReceivedError(p);					\
	    Tcl_SetChannelError((chan),					\
		    Tcl_NewStringObj((fwdParam)->base.msgStr, -1));	\
	    FreeReceivedError(fwdParam);				\
	} while (0)
#define ForwardSetStaticError(p,emsg) \
#define ForwardSetStaticError(fwdParam, emsg) \
	do {								\
	    (p)->base.code = TCL_ERROR;					\
	    (p)->base.mustFree = 0;					\
	    (p)->base.msgStr = (char *) (emsg);				\
	    (fwdParam)->base.code = TCL_ERROR;				\
	    (fwdParam)->base.mustFree = 0;				\
	    (fwdParam)->base.msgStr = (char *) (emsg);			\
	} while (0)
#define ForwardSetDynamicError(p,emsg) \
#define ForwardSetDynamicError(fwdParam, emsg) \
	do {								\
	    (p)->base.code = TCL_ERROR;					\
	    (p)->base.mustFree = 1;					\
	    (p)->base.msgStr = (char *) (emsg);				\
	    (fwdParam)->base.code = TCL_ERROR;				\
	    (fwdParam)->base.mustFree = 1;				\
	    (fwdParam)->base.msgStr = (char *) (emsg);			\
	} while (0)

static void		ForwardSetObjError(ForwardParam *p,
			    Tcl_Obj *objPtr);
static ReflectedTransformMap *	GetThreadReflectedTransformMap(void);
static void		DeleteThreadReflectedTransformMap(
			    void *clientData);
#endif /* TCL_THREADS */

#define SetChannelErrorStr(c,msgStr) \
	Tcl_SetChannelError((c), Tcl_NewStringObj((msgStr), -1))
#define SetChannelErrorStr(chan, msgStr) \
	Tcl_SetChannelError((chan), Tcl_NewStringObj((msgStr), -1))

static Tcl_Obj *	MarshallError(Tcl_Interp *interp);
static void		UnmarshallErrorResult(Tcl_Interp *interp,
			    Tcl_Obj *msgObj);

/*
 * Static functions for this file:
1919
1920
1921
1922
1923
1924
1925
1926

1927
1928
1929
1930
1931
1932
1933
1930
1931
1932
1933
1934
1935
1936

1937
1938
1939
1940
1941
1942
1943
1944







-
+







    if (rtPtr->dead) {
	/*
	 * The transform is marked as dead. Bail out immediately, with an
	 * appropriate error.
	 */

	if (resultObjPtr != NULL) {
	    resObj = Tcl_NewStringObj(msg_dstlost,-1);
	    resObj = Tcl_NewStringObj(msg_dstlost, -1);
	    *resultObjPtr = resObj;
	    Tcl_IncrRefCount(resObj);
	}
	return TCL_ERROR;
    }

    /*
1995
1996
1997
1998
1999
2000
2001
2002

2003
2004
2005
2006
2007
2008
2009
2006
2007
2008
2009
2010
2011
2012

2013
2014
2015
2016
2017
2018
2019
2020







-
+







	     *
	     * This is complex and ugly, and would be completely unnecessary
	     * if we only added support for a TCL_FORBID_EXCEPTIONS flag.
	     */
	    if (result != TCL_ERROR) {
		Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rtPtr->argv);
		Tcl_Size cmdLen;
		const char *cmdString = TclGetStringFromObj(cmd, &cmdLen);
		const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);

		Tcl_IncrRefCount(cmd);
		Tcl_ResetResult(rtPtr->interp);
		Tcl_SetObjResult(rtPtr->interp, Tcl_ObjPrintf(
			"chan handler returned bad code: %d", result));
		Tcl_LogCommandInfo(rtPtr->interp, cmdString, cmdString, cmdLen);
		Tcl_DecrRefCount(cmd);
2763
2764
2765
2766
2767
2768
2769
2770

2771
2772
2773
2774
2775
2776
2777
2774
2775
2776
2777
2778
2779
2780

2781
2782
2783
2784
2785
2786
2787
2788







-
+








static void
ForwardSetObjError(
    ForwardParam *paramPtr,
    Tcl_Obj *obj)
{
    Tcl_Size len;
    const char *msgStr = TclGetStringFromObj(obj, &len);
    const char *msgStr = Tcl_GetStringFromObj(obj, &len);

    len++;
    ForwardSetDynamicError(paramPtr, Tcl_Alloc(len));
    memcpy(paramPtr->base.msgStr, msgStr, len);
}
#endif /* TCL_THREADS */

Changes to generic/tclIOSock.c.
1
2
3
4
5
6
7
8
9
10
11















12
13
14
15
16
17
18
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

-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclIOSock.c --
 *
 *	Common routines used by all socket based channel types.
 *
 * Copyright © 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclIOSock.c --
 *
 *	Common routines used by all socket based channel types.
 */

#include "tclInt.h"

#if defined(_WIN32)
/*
 * On Windows, we need to do proper Unicode->UTF-8 conversion.
 */

187
188
189
190
191
192
193
194

195
196
197
198
199
200
201
198
199
200
201
202
203
204

205
206
207
208
209
210
211
212







-
+







    const char *family = NULL;
    Tcl_DString ds;
    int result;

    if (host != NULL) {
	if (Tcl_UtfToExternalDStringEx(interp, NULL, host, -1, 0, &ds,
		NULL) != TCL_OK) {
		Tcl_DStringFree(&ds);
	    Tcl_DStringFree(&ds);
	    return 0;
	}
	native = Tcl_DStringValue(&ds);
    }

    /*
     * Workaround for OSX's apparent inability to resolve "localhost", "0"
Changes to generic/tclIOUtil.c.


















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








-
-
-
-
-
-
-







/*
 * Copyright © 1991-1994 The Regents of the University of California.
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 * Copyright © 2001-2004 Vincent Darley.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclIOUtil.c --
 *
 *	Provides an interface for managing filesystems in Tcl, and also for
 *	creating a filesystem interface in Tcl arbitrary facilities.  All
 *	filesystem operations are performed via this interface.  Vince Darley
 *	is the primary author.  Other signifiant contributors are Karl
 *	Lehenbauer, Mark Diekhans and Peter da Silva.
 *
 * Copyright © 1991-1994 The Regents of the University of California.
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 * Copyright © 2001-2004 Vincent Darley.
 *
 * 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 "tclIO.h"
#ifdef _WIN32
#   include "tclWinInt.h"
#endif
241
242
243
244
245
246
247
248

249
250
251
252
253
254
255
252
253
254
255
256
257
258

259
260
261
262
263
264
265
266







-
+







Tcl_Stat(
    const char *path,		/* Pathname of file to stat (in current system
				 * encoding). */
    struct stat *oldStyleBuf)	/* Filled with results of stat call. */
{
    int ret;
    Tcl_StatBuf buf;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
    Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1);

    Tcl_IncrRefCount(pathPtr);
    ret = Tcl_FSStat(pathPtr, &buf);
    Tcl_DecrRefCount(pathPtr);
    if (ret != -1) {
#ifndef TCL_WIDE_INT_IS_LONG
	Tcl_WideInt tmp1, tmp2, tmp3 = 0;
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
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







-
+


-
+
















-
+














-
+







int
Tcl_Access(
    const char *path,		/* Pathname of file to access (in current
				 * system encoding). */
    int mode)			/* Permission setting. */
{
    int ret;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
    Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1);

    Tcl_IncrRefCount(pathPtr);
    ret = Tcl_FSAccess(pathPtr,mode);
    ret = Tcl_FSAccess(pathPtr, mode);
    Tcl_DecrRefCount(pathPtr);

    return ret;
}

/* Obsolete */
Tcl_Channel
Tcl_OpenFileChannel(
    Tcl_Interp *interp,		/* Interpreter for error reporting. May be
				 * NULL. */
    const char *path,		/* Pathname of file to open. */
    const char *modeString,	/* A list of POSIX open modes or a string such
				 * as "rw". */
    int permissions)		/* The modes to use if creating a new file. */
{
    Tcl_Channel ret;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
    Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1);

    Tcl_IncrRefCount(pathPtr);
    ret = Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions);
    Tcl_DecrRefCount(pathPtr);

    return ret;
}

/* Obsolete */
int
Tcl_Chdir(
    const char *dirName)
{
    int ret;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(dirName,-1);
    Tcl_Obj *pathPtr = Tcl_NewStringObj(dirName, -1);
    Tcl_IncrRefCount(pathPtr);
    ret = Tcl_FSChdir(pathPtr);
    Tcl_DecrRefCount(pathPtr);
    return ret;
}

/* Obsolete */
395
396
397
398
399
400
401
402

403
404
405
406
407
408
409
406
407
408
409
410
411
412

413
414
415
416
417
418
419
420







-
+







Tcl_EvalFile(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the script. */
    const char *fileName)	/* Pathname of the file containing the script.
				 * Performs Tilde-substitution on this
				 * pathaname. */
{
    int ret;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);
    Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName, -1);

    Tcl_IncrRefCount(pathPtr);
    ret = Tcl_FSEvalFile(interp, pathPtr);
    Tcl_DecrRefCount(pathPtr);
    return ret;
}

519
520
521
522
523
524
525
526
527


528
529
530
531
532
533
534
530
531
532
533
534
535
536


537
538
539
540
541
542
543
544
545







-
-
+
+








    if (tsdPtr->cwdPathPtr == *pathPtrPtr) {
	return 1;
    } else {
	Tcl_Size len1, len2;
	const char *str1, *str2;

	str1 = TclGetStringFromObj(tsdPtr->cwdPathPtr, &len1);
	str2 = TclGetStringFromObj(*pathPtrPtr, &len2);
	str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
	str2 = Tcl_GetStringFromObj(*pathPtrPtr, &len2);
	if ((len1 == len2) && !memcmp(str1, str2, len1)) {
	    /*
	     * The values are equal but the objects are different.  Cache the
	     * current structure in place of the old one.
	     */

	    Tcl_DecrRefCount(*pathPtrPtr);
663
664
665
666
667
668
669
670

671
672
673
674
675
676
677
674
675
676
677
678
679
680

681
682
683
684
685
686
687
688







-
+







    void *clientData)
{
    Tcl_Size len = 0;
    const char *str = NULL;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);

    if (cwdObj != NULL) {
	str = TclGetStringFromObj(cwdObj, &len);
	str = Tcl_GetStringFromObj(cwdObj, &len);
    }

    Tcl_MutexLock(&cwdMutex);
    if (cwdPathPtr != NULL) {
	Tcl_DecrRefCount(cwdPathPtr);
    }
    if (cwdClientData != NULL) {
1153
1154
1155
1156
1157
1158
1159
1160
1161


1162
1163
1164
1165
1166
1167
1168
1164
1165
1166
1167
1168
1169
1170


1171
1172
1173
1174
1175
1176
1177
1178
1179







-
-
+
+







	     * i.e. the representation relative to pathPtr.
	     */

	    norm = Tcl_FSGetNormalizedPath(NULL, pathPtr);
	    if (norm != NULL) {
		const char *path, *mount;

		mount = TclGetStringFromObj(mElt, &mlen);
		path = TclGetStringFromObj(norm, &len);
		mount = Tcl_GetStringFromObj(mElt, &mlen);
		path = Tcl_GetStringFromObj(norm, &len);
		if (path[len-1] == '/') {
		    /*
		     * Deal with the root of the volume.
		     */

		    len--;
		}
1331
1332
1333
1334
1335
1336
1337
1338

1339
1340
1341
1342
1343
1344
1345
1342
1343
1344
1345
1346
1347
1348

1349
1350
1351
1352
1353
1354
1355
1356







-
+







     * are reserved for VFS use.  These names can not conflict with real UNC
     * pathnames per https://msdn.microsoft.com/en-us/library/gg465305.aspx and
     * rfc3986's definition of reg-name.
     *
     * We check these first to avoid useless calls to the native filesystem's
     * normalizePathProc.
     */
    path = TclGetStringFromObj(pathPtr, &i);
    path = Tcl_GetStringFromObj(pathPtr, &i);

    if ((i >= 3) && ((path[0] == '/' && path[1] == '/')
	    || (path[0] == '\\' && path[1] == '\\'))) {
	for (i = 2; ; i++) {
	    if (path[i] == '\0') {
		break;
	    }
1564
1565
1566
1567
1568
1569
1570
1571
1572


1573
1574
1575
1576
1577
1578
1579
1580

1581
1582
1583
1584
1585
1586
1587
1575
1576
1577
1578
1579
1580
1581


1582
1583
1584
1585
1586
1587
1588
1589
1590

1591
1592
1593
1594
1595
1596
1597
1598







-
-
+
+







-
+







	    }
	    mode = (mode & ~O_ACCMODE) | O_RDWR;
	    gotRW = 1;
	} else if ((c == 'A') && (strcmp(flag, "APPEND") == 0)) {
	    if (mode & O_APPEND) {
	    accessFlagRepeated:
		if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"access mode \"%s\" repeated", flag));
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "access mode \"%s\" repeated", flag));
		}
	    goto invAccessMode;
	    }
	    mode |= O_APPEND;
	    *modeFlagsPtr |= 1;
	} else if ((c == 'C') && (strcmp(flag, "CREAT") == 0)) {
	    if (mode & O_CREAT) {
	    goto accessFlagRepeated;
		goto accessFlagRepeated;
	    }
	    mode |= O_CREAT;
	} else if ((c == 'E') && (strcmp(flag, "EXCL") == 0)) {
	    if (mode & O_EXCL) {
		goto accessFlagRepeated;
	    }
	    mode |= O_EXCL;
1731
1732
1733
1734
1735
1736
1737





1738
1739
1740
1741
1742
1743
1744
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760







+
+
+
+
+







     */

    if (encodingName == NULL) {
	encodingName = "utf-8";
    }
    if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName)
	    != TCL_OK) {
	Tcl_CloseEx(interp, chan, 0);
	return result;
    }
    if (Tcl_SetChannelOption(interp, chan, "-profile", "strict")
	    != TCL_OK) {
	Tcl_CloseEx(interp,chan,0);
	return result;
    }

    TclNewObj(objPtr);
    Tcl_IncrRefCount(objPtr);

1773
1774
1775
1776
1777
1778
1779
1780

1781
1782
1783
1784
1785
1786
1787
1789
1790
1791
1792
1793
1794
1795

1796
1797
1798
1799
1800
1801
1802
1803







-
+







	goto end;
    }

    iPtr = (Interp *) interp;
    oldScriptFile = iPtr->scriptFile;
    iPtr->scriptFile = pathPtr;
    Tcl_IncrRefCount(iPtr->scriptFile);
    string = TclGetStringFromObj(objPtr, &length);
    string = Tcl_GetStringFromObj(objPtr, &length);

    /*
     * TIP #280:  Open a frame for the evaluated script.
     */

    iPtr->evalFlags |= TCL_EVAL_FILE;
    result = TclEvalEx(interp, string, length, 0, 1, NULL, string);
1800
1801
1802
1803
1804
1805
1806
1807

1808
1809
1810
1811
1812
1813
1814
1816
1817
1818
1819
1820
1821
1822

1823
1824
1825
1826
1827
1828
1829
1830







-
+







    if (result == TCL_RETURN) {
	result = TclUpdateReturnInfo(iPtr);
    } else if (result == TCL_ERROR) {
	/*
	 * Record information about where the error occurred.
	 */

	const char *pathString = TclGetStringFromObj(pathPtr, &length);
	const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
	int limit = 150;
	int overflow = (length > limit);

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (file \"%.*s%s\" line %d)",
		(overflow ? limit : (int)length), pathString,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
1953
1954
1955
1956
1957
1958
1959
1960

1961
1962
1963
1964
1965
1966
1967
1969
1970
1971
1972
1973
1974
1975

1976
1977
1978
1979
1980
1981
1982
1983







-
+







	result = TclUpdateReturnInfo(iPtr);
    } else if (result == TCL_ERROR) {
	/*
	 * Record information about where the error occurred.
	 */

	Tcl_Size length;
	const char *pathString = TclGetStringFromObj(pathPtr, &length);
	const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
	const int limit = 150;
	int overflow = (length > limit);

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (file \"%.*s%s\" line %d)",
		(overflow ? limit : (int)length), pathString,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
2002
2003
2004
2005
2006
2007
2008
2009

2010
2011
2012
2013
2014
2015
2016
2018
2019
2020
2021
2022
2023
2024

2025
2026
2027
2028
2029
2030
2031
2032







-
+








/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetErrno --
 *
 *	Sets the Tcl error code to the given value. On some saner platforms
 *	this is implemented in the C library as a thread-local value , but this
 *	this is implemented in the C library as a thread-local value, but this
 *	is *really* unsafe to assume!
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Modifies the the Tcl error code value.
2354
2355
2356
2357
2358
2359
2360
2361

2362
2363
2364
2365
2366
2367
2368
2370
2371
2372
2373
2374
2375
2376

2377
2378
2379
2380
2381
2382
2383
2384







-
+







static int
NativeFileAttrsGet(
    Tcl_Interp *interp,		/* The interpreter for error reporting. */
    int index,			/* index of the attribute command. */
    Tcl_Obj *pathPtr,		/* Pathname of the file */
    Tcl_Obj **objPtrRef)	/* Where to store the a pointer to the result. */
{
    return tclpFileAttrProcs[index].getProc(interp, index, pathPtr,objPtrRef);
    return tclpFileAttrProcs[index].getProc(interp, index, pathPtr, objPtrRef);
}

/*
 *----------------------------------------------------------------------
 *
 * NativeFileAttrsSet --
 *
2649
2650
2651
2652
2653
2654
2655
2656

2657
2658
2659
2660
2661
2662
2663
2665
2666
2667
2668
2669
2670
2671

2672
2673
2674
2675
2676
2677
2678
2679







-
+








		/*
		 * Found the pathname of the current directory.
		 */

		retVal = fsRecPtr->fsPtr->internalToNormalizedProc(retCd);
		Tcl_IncrRefCount(retVal);
		norm = TclFSNormalizeAbsolutePath(interp,retVal);
		norm = TclFSNormalizeAbsolutePath(interp, retVal);
		if (norm != NULL) {
		    /*
		     * Assign to global storage the pathname of the current
		     * directory and copy it into thread-local storage as
		     * well.
		     *
		     * At system startup multiple threads could in principle
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
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







-
+










-
+










-
-
+
+







	    FsUpdateCwd(NULL, NULL);
	    goto cdDidNotChange;
	}

	norm = TclFSNormalizeAbsolutePath(interp, retVal);

	if (norm == NULL) {
	     /*
	    /*
	     * 'norm' shouldn't ever be NULL, but we are careful.
	     */

	    /* Do nothing */
	    if (retCd != NULL) {
		fsPtr->freeInternalRepProc(retCd);
	    }
	} else if (norm == tsdPtr->cwdPathPtr) {
	    goto cdEqual;
	} else {
	     /*
	    /*
	     * Determine whether the filesystem's answer is the same as the
	     * cached local value.  Since both 'norm' and 'tsdPtr->cwdPathPtr'
	     * are normalized pathnames, do something more efficient than
	     * calling 'Tcl_FSEqualPaths', and in addition avoid a nasty
	     * infinite loop bug when trying to normalize tsdPtr->cwdPathPtr.
	     */

	    Tcl_Size len1, len2;
	    const char *str1, *str2;

	    str1 = TclGetStringFromObj(tsdPtr->cwdPathPtr, &len1);
	    str2 = TclGetStringFromObj(norm, &len2);
	    str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
	    str2 = Tcl_GetStringFromObj(norm, &len2);
	    if ((len1 == len2) && (strcmp(str1, str2) == 0)) {
		/*
		 * The pathname values are equal so retain the old pathname
		 * object which is probably already shared and free the
		 * normalized pathname that was just produced.
		 */
	    cdEqual:
3903
3904
3905
3906
3907
3908
3909
3910

3911
3912
3913
3914
3915
3916
3917
3919
3920
3921
3922
3923
3924
3925

3926
3927
3928
3929
3930
3931
3932
3933







-
+







				 * length of the volume name. */
    Tcl_Obj **driveNameRef)	/* If not NULL, for an absolute pathname, a
				 * place to store a pointer to an object with a
				 * refCount of 1, and whose value is the name
				 * of the volume. */
{
    Tcl_Size pathLen;
    const char *path = TclGetStringFromObj(pathPtr, &pathLen);
    const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
    Tcl_PathType type;

    type = TclFSNonnativePathType(path, pathLen, filesystemPtrPtr,
	    driveNameLengthPtr, driveNameRef);

    if (type != TCL_PATH_ABSOLUTE) {
	type = TclpGetNativePathType(pathPtr, driveNameLengthPtr,
4010
4011
4012
4013
4014
4015
4016
4017

4018
4019
4020
4021
4022
4023
4024
4026
4027
4028
4029
4030
4031
4032

4033
4034
4035
4036
4037
4038
4039
4040







-
+







		while (numVolumes > 0) {
		    Tcl_Obj *vol;
		    Tcl_Size len;
		    const char *strVol;

		    numVolumes--;
		    Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol);
		    strVol = TclGetStringFromObj(vol,&len);
		    strVol = Tcl_GetStringFromObj(vol ,&len);
		    if (pathLen < len) {
			continue;
		    }
		    if (strncmp(strVol, path, len) == 0) {
			type = TCL_PATH_ABSOLUTE;
			if (filesystemPtrPtr != NULL) {
			    *filesystemPtrPtr = fsRecPtr->fsPtr;
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







-
-
+
+







	Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL);
	if (cwdPtr != NULL) {
	    const char *cwdStr, *normPathStr;
	    Tcl_Size cwdLen, normLen;
	    Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);

	    if (normPath != NULL) {
		normPathStr = TclGetStringFromObj(normPath, &normLen);
		cwdStr = TclGetStringFromObj(cwdPtr, &cwdLen);
		normPathStr = Tcl_GetStringFromObj(normPath, &normLen);
		cwdStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
		if ((cwdLen >= normLen) && (strncmp(normPathStr, cwdStr,
			normLen) == 0)) {
		    /*
		     * The cwd is inside the directory to be removed.  Change
		     * the cwd to [file dirname $path].
		     */

4632
4633
4634
4635
4636
4637
4638
4639

4640
4641
4642
4643
4644
4645
4646
4647
4648
4648
4649
4650
4651
4652
4653
4654

4655
4656
4657
4658
4659
4660
4661
4662
4663
4664







-
+









    case TCL_PLATFORM_UNIX:
	separator = "/";
	break;
    case TCL_PLATFORM_WINDOWS:
	separator = "\\";
	break;
    }
    return Tcl_NewStringObj(separator,1);
    return Tcl_NewStringObj(separator, 1);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclIndexObj.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

















16
17
18
19
20
21
22
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

-
-
-
-
-
-








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclIndexObj.c --
 *
 *	This file implements objects of type "index". This object type is used
 *	to lookup a keyword in a table of valid values and cache the index of
 *	the matching entry. Also provides table-based argv/argc processing.
 *
 * Copyright © 1990-1994 The Regents of the University of California.
 * Copyright © 1997 Sun Microsystems, Inc.
 * Copyright © 2006 Sam Bromley.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclIndexObj.c --
 *
 *	This file implements objects of type "index". This object type is used
 *	to lookup a keyword in a table of valid values and cache the index of
 *	the matching entry. Also provides table-based argv/argc processing.
 */

#include "tclInt.h"

/*
 * Prototypes for functions defined later in this file:
 */

static int		GetIndexFromObjList(Tcl_Interp *interp,
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
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







-
+












-
+








const Tcl_ObjType tclIndexType = {
    "index",			/* name */
    FreeIndex,			/* freeIntRepProc */
    DupIndex,			/* dupIntRepProc */
    UpdateStringOfIndex,	/* updateStringProc */
    NULL,			/* setFromAnyProc */
    TCL_OBJTYPE_V0
	0
};

/*
 * The definition of the internal representation of the "index" object; The
 * internalRep.twoPtrValue.ptr1 field of an object of "index" type will be a
 * pointer to one of these structures.
 *
 * Keep this structure declaration in sync with tclTestObj.c
 */

typedef struct {
    void *tablePtr;		/* Pointer to the table of strings */
    Tcl_Size offset;	/* Offset between table entries */
    Tcl_Size offset;		/* Offset between table entries */
    Tcl_Size index;		/* Selected index into table. */
} IndexRep;

/*
 * The following macros greatly simplify moving through a table...
 */

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
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







-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+







  done:
    /*
     * Cache the found representation. Note that we want to avoid allocating a
     * new internal-rep if at all possible since that is potentially a slow
     * operation.
     */

    if (objPtr && (index != TCL_INDEX_NONE) && !(flags & TCL_INDEX_TEMP_TABLE)) {
    irPtr = TclFetchInternalRep(objPtr, &tclIndexType);
    if (irPtr) {
	indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
    } else {
	Tcl_ObjInternalRep ir;
    if (objPtr && (index != TCL_INDEX_NONE)
	&& !(flags & TCL_INDEX_TEMP_TABLE)) {
	irPtr = TclFetchInternalRep(objPtr, &tclIndexType);
	if (irPtr) {
	    indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
	} else {
	    Tcl_ObjInternalRep ir;

	indexRep = (IndexRep*)Tcl_Alloc(sizeof(IndexRep));
	ir.twoPtrValue.ptr1 = indexRep;
	Tcl_StoreInternalRep(objPtr, &tclIndexType, &ir);
    }
    indexRep->tablePtr = (void *) tablePtr;
    indexRep->offset = offset;
    indexRep->index = index;
	    indexRep = (IndexRep*)Tcl_Alloc(sizeof(IndexRep));
	    ir.twoPtrValue.ptr1 = indexRep;
	    Tcl_StoreInternalRep(objPtr, &tclIndexType, &ir);
	}
	indexRep->tablePtr = (void *) tablePtr;
	indexRep->offset = offset;
	indexRep->index = index;
    }

  uncachedDone:
    if (indexPtr != NULL) {
	flags &= (30-(int)(sizeof(int)<<1));
	if (flags) {
	    if (flags == sizeof(uint16_t)<<1) {
643
644
645
646
647
648
649
650

651
652
653

654
655
656
657
658
659
660
655
656
657
658
659
660
661

662
663
664

665
666
667
668
669
670
671
672







-
+


-
+







    }

    result = TclListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
    if (result != TCL_OK) {
	return result;
    }
    resultPtr = Tcl_NewListObj(0, NULL);
    string = TclGetStringFromObj(objv[2], &length);
    string = Tcl_GetStringFromObj(objv[2], &length);

    for (t = 0; t < tableObjc; t++) {
	elemString = TclGetStringFromObj(tableObjv[t], &elemLength);
	elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength);

	/*
	 * A prefix cannot match if it is longest.
	 */

	if (length <= elemLength) {
	    if (TclpUtfNcmp2(elemString, string, length) == 0) {
700
701
702
703
704
705
706
707

708
709
710
711
712
713

714
715
716
717
718
719
720
712
713
714
715
716
717
718

719
720
721
722
723
724

725
726
727
728
729
730
731
732







-
+





-
+







	return TCL_ERROR;
    }

    result = TclListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
    if (result != TCL_OK) {
	return result;
    }
    string = TclGetStringFromObj(objv[2], &length);
    string = Tcl_GetStringFromObj(objv[2], &length);

    resultString = NULL;
    resultLength = 0;

    for (t = 0; t < tableObjc; t++) {
	elemString = TclGetStringFromObj(tableObjv[t], &elemLength);
	elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength);

	/*
	 * First check if the prefix string matches the element. A prefix
	 * cannot match if it is longest.
	 */

	if ((length > elemLength) ||
802
803
804
805
806
807
808
809

810
811
812
813
814
815
816
814
815
816
817
818
819
820

821
822
823
824
825
826
827
828







-
+







 *
 *----------------------------------------------------------------------
 */

void
Tcl_WrongNumArgs(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Size objc,			/* Number of arguments to print from objv. */
    Tcl_Size objc,		/* Number of arguments to print from objv. */
    Tcl_Obj *const objv[],	/* Initial argument objects, which should be
				 * included in the error message. */
    const char *message)	/* Error message to print after the leading
				 * objects in objv. The message may be
				 * NULL. */
{
    Tcl_Obj *objPtr;
868
869
870
871
872
873
874
875

876
877
878
879
880
881
882
880
881
882
883
884
885
886

887
888
889
890
891
892
893
894







-
+








	    if ((irPtr = TclFetchInternalRep(origObjv[i], &tclIndexType))) {
		IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;

		elementStr = EXPAND_OF(indexRep);
		elemLen = strlen(elementStr);
	    } else {
		elementStr = TclGetStringFromObj(origObjv[i], &elemLen);
		elementStr = Tcl_GetStringFromObj(origObjv[i], &elemLen);
	    }
	    flags = 0;
	    len = TclScanElement(elementStr, elemLen, &flags);

	    if (len != elemLen) {
		char *quotedElementStr = (char *)TclStackAlloc(interp, len + 1);

918
919
920
921
922
923
924
925

926
927
928
929
930
931
932
930
931
932
933
934
935
936

937
938
939
940
941
942
943
944







-
+








	    Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), (char *)NULL);
	} else {
	    /*
	     * Quote the argument if it contains spaces (Bug 942757).
	     */

	    elementStr = TclGetStringFromObj(objv[i], &elemLen);
	    elementStr = Tcl_GetStringFromObj(objv[i], &elemLen);
	    flags = 0;
	    len = TclScanElement(elementStr, elemLen, &flags);

	    if (len != elemLen) {
		char *quotedElementStr = (char *)TclStackAlloc(interp, len + 1);

		len = TclConvertElement(elementStr, elemLen,
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
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







-
+
-





-
+



-
+

-
+







				 * processed here. Should be NULL if no return
				 * of arguments is desired. */
{
    Tcl_Obj **leftovers;	/* Array to write back to remObjv on
				 * successful exit. Will include the name of
				 * the command. */
    Tcl_Size nrem;		/* Size of leftovers.*/
    const Tcl_ArgvInfo *infoPtr;
    const Tcl_ArgvInfo *infoPtr;/* Pointer to the current entry in the table
				/* Pointer to the current entry in the table
				 * of argument descriptions. */
    const Tcl_ArgvInfo *matchPtr;
				/* Descriptor that matches current argument */
    Tcl_Obj *curArg;		/* Current argument */
    const char *str = NULL;
    char c;		/* Second character of current arg (used for
    char c;			/* Second character of current arg (used for
				 * quick check for matching; use 2nd char.
				 * because first char. will almost always be
				 * '-'). */
    Tcl_Size srcIndex;	/* Location from which to read next argument
    Tcl_Size srcIndex;		/* Location from which to read next argument
				 * from objv. */
    Tcl_Size dstIndex;	/* Used to keep track of current arguments
    Tcl_Size dstIndex;		/* Used to keep track of current arguments
				 * being processed, primarily for error
				 * reporting. */
    Tcl_Size objc;		/* # arguments in objv still to process. */
    Tcl_Size length;		/* Number of characters in current argument */
    Tcl_Size gf_ret;		/* Return value from Tcl_ArgvGenFuncProc*/

    if (remObjv != NULL) {
1045
1046
1047
1048
1049
1050
1051
1052

1053
1054
1055
1056
1057
1058
1059
1056
1057
1058
1059
1060
1061
1062

1063
1064
1065
1066
1067
1068
1069
1070







-
+







    srcIndex = dstIndex = 1;
    objc = *objcPtr-1;

    while (objc > 0) {
	curArg = objv[srcIndex];
	srcIndex++;
	objc--;
	str = TclGetStringFromObj(curArg, &length);
	str = Tcl_GetStringFromObj(curArg, &length);
	if (length > 0) {
	    c = str[1];
	} else {
	    c = 0;
	}

	/*
Changes to generic/tclInt.decls.














1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-
-







# Copyright © 1998-1999 Scriptics Corporation.
# Copyright © 2001 Kevin B. Kenny.  All rights reserved.
# Copyright © 2007 Daniel A. Steffen <das@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# tclInt.decls --
#
#	This file contains the declarations for all unsupported
#	functions that are exported by the Tcl library.  This file
#	is used to generate the tclIntDecls.h, tclIntPlatDecls.h
#	and tclStubInit.c files
#
# Copyright © 1998-1999 Scriptics Corporation.
# Copyright © 2001 Kevin B. Kenny.  All rights reserved.
# Copyright © 2007 Daniel A. Steffen <das@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

library tcl

# Define the unsupported generic interfaces.

interface tclInt
scspec EXTERN
33
34
35
36
37
38
39





40
41
42
43
44
45
46
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59







+
+
+
+
+







}
declare 6 {
    void TclCleanupCommand(Command *cmdPtr)
}
declare 7 {
    Tcl_Size TclCopyAndCollapse(Tcl_Size count, const char *src, char *dst)
}
# Removed in 9.0:
#declare 8 {
#    int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan,
#	    Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
#}
# TclCreatePipeline unofficially exported for use by BLT.
declare 9 {
    Tcl_Size TclCreatePipeline(Tcl_Interp *interp, Tcl_Size argc, const char **argv,
	    Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr,
	    TclFile *errFilePtr)
}
declare 10 {
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
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




+
+
+
+
+















+
+
+
+
+
+
+
+







    int Tcl_GetNamespaceResolvers(Tcl_Namespace *namespacePtr,
	    Tcl_ResolverInfo *resInfo)
}
declare 120 {
    Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name,
	    Tcl_Namespace *contextNsPtr, int flags)
}
# Removed in 9.0:
#declare 121 {
#    int TclForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
#	    const char *pattern)
#}
#declare 122 {
#    Tcl_Command TclGetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
#}
#declare 123 {
#    void TclGetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
#	    Tcl_Obj *objPtr)
#}
#declare 124 {
#    Tcl_Namespace *TclGetCurrentNamespace_(Tcl_Interp *interp)
#}
#declare 125 {
#    Tcl_Namespace *TclGetGlobalNamespace_(Tcl_Interp *interp)
#}
declare 126 {
    void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable,
	    Tcl_Obj *objPtr)
}
# Removed in 9.0:
#declare 127 {
#    int TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
#	    const char *pattern, int allowOverwrite)
#}
declare 128 {
    void Tcl_PopCallFrame(Tcl_Interp *interp)
}
declare 129 {
    int Tcl_PushCallFrame(Tcl_Interp *interp, Tcl_CallFrame *framePtr,
	    Tcl_Namespace *nsPtr, int isProcCallFrame)
}
declare 130 {
    int Tcl_RemoveInterpResolvers(Tcl_Interp *interp, const char *name)
}
declare 131 {
    void Tcl_SetNamespaceResolvers(Tcl_Namespace *namespacePtr,
	    Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc,
	    Tcl_ResolveCompiledVarProc *compiledVarProc)
}
# Removed in 9.0:
#declare 132 {
#    int TclpHasSockets(Tcl_Interp *interp)
#}
# Removed in 9.0:
#declare 133 {
#    struct tm *TclpGetDate(const time_t *time, int useGMT)
#}
declare 138 {
    const char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
}
# This is used by TclX, but should otherwise be considered private
declare 141 {
    const char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
348
349
350
351
352
353
354








355
356
357
358
359
360
361
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413







+
+
+
+
+
+
+
+







declare 156 {
    void TclRegError(Tcl_Interp *interp, const char *msg,
	    int status)
}
declare 157 {
    Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName)
}
# Removed in 9.0:
#declare 158 {
#    void TclSetStartupScriptFileName(const char *filename)
#}
#declare 159 {
#    const char *TclGetStartupScriptFileName(void)
#}

declare 161 {
    int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan,
	    Tcl_Obj *cmdObjPtr)
}
declare 162 {
    void TclChannelEventScriptInvoker(void *clientData, int flags)
}
384
385
386
387
388
389
390







391
392
393
394
395
396
397
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456







+
+
+
+
+
+
+








# New function due to TIP #33
declare 166 {
    int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    Tcl_Size index, Tcl_Obj *valuePtr)
}

# Removed in 9.0:
#declare 167 {
#    void TclSetStartupScriptPath(Tcl_Obj *pathPtr)
#}
#declare 168 {
#    Tcl_Obj *TclGetStartupScriptPath(void)
#}
# variant of Tcl_UtfNcmp that takes n as bytes, not chars
declare 169 {
    int TclpUtfNcmp2(const void *s1, const void *s2, size_t n)
}
declare 170 {
    int TclCheckInterpTraces(Tcl_Interp *interp, const char *command,
	    Tcl_Size numChars, Command *cmdPtr, int result, int traceFlags,
416
417
418
419
420
421
422
















423
424
425
426
427
428
429
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







declare 176 {
    void TclCleanupVar(Var *varPtr, Var *arrayPtr)
}
declare 177 {
    void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2,
	    const char *operation, const char *reason)
}
# Removed in 9.0:
#declare 178 {
#    void TclSetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
#}
#declare 179 {
#    Tcl_Obj *TclGetStartupScript(const char **encodingNamePtr)
#}
#declare 182 {
#     struct tm *TclpLocaltime(const time_t *clock)
#}
#declare 183 {
#     struct tm *TclpGmtime(const time_t *clock)
#}

# For the new "Thread Storage" subsystem.

declare 198 {
    int TclObjGetFrame(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    CallFrame **framePtrPtr)
}
# 200-208 exported for use by the test suite [Bug 1054748]
declare 200 {
    int TclpObjRemoveDirectory(Tcl_Obj *pathPtr, int recursive,
538
539
540
541
542
543
544




545
546
547
548
549
550
551
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630







+
+
+
+







declare 234 {
    Var *TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key,
	    int *newPtr)
}
declare 235 {
    void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr)
}
# Removed in 9.0:
#declare 236 {
#    void TclBackgroundException(Tcl_Interp *interp, int code)
#}

# TIP #285: Script cancellation support.
declare 237 {
    int TclResetCancellation(Tcl_Interp *interp, int force)
}

# NRE functions for "rogue" extensions to exploit NRE; they will need to
651
652
653
654
655
656
657




658
659
660
661
662
663
664
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747







+
+
+
+







# only available on the designated platform.

interface tclIntPlat

################################
# Platform specific functions

# Removed in 9.0
#declare 0 {unix win} {
#    void TclWinConvertError(unsigned errCode)
#}
declare 1 {
    int TclpCloseFile(TclFile file)
}
declare 2 {
    Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
	    TclFile writeFile, TclFile errorFile, size_t numPids, Tcl_Pid *pidPtr)
}
Changes to generic/tclInt.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
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

-
-
-
-








+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclInt.h --
 *
 *	Declarations of things used internally by the Tcl interpreter.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1993-1997 Lucent Technologies.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
 * Copyright (c) 2006-2008 by Joe Mistachkin.  All rights reserved.
 * Copyright (c) 2008 by Miguel Sofer. All rights reserved.
 * Copyright (c) 2021 by Nathan Coulter. All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclInt.h --
 *
 *	Declarations of things used internally by the Tcl interpreter.
 */

#ifndef _TCLINT
#define _TCLINT

/*
 * Some numerics configuration options.
 */

42
43
44
45
46
47
48

49
50

51
52

53
54
55
56
57
58
59
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74







+


+


+







#ifndef JOIN
#  define JOIN(a,b) JOIN1(a,b)
#  define JOIN1(a,b) a##b
#endif

#if defined(__cplusplus)
#   define TCL_UNUSED(T) T
#   define TCL_UNUSEDVAR(T) T
#elif defined(__GNUC__) && (__GNUC__ > 2)
#   define TCL_UNUSED(T) T JOIN(dummy, __LINE__) __attribute__((unused))
#   define TCL_UNUSEDVAR(T) T __attribute__((unused))
#else
#   define TCL_UNUSED(T) T JOIN(dummy, __LINE__)
#   define TCL_UNUSEDVAR(T) T
#endif

/*
 * Common include files needed by most of the Tcl source files are included
 * here, so that system-dependent personalizations for the include files only
 * have to be made in once place. This results in a few extra includes, but
 * greater modularity. The order of the three groups of #includes is
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
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




















-


-







 * different rules:
 *    - Bug #696893 - variable is either proc-local or in the current
 *	namespace; never follow the second (global) resolution path
 *    - Bug #631741 - do not use special namespace or interp resolvers
 */

#define TCL_AVOID_RESOLVERS 0x40000

/*
 *----------------------------------------------------------------
 * Object type
 *----------------------------------------------------------------
 */

/* version is a pointer so that it can be overridden if ever needed */
typedef struct TclObjectTypeType {
    int *version;
} TclObjectTypeType;


/* keep this structure in sync with Tcl_ObjType */
typedef struct ObjectType {
    const char *name;		/* Name of the type, e.g. "int". */
    Tcl_FreeInternalRepProc *freeIntRepProc;
				/* Called to free any storage for the type's
				 * internal rep. NULL if the internal rep does
				 * not need freeing. */
    Tcl_DupInternalRepProc *dupIntRepProc;
				/* Called to create a new object as a copy of
				 * an existing object. */
    Tcl_UpdateStringProc *updateStringProc;
				/* Called to update the string rep from the
				 * type's internal representation. */
    Tcl_SetFromAnyProc *setFromAnyProc;
				/* Called to convert the object's internal rep
				 * to this type. Frees the internal rep of the
				 * old type. Returns TCL_ERROR on failure. */
    int version;
    Tcl_ObjInterface *ifPtr;	/* pointer to a functional interface */
} ObjectType;

#define TclObjectInterfaceCall(objPtr, iface, proc, ...)		    \
    ((ObjInterface *)((ObjectType *)(objPtr)->typePtr)->ifPtr)		    \
	->iface.proc(__VA_ARGS__)

#define TclObjectDispatch(objPtr, default, iface, proc, ...)		    \
    TclObjectHasInterface((objPtr), iface, proc)			    \
    ? TclObjectInterfaceCall(objPtr, iface, proc, __VA_ARGS__)		    \
    : default(__VA_ARGS__)


#define TclObjectDispatchNoDefault(interp, res, objPtr, iface, proc, ...)   \
    (TclObjectHasInterface((objPtr), iface, proc)			    \
    ? ((res) = TclObjectInterfaceCall((objPtr), iface, proc, __VA_ARGS__),  \
	TCL_OK)   \
    : (Tcl_SetObjResult((interp),					    \
	    Tcl_ObjPrintf("interface error interface %s proc %s\n%s"	    \
		, #iface, #proc,					    \
		    Tcl_GetStringFromObj(				    \
			Tcl_GetObjResult(interp) ,NULL))), TCL_ERROR))


#define TclObjectHasInterface(objPtr, iface, proc)  \
    ( \
	(objPtr)->typePtr != NULL			    \
	&&TclObjInterface(objPtr) != NULL	    \
	&& TclObjInterface(objPtr)->iface.proc != NULL \
    )

/*
 *----------------------------------------------------------------
 * Object interface data structures and macros
 *----------------------------------------------------------------
 */

typedef struct ObjInterface {
    int version;
    struct string {
	int (*index)(tclObjTypeInterfaceArgsStringIndex);
	int (*indexEnd)(tclObjTypeInterfaceArgsStringIndexEnd);
	int (*isEmpty)(tclObjTypeInterfaceArgsStringIsEmpty);
	int (*length)(tclObjTypeInterfaceArgsStringLength);
	int (*range)(tclObjTypeInterfaceArgsStringRange);
	int (*rangeEnd)(tclObjTypeInterfaceArgsStringRangeEnd);
    } string;
    struct list {
	int (*all)(tclObjTypeInterfaceArgsListAll);
	int (*append)(tclObjTypeInterfaceArgsListAppend);
	int (*appendlist)(tclObjTypeInterfaceArgsListAppendList);
	int (*contains)(tclObjTypeInterfaceArgsListContains);
	int (*index)(tclObjTypeInterfaceArgsListIndex);
	int (*indexEnd)(tclObjTypeInterfaceArgsListIndexEnd);
	int (*isSorted)(tclObjTypeInterfaceArgsListIsSorted);
	int (*length)(tclObjTypeInterfaceArgsListLength);
	int (*range)(tclObjTypeInterfaceArgsListRange);
	int (*rangeEnd)(tclObjTypeInterfaceArgsListRangeEnd);
	int (*replace)(tclObjTypeInterfaceArgsListReplace);
	int (*replaceList)(tclObjTypeInterfaceArgsListReplaceList);
	int (*reverse)(tclObjTypeInterfaceArgsListReverse);
	int (*set)(tclObjTypeInterfaceArgsListSet);
	int (*setDeep)(tclObjTypeInterfaceArgsListSetDeep);
    } list;
} ObjInterface;


/*
 *----------------------------------------------------------------
 * Data structures related to namespaces.
 *----------------------------------------------------------------
 */

typedef struct Tcl_Ensemble Tcl_Ensemble;
typedef struct NamespacePathEntry NamespacePathEntry;

/*
 * Special hashtable for variables:  This is just a Tcl_HashTable with nsPtr
 * and arrayPtr fields added at the end so that variables can find their
 * namespace and possibly containing array without having to copy a pointer in
 * their struct by accessing them via their hPtr->tablePtr.
 */

typedef struct TclVarHashTable {
    Tcl_HashTable table;	/* "Inherit" from Tcl_HashTable. */
    struct Namespace *nsPtr;	/* The namespace containing the variables. */
#if TCL_MAJOR_VERSION > 8
    struct Var *arrayPtr;	/* The array containing the variables, if they
				 * are variables in an array at all. */
#endif /* TCL_MAJOR_VERSION > 8 */
} TclVarHashTable;

/*
 * This is for itcl - it likes to search our varTables directly :(
 */

#define TclVarHashFindVar(tablePtr, key) \
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
381
382
383
384
385
386
387

388



389
390
391
392
393
394
395







-

-
-
-







				 * strings; values have type (Namespace *). */
#else
    Tcl_HashTable *childTablePtr;
				/* Contains any child namespaces. Indexed by
				 * strings; values have type (Namespace *). If
				 * NULL, there are no children. */
#endif
#if TCL_MAJOR_VERSION > 8
    size_t nsId;		/* Unique id for the namespace. */
#else
    unsigned long nsId;
#endif
    Tcl_Interp *interp;		/* The interpreter containing this
				 * namespace. */
    int flags;			/* OR-ed combination of the namespace status
				 * flags NS_DYING and NS_DEAD listed below. */
    Tcl_Size activationCount;	/* Number of "activations" or active call
				 * frames for this namespace that are on the
				 * Tcl call stack. The namespace won't be
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
527
528
529
530
531
532
533


534
535
536
537

538
539
540
541
542
543
544







-
-




-







/*
 * Flags passed to TclGetNamespaceForQualName:
 *
 * TCL_GLOBAL_ONLY		- (see tcl.h) Look only in the global ns.
 * TCL_NAMESPACE_ONLY		- (see tcl.h) Look only in the context ns.
 * TCL_CREATE_NS_IF_UNKNOWN	- Create unknown namespaces.
 * TCL_FIND_ONLY_NS		- The name sought is a namespace name.
 * TCL_FIND_IF_NOT_SIMPLE	- Retrieve last namespace even if the rest of
 *				  name is not simple name (contains ::).
 */

#define TCL_CREATE_NS_IF_UNKNOWN	0x800
#define TCL_FIND_ONLY_NS		0x1000
#define TCL_FIND_IF_NOT_SIMPLE		0x2000

/*
 * The client data for an ensemble command. This consists of the table of
 * commands that are actually exported by the namespace, and an epoch counter
 * that, combined with the exportLookupEpoch field of the namespace structure,
 * defines whether the table contains valid data or will need to be recomputed
 * next time the ensemble command is called.
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
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







-
+











-
-
-
-
-
+
+
+
+
+



-
-
-
-
-
+
+
+
+
+

















-
+







#define TclSetVarConstant(varPtr) \
    (varPtr)->flags = ((varPtr)->flags & ~(VAR_ARRAY|VAR_LINK)) | VAR_CONSTANT

#define TclSetVarArrayElement(varPtr) \
    (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_ARRAY_ELEMENT

#define TclSetVarUndefined(varPtr) \
    (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK|VAR_CONSTANT);\
    (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK|VAR_CONSTANT);		\
    (varPtr)->value.objPtr = NULL

#define TclClearVarUndefined(varPtr)

#define TclSetVarTraceActive(varPtr) \
    (varPtr)->flags |= VAR_TRACE_ACTIVE

#define TclClearVarTraceActive(varPtr) \
    (varPtr)->flags &= ~VAR_TRACE_ACTIVE

#define TclSetVarNamespaceVar(varPtr) \
    if (!TclIsVarNamespaceVar(varPtr)) {\
	(varPtr)->flags |= VAR_NAMESPACE_VAR;\
	if (TclIsVarInHash(varPtr)) {\
	    ((VarInHash *)(varPtr))->refCount++;\
	}\
    if (!TclIsVarNamespaceVar(varPtr)) {				\
	(varPtr)->flags |= VAR_NAMESPACE_VAR;				\
	if (TclIsVarInHash(varPtr)) {					\
	    ((VarInHash *)(varPtr))->refCount++;			\
	}								\
    }

#define TclClearVarNamespaceVar(varPtr) \
    if (TclIsVarNamespaceVar(varPtr)) {\
	(varPtr)->flags &= ~VAR_NAMESPACE_VAR;\
	if (TclIsVarInHash(varPtr)) {\
	    ((VarInHash *)(varPtr))->refCount--;\
	}\
    if (TclIsVarNamespaceVar(varPtr)) {					\
	(varPtr)->flags &= ~VAR_NAMESPACE_VAR;				\
	if (TclIsVarInHash(varPtr)) {					\
	    ((VarInHash *)(varPtr))->refCount--;			\
	}								\
    }

/*
 * Macros to read various flag bits of variables.
 * The ANSI C "prototypes" for these macros are:
 *
 * MODULE_SCOPE int	TclIsVarScalar(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarConstant(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarLink(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarArray(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarUndefined(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarArrayElement(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarTemporary(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarArgument(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarResolved(Var *varPtr);
 */

#define TclVarFindHiddenArray(varPtr,arrayPtr)				\
#define TclVarFindHiddenArray(varPtr, arrayPtr) \
    do {								\
	if ((arrayPtr == NULL) && TclIsVarInHash(varPtr) &&		\
		(TclVarParentArray(varPtr) != NULL)) {			\
	    arrayPtr = TclVarParentArray(varPtr);			\
	}								\
    } while(0)

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
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







-
+
















-
+





-
-
+
+



-
+


+
-
+


-
+
+



-
+



-
+



-
+







#define TclIsVarInHash(varPtr) \
    ((varPtr)->flags & VAR_IN_HASHTABLE)

#define TclIsVarDeadHash(varPtr) \
    ((varPtr)->flags & VAR_DEAD_HASH)

#define TclGetVarNsPtr(varPtr) \
    (TclIsVarInHash(varPtr) \
    (TclIsVarInHash(varPtr)						\
	? ((TclVarHashTable *) ((((VarInHash *) (varPtr))->entry.tablePtr)))->nsPtr \
	: NULL)

#define TclVarParentArray(varPtr)					\
    ((TclVarHashTable *) ((VarInHash *) (varPtr))->entry.tablePtr)->arrayPtr

#define VarHashRefCount(varPtr) \
    ((VarInHash *) (varPtr))->refCount

#define VarHashGetKey(varPtr) \
    (((VarInHash *)(varPtr))->entry.key.objPtr)

/*
 * Macros for direct variable access by TEBC.
 */

#define TclIsVarTricky(varPtr,trickyFlags)				\
#define TclIsVarTricky(varPtr, trickyFlags) \
    (   ((varPtr)->flags & (VAR_ARRAY|VAR_LINK|trickyFlags))		\
	  || (TclIsVarInHash(varPtr)					\
		&& (TclVarParentArray(varPtr) != NULL)			\
		&& (TclVarParentArray(varPtr)->flags & (trickyFlags))))

#define TclIsVarDirectReadable(varPtr)					\
    (   (!TclIsVarTricky(varPtr,VAR_TRACED_READ))			\
#define TclIsVarDirectReadable(varPtr) \
    (   (!TclIsVarTricky(varPtr, VAR_TRACED_READ))			\
	&& (varPtr)->value.objPtr)

#define TclIsVarDirectWritable(varPtr) \
    (!TclIsVarTricky(varPtr,VAR_TRACED_WRITE|VAR_DEAD_HASH|VAR_CONSTANT))
    (!TclIsVarTricky(varPtr, VAR_TRACED_WRITE|VAR_DEAD_HASH|VAR_CONSTANT))

#define TclIsVarDirectUnsettable(varPtr) \
    (!TclIsVarTricky(varPtr,						\
    (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_UNSET|VAR_DEAD_HASH|VAR_CONSTANT))
	VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_UNSET|VAR_DEAD_HASH|VAR_CONSTANT))

#define TclIsVarDirectModifyable(varPtr) \
    (   (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_CONSTANT))	\
    (   (!TclIsVarTricky(varPtr,					\
	    VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_CONSTANT))		\
	&&  (varPtr)->value.objPtr)

#define TclIsVarDirectReadable2(varPtr, arrayPtr) \
    (TclIsVarDirectReadable(varPtr) &&\
    (TclIsVarDirectReadable(varPtr) &&					\
	(!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_READ)))

#define TclIsVarDirectWritable2(varPtr, arrayPtr) \
    (TclIsVarDirectWritable(varPtr) &&\
    (TclIsVarDirectWritable(varPtr) &&					\
	(!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_WRITE)))

#define TclIsVarDirectModifyable2(varPtr, arrayPtr) \
    (TclIsVarDirectModifyable(varPtr) &&\
    (TclIsVarDirectModifyable(varPtr) &&				\
	(!(arrayPtr) || !((arrayPtr)->flags & (VAR_TRACED_READ|VAR_TRACED_WRITE))))

/*
 *----------------------------------------------------------------
 * Data structures related to procedures. These are used primarily in
 * tclProc.c, tclCompile.c, and tclExecute.c.
 *----------------------------------------------------------------
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
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







-
-
-










-




-







				/* Next compiler-recognized local variable for
				 * this procedure, or NULL if this is the last
				 * local. */
    Tcl_Size nameLength;	/* The number of bytes in local variable's name.
				 * Among others used to speed up var lookups. */
    Tcl_Size frameIndex;	/* Index in the array of compiler-assigned
				 * variables in the procedure call frame. */
#if TCL_MAJOR_VERSION < 9
    int flags;
#endif
    Tcl_Obj *defValuePtr;	/* Pointer to the default value of an
				 * argument, if any. NULL if not an argument
				 * or, if an argument, no default value. */
    Tcl_ResolvedVarInfo *resolveInfo;
				/* Customized variable resolution info
				 * supplied by the Tcl_ResolveCompiledVarProc
				 * associated with a namespace. Each variable
				 * is marked by a unique tag during
				 * compilation, and that same tag is used to
				 * find the variable at runtime. */
#if TCL_MAJOR_VERSION > 8
    int flags;			/* Flag bits for the local variable. Same as
				 * the flags for the Var structure above,
				 * although only VAR_ARGUMENT, VAR_TEMPORARY,
				 * and VAR_RESOLVED make sense. */
#endif
    char name[TCLFLEXARRAY];	/* Name of the local variable starts here. If
				 * the name is NULL, this will just be '\0'.
				 * The actual size of this field will be large
				 * enough to hold the name. MUST BE THE LAST
				 * FIELD IN THE STRUCTURE! */
} CompiledLocal;

1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1150
1151
1152
1153
1154
1155
1156

1157



1158
1159
1160
1161
1162
1163
1164







-

-
-
-







 * The structure below defines a command trace. This is used to allow Tcl
 * clients to find out whenever a command is about to be executed.
 */

typedef struct Trace {
    Tcl_Size level;		/* Only trace commands at nesting level less
				 * than or equal to this. */
#if TCL_MAJOR_VERSION > 8
    Tcl_CmdObjTraceProc2 *proc;	/* Procedure to call to trace command. */
#else
    Tcl_CmdObjTraceProc *proc;	/* Procedure to call to trace command. */
#endif
    void *clientData;		/* Arbitrary value to pass to proc. */
    struct Trace *nextPtr;	/* Next in list of traces for this interp. */
    int flags;			/* Flags governing the trace - see
				 * Tcl_CreateObjTrace for details. */
    Tcl_CmdObjTraceDeleteProc *delProc;
				/* Procedure to call when trace is deleted. */
} Trace;
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
1194
1195
1196
1197
1198
1199
1200








































































































1201
1202
1203
1204
1205
1206
1207







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 *				- passed to Tcl_CreateObjTrace to set up
 *				  "leavestep" traces.
 */

#define TCL_TRACE_ENTER_EXEC	1
#define TCL_TRACE_LEAVE_EXEC	2

#if TCL_MAJOR_VERSION > 8
#define TclObjTypeHasProc(objPtr, proc) (((objPtr)->typePtr \
	&& ((offsetof(Tcl_ObjType, proc) < offsetof(Tcl_ObjType, version)) \
	|| (offsetof(Tcl_ObjType, proc) < (objPtr)->typePtr->version))) ? \
	((objPtr)->typePtr)->proc : NULL)

MODULE_SCOPE Tcl_Size TclLengthOne(Tcl_Obj *);

/*
 * Abstract List
 *
 * This structure provides the functions used in List operations to emulate a
 * List for AbstractList types.
 */

static inline Tcl_Size
TclObjTypeLength(
    Tcl_Obj *objPtr)
{
    Tcl_ObjTypeLengthProc *proc = TclObjTypeHasProc(objPtr, lengthProc);
    return proc(objPtr);
}

static inline int
TclObjTypeIndex(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    Tcl_Size index,
    Tcl_Obj **elemObjPtr)
{
    Tcl_ObjTypeIndexProc *proc = TclObjTypeHasProc(objPtr, indexProc);
    return proc(interp, objPtr, index, elemObjPtr);
}

static inline int
TclObjTypeSlice(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    Tcl_Size fromIdx,
    Tcl_Size toIdx,
    Tcl_Obj **newObjPtr)
{
    Tcl_ObjTypeSliceProc *proc = TclObjTypeHasProc(objPtr, sliceProc);
    return proc(interp, objPtr, fromIdx, toIdx, newObjPtr);
}

static inline int
TclObjTypeReverse(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    Tcl_Obj **newObjPtr)
{
    Tcl_ObjTypeReverseProc *proc = TclObjTypeHasProc(objPtr, reverseProc);
    return proc(interp, objPtr, newObjPtr);
}

static inline int
TclObjTypeGetElements(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    Tcl_Size *objCPtr,
    Tcl_Obj ***objVPtr)
{
    Tcl_ObjTypeGetElements *proc = TclObjTypeHasProc(objPtr, getElementsProc);
    return proc(interp, objPtr, objCPtr, objVPtr);
}

static inline Tcl_Obj*
TclObjTypeSetElement(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    Tcl_Size indexCount,
    Tcl_Obj *const indexArray[],
    Tcl_Obj *valueObj)
{
    Tcl_ObjTypeSetElement *proc = TclObjTypeHasProc(objPtr, setElementProc);
    return proc(interp, objPtr, indexCount, indexArray, valueObj);
}

static inline int
TclObjTypeReplace(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    Tcl_Size first,
    Tcl_Size numToDelete,
    Tcl_Size numToInsert,
    Tcl_Obj *const insertObjs[])
{
    Tcl_ObjTypeReplaceProc *proc = TclObjTypeHasProc(objPtr, replaceProc);
    return proc(interp, objPtr, first, numToDelete, numToInsert, insertObjs);
}

static inline int
TclObjTypeInOperator(
    Tcl_Interp *interp,
    Tcl_Obj *valueObj,
    Tcl_Obj *listObj,
    int *boolResult)
{
    Tcl_ObjTypeInOperatorProc *proc = TclObjTypeHasProc(listObj, inOperProc);
    return proc(interp, valueObj, listObj, boolResult);
}
#endif /* TCL_MAJOR_VERSION > 8 */

/*
 * The structure below defines an entry in the assocData hash table which is
 * associated with an interpreter. The entry contains a pointer to a function
 * to call when the interpreter is deleted, and a pointer to a user-defined
 * piece of data.
 */

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
1987
1988
1989
1990
1991
1992
1993

1994












1995
1996
1997
1998
1999
2000
2001







-

-
-
-
-
-
-
-
-
-
-
-
-







    Tcl_HashTable *hiddenCmdTablePtr;
				/* Hash table used by tclBasic.c to keep track
				 * of hidden commands on a per-interp
				 * basis. */
    void *interpInfo;		/* Information used by tclInterp.c to keep
				 * track of parent/child interps on a
				 * per-interp basis. */
#if TCL_MAJOR_VERSION > 8
    void (*optimizer)(void *envPtr);
				/* Reference to the bytecode optimizer, if one
				 * is set. */
#else
    union {
	void (*optimizer)(void *envPtr);
	Tcl_HashTable unused2;	/* No longer used (was mathFuncTable). The
				 * unused space in interp was repurposed for
				 * pluggable bytecode optimizers. The core
				 * contains one optimizer, which can be
				 * selectively overridden by extensions. */
    } extra;
#endif
    /*
     * Information related to procedures and variables. See tclProc.c and
     * tclVar.c for usage.
     */

    Tcl_Size numLevels;		/* Keeps track of how many nested calls to
				 * Tcl_Eval are in progress for this
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2016
2017
2018
2019
2020
2021
2022






2023
2024
2025
2026
2027
2028
2029







-
-
-
-
-
-







				 * or NULL if no active traces. */
    int returnCode;		/* [return -code] parameter. */
    CallFrame *rootFramePtr;	/* Global frame pointer for this
				 * interpreter. */
    Namespace *lookupNsPtr;	/* Namespace to use ONLY on the next
				 * TCL_EVAL_INVOKE call to Tcl_EvalObjv. */

#if TCL_MAJOR_VERSION < 9
    char *appendResultDontUse;
    int appendAvlDontUse;
    int appendUsedDontUse;
#endif

    /*
     * Information about packages. Used only in tclPkg.c.
     */

    Tcl_HashTable packageTable;	/* Describes all of the packages loaded in or
				 * available to this interpreter. Keys are
				 * package names, values are (Package *)
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2038
2039
2040
2041
2042
2043
2044



2045
2046
2047
2048
2049
2050
2051







-
-
-








    Tcl_Size cmdCount;		/* Total number of times a command procedure
				 * has been called for this interpreter. */
    int evalFlags;		/* Flags to control next call to Tcl_Eval.
				 * Normally zero, but may be set before
				 * calling Tcl_Eval. See below for valid
				 * values. */
#if TCL_MAJOR_VERSION < 9
    int unused1;		/* No longer used (was termOffset) */
#endif
    LiteralTable literalTable;	/* Contains LiteralEntry's describing all Tcl
				 * objects holding literals of scripts
				 * compiled by the interpreter. Indexed by the
				 * string representations of literals. Used to
				 * avoid creating duplicate objects. */
    Tcl_Size compileEpoch;	/* Holds the current "compilation epoch" for
				 * this interpreter. This is incremented to
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2074
2075
2076
2077
2078
2079
2080



2081
2082
2083
2084
2085
2086
2087







-
-
-







    struct ExecEnv *execEnvPtr;	/* Execution environment for Tcl bytecode
				 * execution. Contains a pointer to the Tcl
				 * evaluation stack. */
    Tcl_Obj *emptyObjPtr;	/* Points to an object holding an empty
				 * string. Returned by Tcl_ObjSetVar2 when
				 * variable traces change a variable in a
				 * gross way. */
#if TCL_MAJOR_VERSION < 9
    char resultSpaceDontUse[TCL_DSTRING_STATIC_SIZE+1];
#endif
    Tcl_Obj *objResultPtr;	/* If the last command returned an object
				 * result, this points to it. Should not be
				 * accessed directly; see comment above. */
    Tcl_ThreadId threadId;	/* ID of thread that owns the interpreter. */

    ActiveCommandTrace *activeCmdTracePtr;
				/* First in list of active command traces for
2133
2134
2135
2136
2137
2138
2139
2140

2141
2142
2143
2144
2145
2146
2147
2100
2101
2102
2103
2104
2105
2106

2107
2108
2109
2110
2111
2112
2113
2114







-
+








    Tcl_Obj *returnOpts;	/* A dictionary holding the options to the
				 * last [return] command. */

    Tcl_Obj *errorInfo;		/* errorInfo value (now as a Tcl_Obj). */
    Tcl_Obj *eiVar;		/* cached ref to ::errorInfo variable. */
    Tcl_Obj *errorCode;		/* errorCode value (now as a Tcl_Obj). */
    Tcl_Obj *ecVar;		/* cached ref to ::errorInfo variable. */
    Tcl_Obj *ecVar;		/* cached ref to ::errorCode variable. */
    int returnLevel;		/* [return -level] parameter. */

    /*
     * Resource limiting framework support (TIP#143).
     */

    struct {
2556
2557
2558
2559
2560
2561
2562

2563
2564
2565
2566
2567
2568
2569
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537







+







 *				caller plans on recording its own traceback
 *				information.
 */

#define	TCL_INVOKE_HIDDEN	(1<<0)
#define TCL_INVOKE_NO_UNKNOWN	(1<<1)
#define TCL_INVOKE_NO_TRACEBACK	(1<<2)


/*
 * ListStore --
 *
 * A Tcl list's internal representation is defined through three structures.
 *
 * A ListStore struct is a structure that includes a variable size array that
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
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







-
-
-
-
+
+
+
+


-
-
-
-
+
+
+
+


-
-
+
+


-
-
-
+
+
+


-
+


-
-
+
+


-
-
+
+


-
+

-
-
+
+


-
-
-
-
-
+
+
+
+
+


-
-
-
-
+
+
+
+


-
-
-
+
+
+






-
-
+
+







 *            be a list (tclListType). Will crash otherwise.
 * TclListObj* - expect a pointer to a Tcl_Obj whose internal type may or may not
 *            be tclListType. These will convert as needed and return error if
 *            conversion not possible.
 */

/* Returns the starting slot for this listRep in the contained ListStore */
#define ListRepStart(listRepPtr_) \
    ((listRepPtr_)->spanPtr						\
	? (listRepPtr_)->spanPtr->spanStart				\
	: (listRepPtr_)->storePtr->firstUsed)
#define ListRepStart(listRepPtr) \
    ((listRepPtr)->spanPtr						\
	? (listRepPtr)->spanPtr->spanStart				\
	: (listRepPtr)->storePtr->firstUsed)

/* Returns the number of elements in this listRep */
#define ListRepLength(listRepPtr_) \
    ((listRepPtr_)->spanPtr						\
	? (listRepPtr_)->spanPtr->spanLength				\
	: (listRepPtr_)->storePtr->numUsed)
#define ListRepLength(listRepPtr) \
    ((listRepPtr)->spanPtr						\
	? (listRepPtr)->spanPtr->spanLength				\
	: (listRepPtr)->storePtr->numUsed)

/* Returns a pointer to the first slot containing this ListRep elements */
#define ListRepElementsBase(listRepPtr_) \
    (&(listRepPtr_)->storePtr->slots[ListRepStart(listRepPtr_)])
#define ListRepElementsBase(listRepPtr) \
    (&(listRepPtr)->storePtr->slots[ListRepStart(listRepPtr)])

/* Stores the number of elements and base address of the element array */
#define ListRepElements(listRepPtr_, objc_, objv_) \
    (((objv_) = ListRepElementsBase(listRepPtr_)),			\
     ((objc_) = ListRepLength(listRepPtr_)))
#define ListRepElements(listRepPtr, objc, objv) \
    (((objv) = ListRepElementsBase(listRepPtr)),			\
     ((objc) = ListRepLength(listRepPtr)))

/* Returns 1/0 whether the ListRep's ListStore is shared. */
#define ListRepIsShared(listRepPtr_) ((listRepPtr_)->storePtr->refCount > 1)
#define ListRepIsShared(listRepPtr) ((listRepPtr)->storePtr->refCount > 1)

/* Returns a pointer to the ListStore component */
#define ListObjStorePtr(listObj_) \
    ((ListStore *)((listObj_)->internalRep.twoPtrValue.ptr1))
#define ListObjStorePtr(listObj) \
    ((ListStore *)((listObj)->internalRep.twoPtrValue.ptr1))

/* Returns a pointer to the ListSpan component */
#define ListObjSpanPtr(listObj_) \
    ((ListSpan *)((listObj_)->internalRep.twoPtrValue.ptr2))
#define ListObjSpanPtr(listObj) \
    ((ListSpan *)((listObj)->internalRep.twoPtrValue.ptr2))

/* Returns the ListRep internal representaton in a Tcl_Obj */
#define ListObjGetRep(listObj_, listRepPtr_) \
#define ListObjGetRep(listObj, listRepPtr) \
    do {								\
	(listRepPtr_)->storePtr = ListObjStorePtr(listObj_);		\
	(listRepPtr_)->spanPtr = ListObjSpanPtr(listObj_);		\
	(listRepPtr)->storePtr = ListObjStorePtr(listObj);		\
	(listRepPtr)->spanPtr = ListObjSpanPtr(listObj);		\
    } while (0)

/* Returns the length of the list */
#define ListObjLength(listObj_, len_) \
    ((len_) = ListObjSpanPtr(listObj_)					\
	? ListObjSpanPtr(listObj_)->spanLength				\
	: ListObjStorePtr(listObj_)->numUsed)
/* Retrieves the length of the list */
#define ListObjLength(listObj, len) \
    ((len) = ListObjSpanPtr(listObj)					\
	? ListObjSpanPtr(listObj)->spanLength				\
	: ListObjStorePtr(listObj)->numUsed)

/* Returns the starting slot index of this list's elements in the ListStore */
#define ListObjStart(listObj_) \
    (ListObjSpanPtr(listObj_)						\
	? ListObjSpanPtr(listObj_)->spanStart				\
	: ListObjStorePtr(listObj_)->firstUsed)
#define ListObjStart(listObj) \
    (ListObjSpanPtr(listObj)						\
	? ListObjSpanPtr(listObj)->spanStart				\
	: ListObjStorePtr(listObj)->firstUsed)

/* Stores the element count and base address of this list's elements */
#define ListObjGetElements(listObj_, objc_, objv_) \
    (((objv_) = &ListObjStorePtr(listObj_)->slots[ListObjStart(listObj_)]), \
     (ListObjLength(listObj_, (objc_))))
#define ListObjGetElements(listObj, objc, objv) \
    (((objv) = &ListObjStorePtr(listObj)->slots[ListObjStart(listObj)]), \
     (ListObjLength(listObj, (objc))))

/*
 * Returns 1/0 whether the internal representation (not the Tcl_Obj itself)
 * is shared.  Note by intent this only checks for sharing of ListStore,
 * not spans.
 */
#define ListObjRepIsShared(listObj_) \
    (ListObjStorePtr(listObj_)->refCount > 1)
#define ListObjRepIsShared(listObj) \
    (ListObjStorePtr(listObj)->refCount > 1)

/*
 * Certain commands like concat are optimized if an existing string
 * representation of a list object is known to be in canonical format (i.e.
 * generated from the list representation). There are three conditions when
 * this will be the case:
 * (1) No string representation exists which means it will obviously have
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
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







-
-
+
+

-
+








-
-
-
+
+
+


-
-
-
+
+
+


















-
-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-


-
-
-
+
+
+


-
-
-
-
-
+
+
+
+
+



-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+









-
-
-
-
+
+
+
+
+








/*
 * Converts the Tcl_Obj to a list if it isn't one and stores the element
 * count and base address of this list's elements in objcPtr_ and objvPtr_.
 * Return TCL_OK on success or TCL_ERROR if the Tcl_Obj cannot be
 * converted to a list.
 */
#define TclListObjGetElements(interp_, listObj_, objcPtr_, objvPtr_) \
    ((TclHasInternalRep((listObj_), &tclListType))			\
#define TclListObjGetElements(interp_, listObj_, objcPtr_, objvPtr_)	\
    ((TclHasInternalRep((listObj_) ,tclListTypePtr))			\
	? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))),	\
	    TCL_OK)							\
	   TCL_OK)							\
	: Tcl_ListObjGetElements(					\
	    (interp_), (listObj_), (objcPtr_), (objvPtr_)))

/*
 * Converts the Tcl_Obj to a list if it isn't one and stores the element
 * count in lenPtr_.  Returns TCL_OK on success or TCL_ERROR if the
 * Tcl_Obj cannot be converted to a list.
 */
#define TclListObjLength(interp_, listObj_, lenPtr_) \
    ((TclHasInternalRep((listObj_), &tclListType))			\
	? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK)		\
#define TclListObjLength(interp_, listObj_, lenPtr_)		\
    ((TclHasInternalRep((listObj_), tclListTypePtr))		\
	? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK)	\
	: Tcl_ListObjLength((interp_), (listObj_), (lenPtr_)))

#define TclListObjIsCanonical(listObj_) \
    ((TclHasInternalRep((listObj_), &tclListType))			\
	? ListObjIsCanonical((listObj_))				\
#define TclListObjIsCanonical(listObj_)			\
    ((TclHasInternalRep((listObj_), tclListTypePtr))    \
	? ListObjIsCanonical((listObj_))		\
	: 0)

/*
 * Modes for collecting (or not) in the implementations of TclNRForeachCmd,
 * TclNRLmapCmd and their compilations.
 */

#define TCL_EACH_KEEP_NONE  0	/* Discard iteration result like [foreach] */
#define TCL_EACH_COLLECT    1	/* Collect iteration result like [lmap] */

/*
 * Macros providing a faster path to booleans and integers:
 * Tcl_GetBooleanFromObj, Tcl_GetLongFromObj, Tcl_GetIntFromObj
 * and Tcl_GetIntForIndex.
 *
 * WARNING: these macros eval their args more than once.
 */

#if TCL_MAJOR_VERSION > 8
#define TclGetBooleanFromObj(interp, objPtr, intPtr) \
    ((TclHasInternalRep((objPtr), &tclIntType)				\
	    || TclHasInternalRep((objPtr), &tclBooleanType))		\
	? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK)	\
#define TclGetBooleanFromObj(interp, objPtr, intPtr)			    \
    ((TclHasInternalRep((objPtr), tclIntTypePtr))			    \
	    || TclHasInternalRep((objPtr), tclBooleanTypePtr)		    \
	? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK)	    \
	: Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr)))
#else
#define TclGetBooleanFromObj(interp, objPtr, intPtr) \
    ((TclHasInternalRep((objPtr), &tclIntType))				\
	? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK)	\
	: (TclHasInternalRep((objPtr), &tclBooleanType))		\
	? (*(intPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK)	\
	: Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr)))
#endif

#ifdef TCL_WIDE_INT_IS_LONG
#define TclGetLongFromObj(interp, objPtr, longPtr) \
    ((TclHasInternalRep((objPtr), &tclIntType))				\
	? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK)	\
#define TclGetLongFromObj(interp, objPtr, longPtr)			    \
    ((TclHasInternalRep((objPtr), tclIntTypePtr))			    \
	? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK)	    \
	: Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
#else
#define TclGetLongFromObj(interp, objPtr, longPtr) \
    ((TclHasInternalRep((objPtr), &tclIntType)				\
	    && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN) \
	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(LONG_MAX)) \
	? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \
#define TclGetLongFromObj(interp, objPtr, longPtr)			    \
    ((TclHasInternalRep((objPtr), tclIntTypePtr)			    \
	    && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN)   \
	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(LONG_MAX))  \
	? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK)    \
	: Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
#endif

#define TclGetIntFromObj(interp, objPtr, intPtr) \
    ((TclHasInternalRep((objPtr), &tclIntType)				\
	    && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \
	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \
	? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK)	\
#define TclGetIntFromObj(interp, objPtr, intPtr)			    \
    ((TclHasInternalRep((objPtr), tclIntTypePtr)			    \
	    && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN)    \
	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX))   \
	? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK)	    \
	: Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
    (((TclHasInternalRep((objPtr), &tclIntType))			\
	    && ((objPtr)->internalRep.wideValue >= 0)			\
	    && ((objPtr)->internalRep.wideValue <= endValue))		\
	? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK)	\
	: Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr)		    \
    (((TclHasInternalRep((objPtr), tclIntTypePtr))			    \
	&& ((objPtr)->internalRep.wideValue >= 0)			    \
	    && ((objPtr)->internalRep.wideValue <= endValue))		    \
	    ? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK)	    \
	    : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))

/*
 * Macro used to save a function call for common uses of
 * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is:
 *
 * MODULE_SCOPE int TclGetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 *			Tcl_WideInt *wideIntPtr);
 */

#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
    ((TclHasInternalRep((objPtr), &tclIntType))				\
	? (*(wideIntPtr) = ((objPtr)->internalRep.wideValue), TCL_OK)	\
	: Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr)		    \
    ((TclHasInternalRep((objPtr), tclIntTypePtr))			    \
	? (*(wideIntPtr) =						    \
		((objPtr)->internalRep.wideValue), TCL_OK) :		    \
	Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))

/*
 * Flag values for TclTraceDictPath().
 *
 * DICT_PATH_READ indicates that all entries on the path must exist but no
 * updates will be needed.
 *
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999



3000
3001
3002


3003
3004
3005
3006
3007
3008
3009
2950
2951
2952
2953
2954
2955
2956



2957
2958
2959
2960


2961
2962
2963
2964
2965
2966
2967
2968
2969







-
-
-
+
+
+

-
-
+
+







 *----------------------------------------------------------------------
 * Internal convenience macros for manipulating encoding flags. See
 * TCL_ENCODING_PROFILE_* in tcl.h
 *----------------------------------------------------------------------
 */

#define ENCODING_PROFILE_MASK     0xFF000000
#define ENCODING_PROFILE_GET(flags_) \
    ((flags_) & ENCODING_PROFILE_MASK)
#define ENCODING_PROFILE_SET(flags_, profile_) \
#define ENCODING_PROFILE_GET(flags) \
    ((flags) & ENCODING_PROFILE_MASK)
#define ENCODING_PROFILE_SET(flags, profile) \
    do {								\
	(flags_) &= ~ENCODING_PROFILE_MASK;				\
	(flags_) |= ((profile_) & ENCODING_PROFILE_MASK);		\
	(flags) &= ~ENCODING_PROFILE_MASK;				\
	(flags) |= ((profile) & ENCODING_PROFILE_MASK);			\
    } while (0)

/*
 *----------------------------------------------------------------------
 * Common functions for calculating overallocation. Trivial but allows for
 * experimenting with growth factors without having to change code in
 * multiple places. See TclAttemptAllocElemsEx and similar for usage
3136
3137
3138
3139
3140
3141
3142
3143
3144


3145
3146
3147
3148



3149
3150
3151


3152
3153
3154
3155
3156
3157
3158
3096
3097
3098
3099
3100
3101
3102


3103
3104
3105



3106
3107
3108
3109


3110
3111
3112
3113
3114
3115
3116
3117
3118







-
-
+
+

-
-
-
+
+
+

-
-
+
+







MODULE_SCOPE Tcl_ScaleTimeProc *tclScaleTimeProcPtr;
MODULE_SCOPE void *tclTimeClientData;

/*
 * Variables denoting the Tcl object types defined in the core.
 */

MODULE_SCOPE const Tcl_ObjType tclBignumType;
MODULE_SCOPE const Tcl_ObjType tclBooleanType;
MODULE_SCOPE const Tcl_ObjType *tclBignumTypePtr;
MODULE_SCOPE const Tcl_ObjType *tclBooleanTypePtr;
MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
MODULE_SCOPE const Tcl_ObjType tclDoubleType;
MODULE_SCOPE const Tcl_ObjType tclExprCodeType;
MODULE_SCOPE const Tcl_ObjType tclIntType;
MODULE_SCOPE Tcl_ObjType *tclDictTypePtr;
MODULE_SCOPE const Tcl_ObjType *tclDoubleTypePtr;
MODULE_SCOPE const Tcl_ObjType tclExprCodeType;
MODULE_SCOPE const Tcl_ObjType tclIndexType;
MODULE_SCOPE const Tcl_ObjType tclListType;
MODULE_SCOPE const Tcl_ObjType tclDictType;
MODULE_SCOPE const Tcl_ObjType *tclIntTypePtr;
MODULE_SCOPE Tcl_ObjType *tclListTypePtr;
MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
MODULE_SCOPE const Tcl_ObjType tclStringType;
MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType;
MODULE_SCOPE const Tcl_ObjType tclRegexpType;
MODULE_SCOPE Tcl_ObjType tclCmdNameType;

/*
3247
3248
3249
3250
3251
3252
3253
3254
3255


3256
3257
3258
3259
3260
3261
3262
3207
3208
3209
3210
3211
3212
3213


3214
3215
3216
3217
3218
3219
3220
3221
3222







-
-
+
+







    Tcl_Obj *body;		/* Loop body. */
    Tcl_Obj *next;		/* Loop step script, NULL for 'while'. */
    const char *msg;		/* Error message part. */
    Tcl_Size word;		/* Index of the body script in the command */
} ForIterData;

/* TIP #357 - Structure doing the bookkeeping of handles for Tcl_LoadFile
 *            and Tcl_FindSymbol. This structure corresponds to an opaque
 *            typedef in tcl.h */
 *	      and Tcl_FindSymbol. This structure corresponds to an opaque
 *	      typedef in tcl.h */

typedef void* TclFindSymbolProc(Tcl_Interp* interp, Tcl_LoadHandle loadHandle,
	const char* symbol);
struct Tcl_LoadHandle_ {
    void *clientData;		/* Client data is the load handle in the
				 * native filesystem if a module was loaded
				 * there, or an opaque pointer to a structure
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
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







-




















+













-
+








/*
 *----------------------------------------------------------------
 * Procedures shared among Tcl modules but not used by the outside world:
 *----------------------------------------------------------------
 */

#if TCL_MAJOR_VERSION > 8
MODULE_SCOPE void	TclAdvanceContinuations(Tcl_Size *line, Tcl_Size **next,
			    int loc);
MODULE_SCOPE void	TclAdvanceLines(Tcl_Size *line, const char *start,
			    const char *end);
MODULE_SCOPE void	TclAppendBytesToByteArray(Tcl_Obj *objPtr,
			    const unsigned char *bytes, Tcl_Size len);
MODULE_SCOPE void	TclAppendUtfToUtf(Tcl_Obj *objPtr,
			    const char *bytes, Tcl_Size numBytes);
MODULE_SCOPE void	TclArgumentEnter(Tcl_Interp *interp,
			    Tcl_Obj *objv[], Tcl_Size objc, CmdFrame *cf);
MODULE_SCOPE void	TclArgumentRelease(Tcl_Interp *interp,
			    Tcl_Obj *objv[], Tcl_Size objc);
MODULE_SCOPE void	TclArgumentBCEnter(Tcl_Interp *interp,
			    Tcl_Obj *objv[], Tcl_Size objc,
			    void *codePtr, CmdFrame *cfPtr, Tcl_Size cmd,
			    Tcl_Size pc);
MODULE_SCOPE void	TclArgumentBCRelease(Tcl_Interp *interp,
			    CmdFrame *cfPtr);
MODULE_SCOPE void	TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
			    CmdFrame **cfPtrPtr, int *wordPtr);
MODULE_SCOPE void	TclArithSeriesInit(void);
MODULE_SCOPE int	TclAsyncNotifier(int sigNumber, Tcl_ThreadId threadId,
			    void *clientData, int *flagPtr, int value);
MODULE_SCOPE void	TclAsyncMarkFromNotifier(void);
MODULE_SCOPE double	TclBignumToDouble(const void *bignum);
MODULE_SCOPE int	TclByteArrayMatch(const unsigned char *string,
			    Tcl_Size strLen, const unsigned char *pattern,
			    Tcl_Size ptnLen, int flags);
MODULE_SCOPE double	TclCeil(const void *a);
MODULE_SCOPE void	TclChannelPreserve(Tcl_Channel chan);
MODULE_SCOPE void	TclChannelRelease(Tcl_Channel chan);
MODULE_SCOPE int	TclChannelGetBlockingMode(Tcl_Channel chan);
MODULE_SCOPE int	TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr,
			    Var *arrayPtr, Tcl_Obj *name, int index);
MODULE_SCOPE int	TclCheckEmptyString(Tcl_Obj *objPtr);
MODULE_SCOPE int	TclCheckEmptyString(Tcl_Interp *interp, Tcl_Obj *objPtr, int *res);
MODULE_SCOPE int	TclChanCaughtErrorBypass(Tcl_Interp *interp,
			    Tcl_Channel chan);
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
MODULE_SCOPE int	TclChanIsBinary(Tcl_Channel chan);
MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble;
MODULE_SCOPE int	TclCompareTwoNumbers(Tcl_Obj *valuePtr,
			    Tcl_Obj *value2Ptr);
3343
3344
3345
3346
3347
3348
3349
3350



3351
3352
3353
3354
3355
3356
3357

3358
3359
3360
3361
3362
3363
3364
3303
3304
3305
3306
3307
3308
3309

3310
3311
3312
3313
3314
3315
3316

3317
3318
3319
3320
3321
3322
3323
3324
3325
3326







-
+
+
+




-


+







			    Tcl_ObjCmdProc *proc, void *clientData,
			    Tcl_CmdDeleteProc *deleteProc);
MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp,
			    const char *name, Tcl_Namespace *nameNamespacePtr,
			    Tcl_Namespace *ensembleNamespacePtr, int flags);
MODULE_SCOPE void	TclDeleteNamespaceVars(Namespace *nsPtr);
MODULE_SCOPE void	TclDeleteNamespaceChildren(Namespace *nsPtr);
MODULE_SCOPE Tcl_Size	TclDictGetSize(Tcl_Obj *dictPtr);
MODULE_SCOPE void	TclDictInit(void);
MODULE_SCOPE Tcl_Obj*	TclDuplicatePureObj(Tcl_Interp *interp,
			    Tcl_Obj * objPtr, const Tcl_ObjType *typPtr);
MODULE_SCOPE int	TclFindDictElement(Tcl_Interp *interp,
			    const char *dict, Tcl_Size dictLength,
			    const char **elementPtr, const char **nextPtr,
			    Tcl_Size *sizePtr, int *literalPtr);
MODULE_SCOPE Tcl_Obj *	TclDictObjSmartRef(Tcl_Interp *interp, Tcl_Obj *);
MODULE_SCOPE int	TclDictGet(Tcl_Interp *interp, Tcl_Obj *dictPtr,
			    const char *key, Tcl_Obj **valuePtrPtr);
MODULE_SCOPE Tcl_Obj *	TclDictObjSmartRef(Tcl_Interp *interp, Tcl_Obj *);
MODULE_SCOPE int	TclDictPut(Tcl_Interp *interp, Tcl_Obj *dictPtr,
			    const char *key, Tcl_Obj *valuePtr);
MODULE_SCOPE int	TclDictPutString(Tcl_Interp *interp, Tcl_Obj *dictPtr,
			    const char *key, const char *value);
MODULE_SCOPE int	TclDictRemove(Tcl_Interp *interp, Tcl_Obj *dictPtr,
			    const char *key);
/* TIP #280 - Modified token based evaluation, with line information. */
3438
3439
3440
3441
3442
3443
3444


3445
3446
3447
3448
3449
3450
3451
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415







+
+







MODULE_SCOPE char *	TclGetStringStorage(Tcl_Obj *objPtr,
			    Tcl_Size *sizePtr);
MODULE_SCOPE int	TclGetLoadedLibraries(Tcl_Interp *interp,
				const char *targetName,
				const char *prefix);
MODULE_SCOPE int	TclGetWideBitsFromObj(Tcl_Interp *, Tcl_Obj *,
				Tcl_WideInt *);
MODULE_SCOPE int	TclIndexIsFromEnd(Tcl_Size encoded);
MODULE_SCOPE Tcl_Size	TclIndexLast (Tcl_Size N);
MODULE_SCOPE int	TclCompareStringKeys(void *keyPtr, Tcl_HashEntry *hPtr);
MODULE_SCOPE size_t	TclHashStringKey(Tcl_HashTable *tablePtr, void *keyPtr);
MODULE_SCOPE int	TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr,
			    Tcl_Obj *incrPtr);
MODULE_SCOPE Tcl_Obj *	TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags);
MODULE_SCOPE Tcl_ObjCmdProc TclInfoExistsCmd;
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
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







+










+
+



-
+
+



-
-
+
+


+
-
+
-
-
+











+
+
+
+
+
















+












-
+
+







MODULE_SCOPE void	TclInitNotifier(void);
MODULE_SCOPE void	TclInitObjSubsystem(void);
MODULE_SCOPE int	TclInterpReady(Tcl_Interp *interp);
MODULE_SCOPE int	TclIsBareword(int byte);
MODULE_SCOPE Tcl_Obj *	TclJoinPath(Tcl_Size elements, Tcl_Obj * const objv[],
			    int forceRelative);
MODULE_SCOPE Tcl_Obj *	TclGetHomeDirObj(Tcl_Interp *interp, const char *user);
MODULE_SCOPE Tcl_ObjInterfaceListLengthProc TclLengthOne; 
MODULE_SCOPE Tcl_Obj *	TclResolveTildePath(Tcl_Interp *interp,
			    Tcl_Obj *pathObj);
MODULE_SCOPE Tcl_Obj *	TclResolveTildePathList(Tcl_Obj *pathsObj);
MODULE_SCOPE int	TclJoinThread(Tcl_ThreadId id, int *result);
MODULE_SCOPE void	TclLimitRemoveAllHandlers(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Obj *	TclLindexList(Tcl_Interp *interp,
			    Tcl_Obj *listPtr, Tcl_Obj *argPtr);
MODULE_SCOPE Tcl_Obj *	TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Size indexCount, Tcl_Obj *const indexArray[]);
MODULE_SCOPE Tcl_Obj *	TclListObjGetElement(Tcl_Obj *listObj, Tcl_Size index);
MODULE_SCOPE int	Tcl_LengthIsFinite(Tcl_Size length);
MODULE_SCOPE void	TclListInit(void);
/* TIP #280 */
MODULE_SCOPE void	TclListLines(Tcl_Obj *listObj, Tcl_Size line, Tcl_Size n,
			    Tcl_Size *lines, Tcl_Obj *const *elems);
MODULE_SCOPE Tcl_Obj *	TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
MODULE_SCOPE int	(*TclObjInterfaceGetListIndex (Tcl_Obj *objPtr))
			    (tclObjTypeInterfaceArgsListIndex);
MODULE_SCOPE int	TclListObjAppendElements(Tcl_Interp *interp,
			    Tcl_Obj *toObj, Tcl_Size elemCount,
			    Tcl_Obj *const elemObjv[]);
MODULE_SCOPE Tcl_Obj *	TclListObjRange(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Size fromIdx, Tcl_Size toIdx);
MODULE_SCOPE int	TclListObjRange(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Size fromIdx, Tcl_Size toIdx, Tcl_Obj **resultPtr);
MODULE_SCOPE Tcl_Obj *	TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
MODULE_SCOPE int	TclLsetFlat(tclObjTypeInterfaceArgsListSetDeep);
MODULE_SCOPE Tcl_Obj *	TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
MODULE_SCOPE Tcl_Obj *	TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Size indexCount, Tcl_Obj *const indexArray[],
			    Tcl_Obj *valuePtr);
			    Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name,
			    const EnsembleImplMap map[]);
MODULE_SCOPE Tcl_Size	TclMaxListLength(const char *bytes, Tcl_Size numBytes,
			    const char **endPtr);
MODULE_SCOPE int	TclMergeReturnOptions(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr,
			    int *codePtr, int *levelPtr);
MODULE_SCOPE Tcl_Obj *	TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options);
MODULE_SCOPE int	TclNokia770Doubles(void);
MODULE_SCOPE void	TclNsDecrRefCount(Namespace *nsPtr);
MODULE_SCOPE int	TclNamespaceDeleted(Namespace *nsPtr);
MODULE_SCOPE Tcl_Obj *	TclNewNamespaceObj(Tcl_Namespace *namespacePtr);
MODULE_SCOPE Tcl_Obj *	TclObjGetScalar(Tcl_Obj *objPtr);
MODULE_SCOPE ObjInterface * TclObjInterface(Tcl_Obj *objPtr);
MODULE_SCOPE const char *   TclObjTypeName(const Tcl_ObjType *typePtr);
MODULE_SCOPE int	 TclObjTypeVersion (const Tcl_ObjType *typePtr);
MODULE_SCOPE void	TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, const char *operation,
			    const char *reason, int index);
MODULE_SCOPE int	TclObjInvokeNamespace(Tcl_Interp *interp,
			    Tcl_Size objc, Tcl_Obj *const objv[],
			    Tcl_Namespace *nsPtr, int flags);
MODULE_SCOPE int	TclObjUnsetVar2(Tcl_Interp *interp,
			    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags);
MODULE_SCOPE int	TclParseBackslash(const char *src,
			    Tcl_Size numBytes, Tcl_Size *readPtr, char *dst);
MODULE_SCOPE int	TclParseNumber(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    const char *expected, const char *bytes,
			    Tcl_Size numBytes, const char **endPtrPtr, int flags);
MODULE_SCOPE void	TclParseInit(Tcl_Interp *interp, const char *string,
			    Tcl_Size numBytes, Tcl_Parse *parsePtr);
MODULE_SCOPE Tcl_Size	TclParseAllWhiteSpace(const char *src, Tcl_Size numBytes);
MODULE_SCOPE void	TclProcInit(void);
MODULE_SCOPE int	TclProcessReturn(Tcl_Interp *interp,
			    int code, int level, Tcl_Obj *returnOpts);
MODULE_SCOPE void	TclUndoRefCount(Tcl_Obj *objPtr);
MODULE_SCOPE int	TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
MODULE_SCOPE Tcl_Obj *	TclpTempFileName(void);
MODULE_SCOPE Tcl_Obj *	TclpTempFileNameForLibrary(Tcl_Interp *interp,
			    Tcl_Obj* pathPtr);
MODULE_SCOPE Tcl_Obj *	TclNewArithSeriesObj(Tcl_Interp *interp,
			    int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj,
			    Tcl_Obj *stepObj, Tcl_Obj *lenObj);
MODULE_SCOPE Tcl_Obj *	TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep,
			    Tcl_Size len);
MODULE_SCOPE Tcl_Obj *	TclNewNamespaceObj(Tcl_Namespace *namespacePtr);

MODULE_SCOPE int	TclSetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
MODULE_SCOPE void	TclpAlertNotifier(void *clientData);
MODULE_SCOPE void *	TclpNotifierData(void);
MODULE_SCOPE void	TclpServiceModeHook(int mode);
MODULE_SCOPE void	TclpSetTimer(const Tcl_Time *timePtr);
MODULE_SCOPE int	TclpWaitForEvent(const Tcl_Time *timePtr);
MODULE_SCOPE void	TclpCreateFileHandler(int fd, int mask,
			    Tcl_FileProc *proc, void *clientData);
3585
3586
3587
3588
3589
3590
3591

3592
3593
3594
3595
3596
3597
3598
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574







+







			    Tcl_Obj *resultPtr, Tcl_Obj *pathPtr,
			    const char *pattern, Tcl_GlobTypeData *types);
MODULE_SCOPE void	*TclpGetNativeCwd(void *clientData);
MODULE_SCOPE Tcl_FSDupInternalRepProc TclNativeDupInternalRep;
MODULE_SCOPE Tcl_Obj *	TclpObjLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
			    int linkType);
MODULE_SCOPE int	TclpObjChdir(Tcl_Obj *pathPtr);
MODULE_SCOPE void Tcl_ObjTypeVersion(Tcl_Obj *objPtr, int *version);
MODULE_SCOPE Tcl_Channel TclpOpenTemporaryFile(Tcl_Obj *dirObj,
			    Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
			    Tcl_Obj *resultingNameObj);
MODULE_SCOPE void	TclPkgFileSeen(Tcl_Interp *interp,
			    const char *fileName);
MODULE_SCOPE void *	TclInitPkgFiles(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Obj *	TclPathPart(Tcl_Interp *interp, Tcl_Obj *pathPtr,
3629
3630
3631
3632
3633
3634
3635


3636
3637
3638
3639
3640
3641
3642
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620







+
+







			    Tcl_Obj *const *objv, Tcl_Size objc, Tcl_Size subIdx,
			    Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
			    TCL_HASH_TYPE numBytes);
typedef int (*memCmpFn_t)(const void*, const void*, size_t);
MODULE_SCOPE int	TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
			    int checkEq, int nocase, Tcl_Size reqlength);
MODULE_SCOPE int	TclStringIndexInterface(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    Tcl_Obj *indexPtr, Tcl_Obj **charPtr);
MODULE_SCOPE int	TclStringMatch(const char *str, Tcl_Size strLen,
			    const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int	TclStringMatchObj(Tcl_Obj *stringObj,
			    Tcl_Obj *patternObj, int flags);
MODULE_SCOPE void	TclSubstCompile(Tcl_Interp *interp, const char *bytes,
			    Tcl_Size numBytes, int flags, Tcl_Size line,
			    struct CompileEnv *envPtr);
3658
3659
3660
3661
3662
3663
3664

3665
3666
3667
3668
3669
3670
3671
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650







+







MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command);
MODULE_SCOPE int	TclObjInterpProc(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE void	TclRegisterCommandTypeName(
			    Tcl_ObjCmdProc *implementationProc,
			    const char *nameStr);
MODULE_SCOPE void	TclUndoRefCount(Tcl_Obj *objPtr);
MODULE_SCOPE int	TclUtfCmp(const char *cs, const char *ct);
MODULE_SCOPE int	TclUtfCasecmp(const char *cs, const char *ct);
MODULE_SCOPE int	TclUtfCount(int ch);
MODULE_SCOPE Tcl_Obj *	TclpNativeToNormalized(void *clientData);
MODULE_SCOPE Tcl_Obj *	TclpFilesystemPathType(Tcl_Obj *pathPtr);
MODULE_SCOPE int	TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    Tcl_LoadHandle *loadHandle,
3733
3734
3735
3736
3737
3738
3739

3740
3741
3742
3743
3744
3745
3746
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726







+







MODULE_SCOPE Tcl_ObjCmdProc Tcl_CatchObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_CdObjCmd;
MODULE_SCOPE Tcl_Command TclInitChanCmd(Tcl_Interp *interp);
MODULE_SCOPE Tcl_ObjCmdProc TclChanCreateObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclChanPostEventObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclChanPopObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclChanPushObjCmd;
MODULE_SCOPE void	TclClockClassicInit(Tcl_Interp *interp);
MODULE_SCOPE void	TclClockInit(Tcl_Interp *interp);
MODULE_SCOPE Tcl_ObjCmdProc TclClockOldscanObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_CloseObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ConcatObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ConstObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ContinueObjCmd;
MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler(
4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4130
4131
4132
4133
4134
4135
4136


4137
4138
4139
4140
4141
4142
4143







-
-








/*
 * Error message utility functions
 */
MODULE_SCOPE int	TclCommandWordLimitError(Tcl_Interp *interp,
			    Tcl_Size count);

#endif /* TCL_MAJOR_VERSION > 8 */

/* Constants used in index value encoding routines. */
#define TCL_INDEX_END	((Tcl_Size)-2)
#define TCL_INDEX_START	((Tcl_Size)0)

/*
 *----------------------------------------------------------------------
 *
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
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







-
+



-
+




-
+
+




-
+







 *
 * Note that the optimiser should resolve the case (interp==NULL) at compile
 * time.
 */

#  define ALLOC_NOBJHIGH 1200

#  define TclAllocObjStorageEx(interp, objPtr)				\
#  define TclAllocObjStorageEx(interp, objPtr) \
    do {								\
	AllocCache *cachePtr;						\
	if (((interp) == NULL) ||					\
		((cachePtr = ((Interp *)(interp))->allocCache),		\
		((cachePtr = ((Interp *) (interp))->allocCache),	\
			(cachePtr->numObjects == 0))) {			\
	    (objPtr) = TclThreadAllocObj();				\
	} else {							\
	    (objPtr) = cachePtr->firstObjPtr;				\
	    cachePtr->firstObjPtr = (Tcl_Obj *)(objPtr)->internalRep.twoPtrValue.ptr1; \
	    cachePtr->firstObjPtr = (Tcl_Obj *)				\
		    (objPtr)->internalRep.twoPtrValue.ptr1;		\
	    --cachePtr->numObjects;					\
	}								\
    } while (0)

#  define TclFreeObjStorageEx(interp, objPtr)				\
#  define TclFreeObjStorageEx(interp, objPtr) \
    do {								\
	AllocCache *cachePtr;						\
	if (((interp) == NULL) ||					\
		((cachePtr = ((Interp *)(interp))->allocCache),		\
			((cachePtr->numObjects == 0) ||			\
			(cachePtr->numObjects >= ALLOC_NOBJHIGH)))) {	\
	    TclThreadFreeObj(objPtr);					\
4389
4390
4391
4392
4393
4394
4395
4396

4397
4398
4399
4400
4401
4402
4403
4368
4369
4370
4371
4372
4373
4374

4375
4376
4377
4378
4379
4380
4381
4382







-
+







#endif

#else /* TCL_MEM_DEBUG */
MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
			    int line);

# define TclDbNewObj(objPtr, file, line) \
    do { \
    do {								\
	TclIncrObjsAllocated();						\
	(objPtr) = (Tcl_Obj *)						\
		Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line));		\
	TclDbInitNewObj((objPtr), (file), (line));			\
	TCL_DTRACE_OBJ_CREATE(objPtr);					\
    } while (0)

4433
4434
4435
4436
4437
4438
4439
4440

4441
4442
4443
4444
4445


4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456


4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475

4476
4477
4478
4479
4480
4481
4482
4412
4413
4414
4415
4416
4417
4418

4419
4420
4421
4422
4423

4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435

4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455

4456
4457
4458
4459
4460
4461
4462
4463







-
+




-
+
+










-
+
+


















-
+







 *
 *----------------------------------------------------------------
 */

#define TclInitEmptyStringRep(objPtr) \
    ((objPtr)->length = (((objPtr)->bytes = &tclEmptyString), 0))

#define TclInitStringRep(objPtr, bytePtr, len) \
#define TclInitStringRep(objPtr, bytePtr, len)				\
    if ((len) == 0) {							\
	TclInitEmptyStringRep(objPtr);					\
    } else {								\
	(objPtr)->bytes = (char *)Tcl_Alloc((len) + 1U);		\
	memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)); \
	memcpy((objPtr)->bytes, (bytePtr)				\
	    ? (bytePtr) : &tclEmptyString, (len));			\
	(objPtr)->bytes[len] = '\0';					\
	(objPtr)->length = (len);					\
    }

#define TclAttemptInitStringRep(objPtr, bytePtr, len) \
    ((((len) == 0) ? (							\
	TclInitEmptyStringRep(objPtr)					\
    ) : (								\
	(objPtr)->bytes = (char *)Tcl_AttemptAlloc((len) + 1U),		\
	(objPtr)->length = ((objPtr)->bytes) ?				\
		(memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)), \
		(memcpy((objPtr)->bytes, (bytePtr)			\
		    ? (bytePtr) : &tclEmptyString, (len)),		\
		(objPtr)->bytes[len] = '\0', (len)) : (-1)		\
    )), (objPtr)->bytes)

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to get the string representation's byte array
 * pointer from a Tcl_Obj. This is an inline version of Tcl_GetString(). The
 * macro's expression result is the string rep's byte pointer which might be
 * NULL. The bytes referenced by this pointer must not be modified by the
 * caller. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE char *	TclGetString(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

#define TclGetString(objPtr) \
    ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString(objPtr))

#define TclGetStringFromObj(objPtr, lenPtr) \
#define TclGetStringFromObj(objPtr, lenPtr)				\
    ((objPtr)->bytes							\
	    ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes)		\
	    : (Tcl_GetStringFromObj)((objPtr), (lenPtr)))

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to clean out an object's internal
4502
4503
4504
4505
4506
4507
4508
4509

4510
4511
4512
4513
4514
4515
4516
4483
4484
4485
4486
4487
4488
4489

4490
4491
4492
4493
4494
4495
4496
4497







-
+







 *
 * MODULE_SCOPE void	TclInvalidateStringRep(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

#define TclInvalidateStringRep(objPtr) \
    do {								\
	Tcl_Obj *_isobjPtr = (Tcl_Obj *)(objPtr);			\
	Tcl_Obj *_isobjPtr = (Tcl_Obj *) (objPtr);			\
	if (_isobjPtr->bytes != NULL) {					\
	    if (_isobjPtr->bytes != &tclEmptyString) {			\
		Tcl_Free((char *)_isobjPtr->bytes);			\
	    }								\
	    _isobjPtr->bytes = NULL;					\
	}								\
    } while (0)
4684
4685
4686
4687
4688
4689
4690
4691

4692
4693

4694
4695
4696
4697
4698
4699
4700
4665
4666
4667
4668
4669
4670
4671

4672
4673

4674
4675
4676
4677
4678
4679
4680
4681







-
+

-
+







 *
 * MODULE_SCOPE int	TclIsPureByteArray(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

MODULE_SCOPE int	TclIsPureByteArray(Tcl_Obj *objPtr);
#define TclIsPureDict(objPtr) \
    (((objPtr)->bytes == NULL) && TclHasInternalRep((objPtr), &tclDictType))
    (((objPtr)->bytes==NULL) && TclHasInternalRep((objPtr), tclDictTypePtr))
#define TclHasInternalRep(objPtr, type) \
    ((objPtr)->typePtr == (type))
    ((objPtr)->typePtr == (void *)(type))
#define TclFetchInternalRep(objPtr, type) \
    (TclHasInternalRep((objPtr), (type)) ? &(objPtr)->internalRep : NULL)

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to increment a namespace's export epoch
 * counter. The ANSI C "prototype" for this macro is:
4732
4733
4734
4735
4736
4737
4738
4739
4740



4741
4742
4743
4744
4745
4746
4747
4713
4714
4715
4716
4717
4718
4719


4720
4721
4722
4723
4724
4725
4726
4727
4728
4729







-
-
+
+
+







 */

MODULE_SCOPE Tcl_LibraryInitProc TclplatformtestInit;
MODULE_SCOPE Tcl_LibraryInitProc TclObjTest_Init;
MODULE_SCOPE Tcl_LibraryInitProc TclThread_Init;
MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_Init;
MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init;

MODULE_SCOPE Tcl_LibraryInitProc TcltestObjectInterfaceInit;
MODULE_SCOPE Tcl_LibraryInitProc TcltestObjectInterfaceListIntegerInit;
MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init;
/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to check whether a pattern has any characters
 * special to [string match]. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE int	TclMatchIsTrivial(const char *pattern);
 *----------------------------------------------------------------
4763
4764
4765
4766
4767
4768
4769
4770

4771
4772
4773
4774
4775
4776
4777
4778

4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789

4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803

4804
4805
4806
4807
4808
4809
4810
4811
4812
4813
4814
4815
4816
4817
4818
4819
4820
4821
4822

4823
4824
4825
4826
4827
4828


4829
4830
4831
4832
4833
4834
4835
4836
4837

4838
4839
4840
4841
4842
4843
4844
4745
4746
4747
4748
4749
4750
4751

4752
4753
4754
4755
4756
4757
4758
4759

4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770

4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784

4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803

4804
4805
4806
4807
4808


4809
4810
4811
4812
4813
4814
4815
4816
4817
4818

4819
4820
4821
4822
4823
4824
4825
4826







-
+







-
+










-
+













-
+


















-
+




-
-
+
+








-
+







 */

#define TclSetIntObj(objPtr, i) \
    do {							\
	Tcl_ObjInternalRep ir;					\
	ir.wideValue = (Tcl_WideInt) i;				\
	TclInvalidateStringRep(objPtr);				\
	Tcl_StoreInternalRep(objPtr, &tclIntType, &ir);		\
	Tcl_StoreInternalRep(objPtr, tclIntTypePtr, &ir);		\
    } while (0)

#define TclSetDoubleObj(objPtr, d) \
    do {							\
	Tcl_ObjInternalRep ir;					\
	ir.doubleValue = (double) d;				\
	TclInvalidateStringRep(objPtr);				\
	Tcl_StoreInternalRep(objPtr, &tclDoubleType, &ir);	\
	Tcl_StoreInternalRep(objPtr, tclDoubleTypePtr, &ir);	\
    } while (0)

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to create and initialise objects of standard
 * types, avoiding the corresponding function calls in time critical parts of
 * the core. The ANSI C "prototypes" for these macros are:
 *
 * MODULE_SCOPE void	TclNewIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
 * MODULE_SCOPE void	TclNewDoubleObj(Tcl_Obj *objPtr, double d);
 * MODULE_SCOPE void	TclNewStringObj(Tcl_Obj *objPtr, const char *s, Tcl_Size len);
 * MODULE_SCOPE void	TclNewStringObj(Tcl_Obj *objPtr, const char *s, * Tcl_Size len);
 * MODULE_SCOPE void	TclNewLiteralStringObj(Tcl_Obj*objPtr, const char *sLiteral);
 *
 *----------------------------------------------------------------
 */

#ifndef TCL_MEM_DEBUG
#define TclNewIntObj(objPtr, w) \
    do {								\
	TclIncrObjsAllocated();						\
	TclAllocObjStorage(objPtr);					\
	(objPtr)->refCount = 0;						\
	(objPtr)->bytes = NULL;						\
	(objPtr)->internalRep.wideValue = (Tcl_WideInt)(w);		\
	(objPtr)->typePtr = &tclIntType;				\
	(objPtr)->typePtr = tclIntTypePtr;					\
	TCL_DTRACE_OBJ_CREATE(objPtr);					\
    } while (0)

#define TclNewUIntObj(objPtr, uw) \
    do {								\
	TclIncrObjsAllocated();						\
	TclAllocObjStorage(objPtr);					\
	(objPtr)->refCount = 0;						\
	(objPtr)->bytes = NULL;						\
	Tcl_WideUInt uw_ = (uw);					\
	if (uw_ > WIDE_MAX) {						\
	    mp_int bignumValue_;					\
	    if (mp_init_u64(&bignumValue_, uw_) != MP_OKAY) {		\
		Tcl_Panic("%s: memory overflow", "TclNewUIntObj");	\
	    }								\
	    TclSetBignumInternalRep((objPtr), &bignumValue_);		\
	} else {							\
	    (objPtr)->internalRep.wideValue = (Tcl_WideInt)(uw_);	\
	    (objPtr)->typePtr = &tclIntType;				\
	    (objPtr)->typePtr = tclIntTypePtr;				\
	}								\
	TCL_DTRACE_OBJ_CREATE(objPtr);					\
    } while (0)

#define TclNewIndexObj(objPtr, w) \
    TclNewIntObj(objPtr, w)
#define TclNewIndexObj(objPtr, uw)\
    TclNewIntObj(objPtr, uw)

#define TclNewDoubleObj(objPtr, d) \
    do {								\
	TclIncrObjsAllocated();						\
	TclAllocObjStorage(objPtr);					\
	(objPtr)->refCount = 0;						\
	(objPtr)->bytes = NULL;						\
	(objPtr)->internalRep.doubleValue = (double)(d);		\
	(objPtr)->typePtr = &tclDoubleType;				\
	(objPtr)->typePtr = tclDoubleTypePtr;				\
	TCL_DTRACE_OBJ_CREATE(objPtr);					\
    } while (0)

#define TclNewStringObj(objPtr, s, len) \
    do {								\
	TclIncrObjsAllocated();						\
	TclAllocObjStorage(objPtr);					\
4912
4913
4914
4915
4916
4917
4918
4919
4920
4921
4922
4923





4924
4925
4926
4927
4928
4929
4930
4894
4895
4896
4897
4898
4899
4900





4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912







-
-
-
-
-
+
+
+
+
+








/*
 *----------------------------------------------------------------
 * Inline version of TclCleanupCommand; still need the function as it is in
 * the internal stubs, but the core can use the macro instead.
 */

#define TclCleanupCommandMacro(cmdPtr) \
    do {					\
	if ((cmdPtr)->refCount-- <= 1) {	\
	    Tcl_Free(cmdPtr);			\
	}					\
#define TclCleanupCommandMacro(cmdPtr)					\
    do {								\
	if ((cmdPtr)->refCount-- <= 1) {				\
	    Tcl_Free(cmdPtr);						\
	}								\
    } while (0)

/*
 * inside this routine crement refCount first incase cmdPtr is replacing itself
 */
#define TclRoutineAssign(location, cmdPtr) \
    do {								\
5002
5003
5004
5005
5006
5007
5008
5009

5010
5011
5012
5013
5014
5015
5016
5017
5018
5019
5020
5021
5022
5023
5024

5025
5026
5027
5028
5029
5030
5031
4984
4985
4986
4987
4988
4989
4990

4991
4992
4993
4994
4995
4996
4997
4998
4999
5000
5001
5002
5003
5004
5005

5006
5007
5008
5009
5010
5011
5012
5013







-
+














-
+







	TclIncrObjsAllocated();						\
	TclAllocObjStorageEx((interp), (_objPtr));			\
	*(void **)&(memPtr) = (void *) (_objPtr);			\
    } while (0)

#define TclSmallFreeEx(interp, memPtr) \
    do {								\
	TclFreeObjStorageEx((interp), (Tcl_Obj *)(memPtr));		\
	TclFreeObjStorageEx((interp), (Tcl_Obj *) (memPtr));		\
	TclIncrObjsFreed();						\
    } while (0)

#else    /* TCL_MEM_DEBUG */
#define TclSmallAllocEx(interp, nbytes, memPtr) \
    do {								\
	Tcl_Obj *_objPtr;						\
	TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj));			\
	TclNewObj(_objPtr);						\
	*(void **)&(memPtr) = (void *)_objPtr;				\
    } while (0)

#define TclSmallFreeEx(interp, memPtr) \
    do {								\
	Tcl_Obj *_objPtr = (Tcl_Obj *)(memPtr);				\
	Tcl_Obj *_objPtr = (Tcl_Obj *) (memPtr);			\
	_objPtr->bytes = NULL;						\
	_objPtr->typePtr = NULL;					\
	_objPtr->refCount = 1;						\
	TclDecrRefCount(_objPtr);					\
    } while (0)
#endif   /* TCL_MEM_DEBUG */

5091
5092
5093
5094
5095
5096
5097
5098

5099
5100
5101
5102
5103
5104
5105
5073
5074
5075
5076
5077
5078
5079

5080
5081
5082
5083
5084
5085
5086
5087







-
+








#if NRE_USE_SMALL_ALLOC
#define TCLNR_ALLOC(interp, ptr) \
    TclSmallAllocEx(interp, sizeof(NRE_callback), (ptr))
#define TCLNR_FREE(interp, ptr)  TclSmallFreeEx((interp), (ptr))
#else
#define TCLNR_ALLOC(interp, ptr) \
    ((ptr) = Tcl_Alloc(sizeof(NRE_callback)))
    ((ptr) = (Tcl_Alloc(sizeof(NRE_callback))))
#define TCLNR_FREE(interp, ptr)  Tcl_Free(ptr)
#endif

#if NRE_ENABLE_ASSERTS
#define NRE_ASSERT(expr) assert((expr))
#else
#define NRE_ASSERT(expr)
Changes to generic/tclIntDecls.h.
















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-







/*
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclIntDecls.h --
 *
 *	This file contains the declarations for all unsupported
 *	functions that are exported by the Tcl library.  These
 *	interfaces are not guaranteed to remain the same between
 *	versions.  Use at your own risk.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef _TCLINTDECLS
#define _TCLINTDECLS


#undef TCL_STORAGE_CLASS
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
1276
1277
1278
1279
1280
1281
1282











1283
1284
1285
1286
1287
1288
1289
1290







-
-
-
-
-
-
-
-
-
-
-









#if defined(USE_TCL_STUBS)
#undef Tcl_StaticLibrary
#define Tcl_StaticLibrary \
	(tclIntStubsPtr->tclStaticLibrary)
#endif /* defined(USE_TCL_STUBS) */

#if (TCL_MAJOR_VERSION < 9) && defined(USE_TCL_STUBS)
#undef TclpGetClicks
#define TclpGetClicks() \
		((unsigned long)tclIntStubsPtr->tclpGetClicks())
#undef TclpGetSeconds
#define TclpGetSeconds() \
		((unsigned long)tclIntStubsPtr->tclpGetSeconds())
#undef TclGetObjInterpProc2
#define TclGetObjInterpProc2 TclGetObjInterpProc
#endif

#undef TclUnusedStubEntry
#define TclObjInterpProc TclGetObjInterpProc()
#define TclObjInterpProc2 TclGetObjInterpProc2()

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TCLINTDECLS */
Changes to generic/tclIntPlatDecls.h.














1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-







/*
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * All rights reserved.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclIntPlatDecls.h --
 *
 *	This file contains the declarations for all platform dependent
 *	unsupported functions that are exported by the Tcl library.  These
 *	interfaces are not guaranteed to remain the same between
 *	versions.  Use at your own risk.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * All rights reserved.
 */

#ifndef _TCLINTPLATDECLS
#define _TCLINTPLATDECLS

#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
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
37
38
39
40
41
42
43






































































































































































































































































































































































































































































































44
45
46
47
48
49
50







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








/*
 * WARNING: This file is automatically generated by the tools/genStubs.tcl
 * script.  Any modifications to the function declarations below should be made
 * in the generic/tclInt.decls script.
 */

#if TCL_MAJOR_VERSION < 9

#ifdef __cplusplus
extern "C" {
#endif

/*
 * Exported function declarations:
 */

#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
/* 0 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 1 */
EXTERN int		TclpCloseFile(TclFile file);
/* 2 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
				TclFile writeFile, TclFile errorFile,
				int numPids, Tcl_Pid *pidPtr);
/* 3 */
EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 4 */
EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
				const char **argv, TclFile inputFile,
				TclFile outputFile, TclFile errorFile,
				Tcl_Pid *pidPtr);
/* Slot 5 is reserved */
/* 6 */
EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
/* 7 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
/* 8 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* 10 */
EXTERN Tcl_DirEntry *	TclpReaddir(TclDIR *dir);
/* Slot 11 is reserved */
/* Slot 12 is reserved */
/* Slot 13 is reserved */
/* 14 */
EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
				const Tcl_StatBuf *statBufPtr,
				int dontCopyAtts);
/* 15 */
EXTERN int		TclMacOSXGetFileAttribute(Tcl_Interp *interp,
				int objIndex, Tcl_Obj *fileName,
				Tcl_Obj **attributePtrPtr);
/* 16 */
EXTERN int		TclMacOSXSetFileAttribute(Tcl_Interp *interp,
				int objIndex, Tcl_Obj *fileName,
				Tcl_Obj *attributePtr);
/* 17 */
EXTERN int		TclMacOSXCopyFileAttributes(const char *src,
				const char *dst,
				const Tcl_StatBuf *statBufPtr);
/* 18 */
EXTERN int		TclMacOSXMatchType(Tcl_Interp *interp,
				const char *pathName, const char *fileName,
				Tcl_StatBuf *statBufPtr,
				Tcl_GlobTypeData *types);
/* 19 */
EXTERN void		TclMacOSXNotifierAddRunLoopMode(
				const void *runLoopMode);
/* Slot 20 is reserved */
/* Slot 21 is reserved */
/* Slot 22 is reserved */
/* Slot 23 is reserved */
/* Slot 24 is reserved */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* Slot 28 is reserved */
/* 29 */
EXTERN int		TclWinCPUID(int index, int *regs);
/* 30 */
EXTERN int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
				Tcl_Obj *resultingNameObj);
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* Slot 0 is reserved */
/* Slot 1 is reserved */
/* Slot 2 is reserved */
/* Slot 3 is reserved */
/* 4 */
EXTERN void *		TclWinGetTclInstance(void);
/* 5 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* Slot 6 is reserved */
/* Slot 7 is reserved */
/* 8 */
EXTERN Tcl_Size		TclpGetPid(Tcl_Pid pid);
/* Slot 9 is reserved */
/* Slot 10 is reserved */
/* 11 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 12 */
EXTERN int		TclpCloseFile(TclFile file);
/* 13 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
				TclFile writeFile, TclFile errorFile,
				int numPids, Tcl_Pid *pidPtr);
/* 14 */
EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 15 */
EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
				const char **argv, TclFile inputFile,
				TclFile outputFile, TclFile errorFile,
				Tcl_Pid *pidPtr);
/* 16 */
EXTERN int		TclpIsAtty(int fd);
/* 17 */
EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
				const Tcl_StatBuf *statBufPtr,
				int dontCopyAtts);
/* 18 */
EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
/* 19 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
/* 20 */
EXTERN void		TclWinAddProcess(void *hProcess, Tcl_Size id);
/* Slot 21 is reserved */
/* 22 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* Slot 23 is reserved */
/* 24 */
EXTERN char *		TclWinNoBackslash(char *path);
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* 27 */
EXTERN void		TclWinFlushDirtyChannels(void);
/* Slot 28 is reserved */
/* 29 */
EXTERN int		TclWinCPUID(int index, int *regs);
/* 30 */
EXTERN int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
				Tcl_Obj *resultingNameObj);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 0 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 1 */
EXTERN int		TclpCloseFile(TclFile file);
/* 2 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
				TclFile writeFile, TclFile errorFile,
				int numPids, Tcl_Pid *pidPtr);
/* 3 */
EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 4 */
EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
				const char **argv, TclFile inputFile,
				TclFile outputFile, TclFile errorFile,
				Tcl_Pid *pidPtr);
/* Slot 5 is reserved */
/* 6 */
EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
/* 7 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
/* 8 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* 10 */
EXTERN Tcl_DirEntry *	TclpReaddir(TclDIR *dir);
/* Slot 13 is reserved */
/* 14 */
EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
				const Tcl_StatBuf *statBufPtr,
				int dontCopyAtts);
/* 15 */
EXTERN int		TclMacOSXGetFileAttribute(Tcl_Interp *interp,
				int objIndex, Tcl_Obj *fileName,
				Tcl_Obj **attributePtrPtr);
/* 16 */
EXTERN int		TclMacOSXSetFileAttribute(Tcl_Interp *interp,
				int objIndex, Tcl_Obj *fileName,
				Tcl_Obj *attributePtr);
/* 17 */
EXTERN int		TclMacOSXCopyFileAttributes(const char *src,
				const char *dst,
				const Tcl_StatBuf *statBufPtr);
/* 18 */
EXTERN int		TclMacOSXMatchType(Tcl_Interp *interp,
				const char *pathName, const char *fileName,
				Tcl_StatBuf *statBufPtr,
				Tcl_GlobTypeData *types);
/* 19 */
EXTERN void		TclMacOSXNotifierAddRunLoopMode(
				const void *runLoopMode);
/* Slot 20 is reserved */
/* Slot 21 is reserved */
/* Slot 22 is reserved */
/* Slot 23 is reserved */
/* Slot 24 is reserved */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* Slot 28 is reserved */
/* 29 */
EXTERN int		TclWinCPUID(int index, int *regs);
/* 30 */
EXTERN int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
				Tcl_Obj *resultingNameObj);
#endif /* MACOSX */

typedef struct TclIntPlatStubs {
    int magic;
    void *hooks;

#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
    int (*tclpCloseFile) (TclFile file); /* 1 */
    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
    int (*tclUnixWaitForFile_) (int fd, int mask, int timeout); /* 5 */
    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
    TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
    Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
    void (*reserved11)(void);
    void (*reserved12)(void);
    void (*reserved13)(void);
    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
    int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
    int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
    int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */
    int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
    void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */
    void (*reserved20)(void);
    void (*reserved21)(void);
    TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */
    void (*reserved23)(void);
    void (*reserved24)(void);
    void (*reserved25)(void);
    void (*reserved26)(void);
    void (*reserved27)(void);
    void (*reserved28)(void);
    int (*tclWinCPUID) (int index, int *regs); /* 29 */
    int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
    void (*reserved0)(void);
    void (*reserved1)(void);
    void (*reserved2)(void);
    void (*reserved3)(void);
    void * (*tclWinGetTclInstance) (void); /* 4 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
    void (*reserved6)(void);
    void (*reserved7)(void);
    Tcl_Size (*tclpGetPid) (Tcl_Pid pid); /* 8 */
    void (*reserved9)(void);
    void *(*tclpReaddir) (void *dir); /* 10 */
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
    int (*tclpCloseFile) (TclFile file); /* 12 */
    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */
    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
    int (*tclpIsAtty) (int fd); /* 16 */
    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */
    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */
    void (*tclWinAddProcess) (void *hProcess, Tcl_Size id); /* 20 */
    void (*reserved21)(void);
    TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
    void (*reserved23)(void);
    char * (*tclWinNoBackslash) (char *path); /* 24 */
    void (*reserved25)(void);
    void (*reserved26)(void);
    void (*tclWinFlushDirtyChannels) (void); /* 27 */
    void (*reserved28)(void);
    int (*tclWinCPUID) (int index, int *regs); /* 29 */
    int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
    int (*tclpCloseFile) (TclFile file); /* 1 */
    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
    int (*tclUnixWaitForFile_) (int fd, int mask, int timeout); /* 5 */
    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
    TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
    Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
    void (*reserved11)(void);
    void (*reserved12)(void);
    void (*reserved13)(void);
    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
    int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
    int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
    int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */
    int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
    void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */
    void (*reserved20)(void);
    void (*reserved21)(void);
    TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */
    void (*reserved23)(void);
    void (*reserved24)(void);
    void (*reserved25)(void);
    void (*reserved26)(void);
    void (*reserved27)(void);
    void (*reserved28)(void);
    int (*tclWinCPUID) (int index, int *regs); /* 29 */
    int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* MACOSX */
} TclIntPlatStubs;

extern const TclIntPlatStubs *tclIntPlatStubsPtr;

#ifdef __cplusplus
}
#endif

#if defined(USE_TCL_STUBS)

/*
 * Inline function declarations:
 */

#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
#define TclGetAndDetachPids \
	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
#define TclpCloseFile \
	(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
#define TclpCreateCommandChannel \
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
#define TclpCreatePipe \
	(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
#define TclpCreateProcess \
	(tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
/* Slot 5 is reserved */
#define TclpMakeFile \
	(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
#define TclpReaddir \
	(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
/* Slot 11 is reserved */
/* Slot 12 is reserved */
/* Slot 13 is reserved */
#define TclUnixCopyFile \
	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
#define TclMacOSXGetFileAttribute \
	(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
#define TclMacOSXSetFileAttribute \
	(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
#define TclMacOSXCopyFileAttributes \
	(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */
#define TclMacOSXMatchType \
	(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
#define TclMacOSXNotifierAddRunLoopMode \
	(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
/* Slot 20 is reserved */
/* Slot 21 is reserved */
/* Slot 22 is reserved */
/* Slot 23 is reserved */
/* Slot 24 is reserved */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* Slot 28 is reserved */
#define TclWinCPUID \
	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* Slot 0 is reserved */
/* Slot 1 is reserved */
/* Slot 2 is reserved */
/* Slot 3 is reserved */
#define TclWinGetTclInstance \
	(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */
/* Slot 6 is reserved */
/* Slot 7 is reserved */
#define TclpGetPid \
	(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
/* Slot 9 is reserved */
/* Slot 10 is reserved */
#define TclGetAndDetachPids \
	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
#define TclpCloseFile \
	(tclIntPlatStubsPtr->tclpCloseFile) /* 12 */
#define TclpCreateCommandChannel \
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 13 */
#define TclpCreatePipe \
	(tclIntPlatStubsPtr->tclpCreatePipe) /* 14 */
#define TclpCreateProcess \
	(tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */
#define TclpIsAtty \
	(tclIntPlatStubsPtr->tclpIsAtty) /* 16 */
#define TclUnixCopyFile \
	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */
#define TclpMakeFile \
	(tclIntPlatStubsPtr->tclpMakeFile) /* 18 */
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 19 */
#define TclWinAddProcess \
	(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
/* Slot 21 is reserved */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
/* Slot 23 is reserved */
#define TclWinNoBackslash \
	(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
#define TclWinFlushDirtyChannels \
	(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */
/* Slot 28 is reserved */
#define TclWinCPUID \
	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
#define TclGetAndDetachPids \
	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
#define TclpCloseFile \
	(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
#define TclpCreateCommandChannel \
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
#define TclpCreatePipe \
	(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
#define TclpCreateProcess \
	(tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
/* Slot 5 is reserved */
#define TclpMakeFile \
	(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
#define TclpReaddir \
	(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
/* Slot 11 is reserved */
/* Slot 12 is reserved */
/* Slot 13 is reserved */
#define TclUnixCopyFile \
	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
#define TclMacOSXGetFileAttribute \
	(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
#define TclMacOSXSetFileAttribute \
	(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
#define TclMacOSXCopyFileAttributes \
	(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */
#define TclMacOSXMatchType \
	(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
#define TclMacOSXNotifierAddRunLoopMode \
	(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
/* Slot 20 is reserved */
/* Slot 21 is reserved */
/* Slot 22 is reserved */
/* Slot 23 is reserved */
/* Slot 24 is reserved */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* Slot 28 is reserved */
#define TclWinCPUID \
	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* MACOSX */

#endif /* defined(USE_TCL_STUBS) */

#else /* TCL_MAJOR_VERSION > 8 */
/* !BEGIN!: Do not edit below this line. */

#ifdef __cplusplus
extern "C" {
#endif

/*
684
685
686
687
688
689
690
691
692
693
694




695





696
697
698
699
700
701
702
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







-



+
+
+
+

+
+
+
+
+







	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */
#endif /* TCL_MAJOR_VERSION */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
#undef TclpLocaltime_unix
#undef TclpGmtime_unix
#undef TclWinConvertWSAError
#define TclWinConvertWSAError TclWinConvertError

#undef TclpInetNtoa
#define TclpInetNtoa inet_ntoa

#undef TclpCreateTempFile_
#undef TclUnixWaitForFile_
#ifdef MAC_OSX_TCL /* not accessible on Win32/UNIX */
MODULE_SCOPE int TclMacOSXGetFileAttribute(Tcl_Interp *interp,
	int objIndex, Tcl_Obj *fileName,
	Tcl_Obj **attributePtrPtr);
/* 16 */
MODULE_SCOPE int TclMacOSXSetFileAttribute(Tcl_Interp *interp,
	int objIndex, Tcl_Obj *fileName,
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
248
249
250
251
252
253
254




255







256
257
258
259
260
261

262
263

264
265
266
267







-
-
-
-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
-


-
+



#undef TclMacOSXSetFileAttribute /* 16 */
#undef TclMacOSXCopyFileAttributes /* 17 */
#undef TclMacOSXMatchType /* 18 */
#undef TclMacOSXNotifierAddRunLoopMode /* 19 */
#endif

#if defined(_WIN32)
#   if !defined(TCL_NO_DEPRECATED)
#	define TclWinConvertError Tcl_WinConvertError
#	define TclWinConvertWSAError Tcl_WinConvertError
#	define TclWinNToHS ntohs
#   undef TclWinNToHS
#	define TclpInetNtoa inet_ntoa
#	define TclWinGetServByName getservbyname
#	define TclWinGetSockOpt getsockopt
#	define TclWinSetSockOpt setsockopt
#	define TclWinGetPlatformId() (2) /* VER_PLATFORM_WIN32_NT */
#	define TclWinResetInterfaces() /* nop */
#	define TclWinSetInterfaces(dummy) /* nop */
#   undef TclWinGetServByName
#   undef TclWinGetSockOpt
#   undef TclWinSetSockOpt
#   undef TclWinGetPlatformId
#   undef TclWinResetInterfaces
#   undef TclWinSetInterfaces
#   endif /* TCL_NO_DEPRECATED */
#else
#   undef TclpGetPid
#   define TclpGetPid(pid) ((Tcl_Size)(pid))
#   define TclpGetPid(pid) ((size_t)(pid))
#endif

#endif /* _TCLINTPLATDECLS */
Changes to generic/tclInterp.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
















14
15
16
17
18
19
20
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

-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclInterp.c --
 *
 *	This file implements the "interp" command which allows creation and
 *	manipulation of Tcl interpreters from within Tcl scripts.
 *
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 * Copyright © 2004 Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclInterp.c --
 *
 *	This file implements the "interp" command which allows creation and
 *	manipulation of Tcl interpreters from within Tcl scripts.
 */

#include "tclInt.h"

/*
 * A pointer to a string that holds an initialization script that if non-NULL
 * is evaluated in Tcl_Init() prior to the built-in initialization script
 * above. This variable can be modified by the function below.
 */
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
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







-

-

















-

-







    static const char *const options[] = {
	"alias",	"aliases",	"bgerror",	"cancel",
	"children",	"create",	"debug",	"delete",
	"eval",		"exists",	"expose",	"hide",
	"hidden",	"issafe",	"invokehidden",
	"limit",	"marktrusted",	"recursionlimit",
	"share",
#ifndef TCL_NO_DEPRECATED
	"slaves",
#endif
	"target",	"transfer",	NULL
    };
    static const char *const optionsNoSlaves[] = {
	"alias",	"aliases",	"bgerror",	"cancel",
	"children",	"create",	"debug",	"delete",
	"eval",		"exists",	"expose",
	"hide",		"hidden",	"issafe",
	"invokehidden",	"limit",	"marktrusted",	"recursionlimit",
	"share",	"target",	"transfer",
	NULL
    };
    enum interpOptionEnum {
	OPT_ALIAS,	OPT_ALIASES,	OPT_BGERROR,	OPT_CANCEL,
	OPT_CHILDREN,	OPT_CREATE,	OPT_DEBUG,	OPT_DELETE,
	OPT_EVAL,	OPT_EXISTS,	OPT_EXPOSE,	OPT_HIDE,
	OPT_HIDDEN,	OPT_ISSAFE,	OPT_INVOKEHID,
	OPT_LIMIT,	OPT_MARKTRUSTED, OPT_RECLIMIT, OPT_SHARE,
#ifndef TCL_NO_DEPRECATED
	OPT_SLAVES,
#endif
	OPT_TARGET,	OPT_TRANSFER
    } index;
    Tcl_Size i;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
	return TCL_ERROR;
1014
1015
1016
1017
1018
1019
1020
1021

1022
1023
1024
1025
1026
1027
1028
1021
1022
1023
1024
1025
1026
1027

1028
1029
1030
1031
1032
1033
1034
1035







-
+







	}
	if (Tcl_GetIndexFromObj(interp, objv[3], limitTypes, "limit type", 0,
		&limitType) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (limitType) {
	case LIMIT_TYPE_COMMANDS:
	    return ChildCommandLimitCmd(interp, childInterp, 4, objc,objv);
	    return ChildCommandLimitCmd(interp, childInterp, 4, objc, objv);
	case LIMIT_TYPE_TIME:
	    return ChildTimeLimitCmd(interp, childInterp, 4, objc, objv);
	default:
	    Tcl_Panic("unreachable");
	    return TCL_ERROR;
	}
    }
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1049
1050
1051
1052
1053
1054
1055

1056

1057
1058
1059
1060
1061
1062
1063







-

-







	    return TCL_ERROR;
	}
	childInterp = GetInterp(interp, objv[2]);
	if (childInterp == NULL) {
	    return TCL_ERROR;
	}
	return ChildRecursionLimit(interp, childInterp, objc - 3, objv + 3);
#ifndef TCL_NO_DEPRECATED
    case OPT_SLAVES:
#endif
    case OPT_CHILDREN: {
	InterpInfo *iiPtr;
	Tcl_Obj *resultPtr;
	Tcl_HashEntry *hPtr;
	Tcl_HashSearch hashSearch;
	char *string;

2670
2671
2672
2673
2674
2675
2676
2677

2678
2679
2680
2681
2682
2683
2684
2675
2676
2677
2678
2679
2680
2681

2682
2683
2684
2685
2686
2687
2688
2689







-
+







	}
	if (Tcl_GetIndexFromObj(interp, objv[2], limitTypes, "limit type", 0,
		&limitType) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (limitType) {
	case LIMIT_TYPE_COMMANDS:
	    return ChildCommandLimitCmd(interp, childInterp, 3, objc,objv);
	    return ChildCommandLimitCmd(interp, childInterp, 3, objc, objv);
	case LIMIT_TYPE_TIME:
	    return ChildTimeLimitCmd(interp, childInterp, 3, objc, objv);
	}
    }
    break;
    case OPT_MARKTRUSTED:
	if (objc != 2) {
4543
4544
4545
4546
4547
4548
4549
4550

4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567

4568
4569
4570
4571
4572
4573
4574
4548
4549
4550
4551
4552
4553
4554

4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571

4572
4573
4574
4575
4576
4577
4578
4579







-
+
















-
+







	    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
		    &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch (index) {
	    case OPT_CMD:
		scriptObj = objv[i+1];
		(void) TclGetStringFromObj(scriptObj, &scriptLen);
		(void) Tcl_GetStringFromObj(scriptObj, &scriptLen);
		break;
	    case OPT_GRAN:
		granObj = objv[i+1];
		if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (gran < 1) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "granularity must be at least 1", -1));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", (char *)NULL);
		    return TCL_ERROR;
		}
		break;
	    case OPT_VAL:
		limitObj = objv[i+1];
		(void) TclGetStringFromObj(objv[i+1], &limitLen);
		(void) Tcl_GetStringFromObj(objv[i+1], &limitLen);
		if (limitLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &limit) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (limit < 0) {
4747
4748
4749
4750
4751
4752
4753
4754

4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771

4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789

4790
4791
4792
4793
4794
4795
4796
4752
4753
4754
4755
4756
4757
4758

4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775

4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
4792
4793

4794
4795
4796
4797
4798
4799
4800
4801







-
+
















-
+

















-
+







	    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
		    &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch (index) {
	    case OPT_CMD:
		scriptObj = objv[i+1];
		(void) TclGetStringFromObj(objv[i+1], &scriptLen);
		(void) Tcl_GetStringFromObj(objv[i+1], &scriptLen);
		break;
	    case OPT_GRAN:
		granObj = objv[i+1];
		if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (gran < 1) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "granularity must be at least 1", -1));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", (char *)NULL);
		    return TCL_ERROR;
		}
		break;
	    case OPT_MILLI:
		milliObj = objv[i+1];
		(void) TclGetStringFromObj(objv[i+1], &milliLen);
		(void) Tcl_GetStringFromObj(objv[i+1], &milliLen);
		if (milliLen == 0) {
		    break;
		}
		if (TclGetWideIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (tmp < 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "milliseconds must be non-negative", -1));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", (char *)NULL);
		    return TCL_ERROR;
		}
		limitMoment.usec = tmp*1000;
		break;
	    case OPT_SEC:
		secObj = objv[i+1];
		(void) TclGetStringFromObj(objv[i+1], &secLen);
		(void) Tcl_GetStringFromObj(objv[i+1], &secLen);
		if (secLen == 0) {
		    break;
		}
		if (TclGetWideIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (tmp < 0) {
Changes to generic/tclLink.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
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

-
-
-
-
-
-
-









+
+
+
+
+
+
+
+
+







/*
 * tclLink.c --
 *
 *	This file implements linked variables (a C variable that is tied to a
 *	Tcl variable). The idea of linked variables was first suggested by
 *	Andreas Stolcke and this implementation is based heavily on a
 *	prototype implementation provided by him.
 *
 * Copyright © 1993 The Regents of the University of California.
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 * Copyright © 2008 Rene Zaumseil
 * Copyright © 2019 Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclLink.c --
 *
 *	This file implements linked variables (a C variable that is tied to a
 *	Tcl variable). The idea of linked variables was first suggested by
 *	Andreas Stolcke and this implementation is based heavily on a
 *	prototype implementation provided by him.
 */

#include "tclInt.h"
#include "tclTomMath.h"
#include <math.h>

/*
 * For each linked variable there is a data structure of the following type,
 * which describes the link and is the clientData for the trace set on the Tcl
32
33
34
35
36
37
38
39

40
41
42
43
44
45
46
34
35
36
37
38
39
40

41
42
43
44
45
46
47
48







-
+







				 * needed during trace callbacks, since the
				 * actual variable may be aliased at that time
				 * via upvar. */
    void *addr;			/* Location of C variable. */
    Tcl_Size bytes;		/* Size of C variable array. This is 0 when
				 * single variables, and >0 used for array
				 * variables. */
    Tcl_Size numElems;	/* Number of elements in C variable array.
    Tcl_Size numElems;		/* Number of elements in C variable array.
				 * Zero for single variables. */
    int type;			/* Type of link (TCL_LINK_INT, etc.). */
    union {
	char c;
	unsigned char uc;
	int i;
	unsigned int ui;
106
107
108
109
110
111
112
113

114
115
116
117
118

119
120
121
122
123
124
125
108
109
110
111
112
113
114

115
116
117
118
119

120
121
122
123
124
125
126
127







-
+




-
+







			    Tcl_Obj *objPtr);

/*
 * A marker type used to flag weirdnesses so we can pass them around right.
 */

static const Tcl_ObjType invalidRealType = {
    "invalidReal",			/* name */
    "invalidReal",		/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    NULL,				/* updateStringProc */
    NULL,				/* setFromAnyProc */
    TCL_OBJTYPE_V1(TclLengthOne)
	0
};

/*
 * Convenience macro for accessing the value of the C variable pointed to by a
 * link. Note that this macro produces something that may be regarded as an
 * lvalue or rvalue; it may be assigned to as well as read. Also note that
 * this macro assumes the name of the variable being accessed (linkPtr); this
296
297
298
299
300
301
302
303

304
305
306
307
308
309
310
298
299
300
301
302
303
304

305
306
307
308
309
310
311
312







-
+







    case TCL_LINK_STRING:
	linkPtr->bytes = size * sizeof(char);
	size = 1;		/* This is a variable length string, no need
				 * to check last value. */

	/*
	 * If no address is given create one and use as address the
         * not needed linkPtr->lastValue
	 * not needed linkPtr->lastValue
	 */

	if (addr == NULL) {
	    linkPtr->lastValue.aryPtr = Tcl_Alloc(linkPtr->bytes);
	    linkPtr->flags |= LINK_ALLOC_LAST;
	    addr = (char *) &linkPtr->lastValue.cPtr;
	}
519
520
521
522
523
524
525
526

527
528
529
530
531
532
533
521
522
523
524
525
526
527

528
529
530
531
532
533
534
535







-
+







    Tcl_Obj *objPtr,
    double *dblPtr)
{
    if (Tcl_GetDoubleFromObj(NULL, objPtr, dblPtr) == TCL_OK) {
	return 0;
    } else {
#ifdef ACCEPT_NAN
	Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &tclDoubleType);
	Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, tclDoubleTypePtr);

	if (irPtr != NULL) {
	    *dblPtr = irPtr->doubleValue;
	    return 0;
	}
#endif /* ACCEPT_NAN */
	return GetInvalidDoubleFromObj(objPtr, dblPtr) != TCL_OK;
566
567
568
569
570
571
572
573

574
575
576
577
578
579
580
568
569
570
571
572
573
574

575
576
577
578
579
580
581
582







-
+







    TCL_UNUSED(Tcl_Interp *),
    Tcl_Obj *objPtr)
{
    const char *str;
    const char *endPtr;
    Tcl_Size length;

    str = TclGetStringFromObj(objPtr, &length);
    str = Tcl_GetStringFromObj(objPtr, &length);
    if ((length == 1) && (str[0] == '.')) {
	objPtr->typePtr = &invalidRealType;
	objPtr->internalRep.doubleValue = 0.0;
	return TCL_OK;
    }
    if (TclParseNumber(NULL, objPtr, NULL, str, length, &endPtr,
	    TCL_PARSE_DECIMAL_ONLY) == TCL_OK) {
611
612
613
614
615
616
617
618

619
620
621
622
623
624
625
613
614
615
616
617
618
619

620
621
622
623
624
625
626
627







-
+








static int
GetInvalidIntFromObj(
    Tcl_Obj *objPtr,
    int *intPtr)
{
    Tcl_Size length;
    const char *str = TclGetStringFromObj(objPtr, &length);
    const char *str = Tcl_GetStringFromObj(objPtr, &length);

    if ((length == 0) || ((length == 2) && (str[0] == '0')
	    && strchr("xXbBoOdD", str[1]))) {
	*intPtr = 0;
	return TCL_OK;
    } else if ((length == 1) && strchr("+-", str[0])) {
	*intPtr = (str[0] == '+');
676
677
678
679
680
681
682
683

684
685
686
687
688
689
690
678
679
680
681
682
683
684

685
686
687
688
689
690
691
692







-
+







 *	modification.
 *
 *----------------------------------------------------------------------
 */

static char *
LinkTraceProc(
    void *clientData,	/* Contains information about the link. */
    void *clientData,		/* Contains information about the link. */
    Tcl_Interp *interp,		/* Interpreter containing Tcl variable. */
    TCL_UNUSED(const char *) /*name1*/,
    TCL_UNUSED(const char *) /*name2*/,
				/* Links can only be made to global variables,
				 * so we can find them with need to resolve
				 * caller-supplied name in caller context. */
    int flags)			/* Miscellaneous additional information. */
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
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







-
+














-
+







-
+







     */

    if (linkPtr->flags & LINK_READ_ONLY) {
	Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		TCL_GLOBAL_ONLY);
	return (char *) "linked variable is read-only";
    }
    valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName,NULL, TCL_GLOBAL_ONLY);
    valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName, NULL, TCL_GLOBAL_ONLY);
    if (valueObj == NULL) {
	/*
	 * This shouldn't ever happen.
	 */

	return (char *) "internal error: linked variable couldn't be read";
    }

    /*
     * Special cases.
     */

    switch (linkPtr->type) {
    case TCL_LINK_STRING:
	value = TclGetStringFromObj(valueObj, &valueLength);
	value = Tcl_GetStringFromObj(valueObj, &valueLength);
	pp = (char **) linkPtr->addr;

	*pp = (char *)Tcl_Realloc(*pp, ++valueLength);
	memcpy(*pp, value, valueLength);
	return NULL;

    case TCL_LINK_CHARS:
	value = (char *) TclGetStringFromObj(valueObj, &valueLength);
	value = (char *) Tcl_GetStringFromObj(valueObj, &valueLength);
	valueLength++;		/* include end of string char */
	if (valueLength > linkPtr->bytes) {
	    return (char *) "wrong size of char* value";
	}
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, value, valueLength);
	    memcpy(linkPtr->addr, value, valueLength);
887
888
889
890
891
892
893
894

895
896
897
898
899
900
901
889
890
891
892
893
894
895

896
897
898
899
900
901
902
903







-
+







	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i = 0; i < objc; i++) {
		int *varPtr = &linkPtr->lastValue.iPtr[i];

		if (GetInt(objv[i], varPtr)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *) "variable array must have integer values";
		    return (char *) "variable array must have integer values";
		}
	    }
	} else {
	    int *varPtr = &linkPtr->lastValue.i;

	    if (GetInt(valueObj, varPtr)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
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
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







-
+


















-
+


-
+


















-
+







	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		int *varPtr = &linkPtr->lastValue.iPtr[i];

		if (Tcl_GetBooleanFromObj(NULL, objv[i], varPtr) != TCL_OK) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *) "variable array must have boolean value";
		    return (char *) "variable array must have boolean value";
		}
	    }
	} else {
	    int *varPtr = &linkPtr->lastValue.i;

	    if (Tcl_GetBooleanFromObj(NULL, valueObj, varPtr) != TCL_OK) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have boolean value";
	    }
	    LinkedVar(int) = *varPtr;
	}
	break;

    case TCL_LINK_CHAR:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetInt(objv[i], &valueInt)
		        || !InRange(SCHAR_MIN, valueInt, SCHAR_MAX)) {
			|| !InRange(SCHAR_MIN, valueInt, SCHAR_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *) "variable array must have char value";
		    return (char *) "variable array must have char value";
		}
		linkPtr->lastValue.cPtr[i] = (char) valueInt;
	    }
	} else {
	    if (GetInt(valueObj, &valueInt)
		    || !InRange(SCHAR_MIN, valueInt, SCHAR_MAX)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have char value";
	    }
	    LinkedVar(char) = linkPtr->lastValue.c = (char) valueInt;
	}
	break;

    case TCL_LINK_UCHAR:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetInt(objv[i], &valueInt)
		        || !InRange(0, valueInt, (int)UCHAR_MAX)) {
			|| !InRange(0, valueInt, (int)UCHAR_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		    return (char *)
			    "variable array must have unsigned char value";
		}
		linkPtr->lastValue.ucPtr[i] = (unsigned char) valueInt;
	    }
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
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







-
+


















-
+


-
+







    case TCL_LINK_SHORT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetInt(objv[i], &valueInt)
			|| !InRange(SHRT_MIN, valueInt, SHRT_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *) "variable array must have short value";
		    return (char *) "variable array must have short value";
		}
		linkPtr->lastValue.sPtr[i] = (short) valueInt;
	    }
	} else {
	    if (GetInt(valueObj, &valueInt)
		    || !InRange(SHRT_MIN, valueInt, SHRT_MAX)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have short value";
	    }
	    LinkedVar(short) = linkPtr->lastValue.s = (short) valueInt;
	}
	break;

    case TCL_LINK_USHORT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetInt(objv[i], &valueInt)
		        || !InRange(0, valueInt, (int)USHRT_MAX)) {
			|| !InRange(0, valueInt, (int)USHRT_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *)
		    return (char *)
			"variable array must have unsigned short value";
		}
		linkPtr->lastValue.usPtr[i] = (unsigned short) valueInt;
	    }
	} else {
	    if (GetInt(valueObj, &valueInt)
		    || !InRange(0, valueInt, (int)USHRT_MAX)) {
1069
1070
1071
1072
1073
1074
1075
1076

1077
1078
1079
1080
1081
1082
1083
1071
1072
1073
1074
1075
1076
1077

1078
1079
1080
1081
1082
1083
1084
1085







-
+







    case TCL_LINK_UINT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetWide(objv[i], &valueWide)
			|| !InRange(0, valueWide, (Tcl_WideInt)UINT_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *)
		    return (char *)
			    "variable array must have unsigned int value";
		}
		linkPtr->lastValue.uiPtr[i] = (unsigned int) valueWide;
	    }
	} else {
	    if (GetWide(valueObj, &valueWide)
		    || !InRange(0, valueWide, (Tcl_WideInt)UINT_MAX)) {
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
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







-
+



















-
+


-
+







	break;
    case TCL_LINK_WIDE_UINT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetUWide(objv[i], &valueUWide)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *)
		    return (char *)
			    "variable array must have unsigned wide int value";
		}
		linkPtr->lastValue.uwPtr[i] = valueUWide;
	    }
	} else {
	    if (GetUWide(valueObj, &valueUWide)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have unsigned wide int value";
	    }
	    LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw = valueUWide;
	}
	break;

    case TCL_LINK_FLOAT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetDouble(objv[i], &valueDouble)
			&& !InRange(FLT_MIN, fabs(valueDouble), FLT_MAX)
		        && !IsSpecial(valueDouble)) {
			&& !IsSpecial(valueDouble)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *) "variable array must have float value";
		    return (char *) "variable array must have float value";
		}
		linkPtr->lastValue.fPtr[i] = (float) valueDouble;
	    }
	} else {
	    if (GetDouble(valueObj, &valueDouble)
		    && !InRange(FLT_MIN, fabs(valueDouble), FLT_MAX)
		    && !IsSpecial(valueDouble)) {
Changes to generic/tclListObj.c.

















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-







/*
 * Copyright © 2022 Ashok P. Nadkarni.  All rights reserved.
 * Copyright © 2021 - 2024 Nathan Coulter.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclListObj.c --
 *
 *	This file contains functions that implement the Tcl list object type.
 *
 * Copyright © 2022 Ashok P. Nadkarni.  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 <assert.h>
#include "tclInt.h"
#include "tclTomMath.h"

/*
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
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







-
+






-
-
-
-
+
+
+
+


-
-
-
-
+
+
+
+




-
-
-
+
+
+




-
-
+
+









-
+
+

-
+







# ifndef NDEBUG
#  define ENABLE_LIST_ASSERTS /* Always activate list asserts in debug mode */
# endif
#endif

#ifdef ENABLE_LIST_ASSERTS

#define LIST_ASSERT(cond_) assert(cond_)
#define LIST_ASSERT(cond)	assert(cond)
/*
 * LIST_INDEX_ASSERT is to catch errors with negative indices and counts
 * being passed AFTER validation. On Tcl9 length types are unsigned hence
 * the checks against LIST_MAX. On Tcl8 length types are signed hence the
 * also checks against 0.
 */
#define LIST_INDEX_ASSERT(idxarg_)                                 \
    do {                                                           \
	Tcl_Size idx_ = (idxarg_); /* To guard against ++ etc. */ \
	LIST_ASSERT(idx_ >= 0 && idx_ < LIST_MAX);                 \
#define LIST_INDEX_ASSERT(idxarg) \
    do {								\
	Tcl_Size idx_ = (idxarg);	/* To guard against ++ etc. */	\
	LIST_ASSERT(idx_ >= 0 && idx_ < LIST_MAX);			\
    } while (0)
/* Ditto for counts except upper limit is different */
#define LIST_COUNT_ASSERT(countarg_)                                   \
    do {                                                               \
	Tcl_Size count_ = (countarg_); /* To guard against ++ etc. */ \
	LIST_ASSERT(count_ >= 0 && count_ <= LIST_MAX);                \
#define LIST_COUNT_ASSERT(countarg) \
    do {								\
	Tcl_Size count_ = (countarg);	/* To guard against ++ etc. */	\
	LIST_ASSERT(count_ >= 0 && count_ <= LIST_MAX);			\
    } while (0)

#else

#define LIST_ASSERT(cond_) ((void) 0)
#define LIST_INDEX_ASSERT(idx_) ((void) 0)
#define LIST_COUNT_ASSERT(count_) ((void) 0)
#define LIST_ASSERT(cond)	((void) 0)
#define LIST_INDEX_ASSERT(idx)	((void) 0)
#define LIST_COUNT_ASSERT(count) ((void) 0)

#endif

/* Checks for when caller should have already converted to internal list type */
#define LIST_ASSERT_TYPE(listObj_) \
    LIST_ASSERT(TclHasInternalRep((listObj_), &tclListType))
#define LIST_ASSERT_TYPE(listObj) \
    LIST_ASSERT(TclHasInternalRep((listObj), tclListTypePtr))

/*
 * If ENABLE_LIST_INVARIANTS is enabled (-DENABLE_LIST_INVARIANTS from the
 * command line), the entire list internal representation is checked for
 * inconsistencies. This has a non-trivial cost so has to be separately
 * enabled and not part of assertions checking. However, the test suite does
 * invoke ListRepValidate directly even without ENABLE_LIST_INVARIANTS.
 */
#ifdef ENABLE_LIST_INVARIANTS
#define LISTREP_CHECK(listRepPtr_) ListRepValidate(listRepPtr_, __FILE__, __LINE__)
#define LISTREP_CHECK(listRepPtr) \
    ListRepValidate(listRepPtr, __FILE__, __LINE__)
#else
#define LISTREP_CHECK(listRepPtr_) (void) 0
#define LISTREP_CHECK(listRepPtr) (void) 0
#endif

/*
 * Flags used for controlling behavior of allocation of list
 * internal representations.
 *
 * If the LISTREP_PANIC_ON_FAIL bit is set, the function will panic if
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
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







-
+










-
+
-
-
+
-


-
-
+
+
+
-
-
-
-
+





-
+

+
-
+
+
+
+
+
+
+
+
+
+
+








-
-
+
+



-
+
-
+
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
-



-
-
-
+
+
+


-
+
+

-
-
-
+
+
+




















-
-
-
-
-
+
+
+
+
+


-
-
-
-
+
+
+
+


-
-
-
-
-
-
-
+
+
+
+
+
+
+




















-
-
+
+







 */
#define LISTREP_PANIC_ON_FAIL         0x00000001
#define LISTREP_SPACE_FAVOR_FRONT     0x00000002
#define LISTREP_SPACE_FAVOR_BACK      0x00000004
#define LISTREP_SPACE_ONLY_BACK       0x00000008
#define LISTREP_SPACE_FAVOR_NONE \
    (LISTREP_SPACE_FAVOR_FRONT | LISTREP_SPACE_FAVOR_BACK)
#define LISTREP_SPACE_FLAGS                               \
#define LISTREP_SPACE_FLAGS \
    (LISTREP_SPACE_FAVOR_FRONT | LISTREP_SPACE_FAVOR_BACK \
     | LISTREP_SPACE_ONLY_BACK)

/*
 * Prototypes for non-inline static functions defined later in this file:
 */
static int	MemoryAllocationError(Tcl_Interp *, size_t size);
static int	ListLimitExceededError(Tcl_Interp *);
static ListStore *ListStoreNew(Tcl_Size objc, Tcl_Obj *const objv[], int flags);
static int	ListRepInit(Tcl_Size objc, Tcl_Obj *const objv[], int flags, ListRep *);
static int	ListRepInitAttempt(Tcl_Interp *,
static int	ListRepInitAttempt(Tcl_Interp *, Tcl_Size objc,
		    Tcl_Size objc,
		    Tcl_Obj *const objv[],
		    Tcl_Obj *const objv[], ListRep *);
		    ListRep *);
static void	ListRepClone(ListRep *fromRepPtr, ListRep *toRepPtr, int flags);
static void	ListRepUnsharedFreeUnreferenced(const ListRep *repPtr);
static int	TclListObjGetRep(Tcl_Interp *, Tcl_Obj *listPtr, ListRep *repPtr);
static void	ListRepRange(ListRep *srcRepPtr,
static int	TclListObjGetRep(Tcl_Interp *, Tcl_Obj *listPtr
		    , ListRep *repPtr);
static void	ListRepRange(ListRep *srcRepPtr, Tcl_Size fromIdx,
		    Tcl_Size rangeStart,
		    Tcl_Size rangeEnd,
		    int preserveSrcRep,
		    ListRep *rangeRepPtr);
		    Tcl_Size toIdx, int preserveSrcRep, ListRep *rangeRepPtr);
static ListStore *ListStoreReallocate(ListStore *storePtr, Tcl_Size numSlots);
static void	ListRepValidate(const ListRep *repPtr, const char *file,
		    int lineNum);
static void	DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void	FreeListInternalRep(Tcl_Obj *listPtr);
static int	SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
int		TclSetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void	UpdateStringOfList(Tcl_Obj *listPtr);
static int	ListObjAppendElement(Tcl_Interp *interp,
static Tcl_Size ListLength(Tcl_Obj *listPtr);
	  	    Tcl_Obj *listPtr, Tcl_Obj *objPtr);
static int	ListObjAppendList(Tcl_Interp *interp,
	  	    Tcl_Obj *listPtr, Tcl_Obj *elemListPtr);
static int	ListObjIndex(tclObjTypeInterfaceArgsListIndex);
static int	ListObjInterfaceGetElements(tclObjTypeInterfaceArgsListAll);
static int	ListObjInterfaceLength(tclObjTypeInterfaceArgsListLength);
static int	ListObjSetElement(tclObjTypeInterfaceArgsListSet);
static int	LsetFlat(tclObjTypeInterfaceArgsListSetDeep);
static int	ListObjRange(tclObjTypeInterfaceArgsListRange);
static int	ListObjReplace(tclObjTypeInterfaceArgsListReplace);
static int	ListObjStringIsEmpty(tclObjTypeInterfaceArgsStringIsEmpty);

/*
 * The structure below defines the list Tcl object type by means of functions
 * that can be invoked by generic object code.
 *
 * The internal representation of a list object is ListRep defined in tcl.h.
 */

const Tcl_ObjType tclListType = {
    "list",			/* name */
static ObjectType tclListObjectType = {
    "list",
    FreeListInternalRep,	/* freeIntRepProc */
    DupListInternalRep,		/* dupIntRepProc */
    UpdateStringOfList,		/* updateStringProc */
    SetListFromAny,		/* setFromAnyProc */
    TclSetListFromAny,	/* setFromAnyProc */
    TCL_OBJTYPE_V1(ListLength)
    2,
    NULL
};

Tcl_ObjType * tclListTypePtr = (Tcl_ObjType *)&tclListObjectType;


void TclListInit(void) {
    Tcl_ObjInterface *oiPtr;
    oiPtr = Tcl_NewObjInterface();
    Tcl_ObjInterfaceSetFnStringIsEmpty(oiPtr ,ListObjStringIsEmpty);
    Tcl_ObjInterfaceSetFnListAll(oiPtr ,ListObjInterfaceGetElements);
    Tcl_ObjInterfaceSetFnListAppend(oiPtr ,ListObjAppendElement);
    Tcl_ObjInterfaceSetFnListAppendList(oiPtr ,ListObjAppendList);
    Tcl_ObjInterfaceSetFnListIndex(oiPtr ,ListObjIndex);
    Tcl_ObjInterfaceSetFnListLength(oiPtr ,ListObjInterfaceLength);
    Tcl_ObjInterfaceSetFnListRange(oiPtr ,ListObjRange);
    Tcl_ObjInterfaceSetFnListReplace(oiPtr ,ListObjReplace);
    Tcl_ObjInterfaceSetFnListSet(oiPtr ,ListObjSetElement);
    Tcl_ObjInterfaceSetFnListSetDeep(oiPtr ,LsetFlat);
    Tcl_ObjTypeSetInterface(tclListTypePtr ,oiPtr);
    return;
}

/* Macros to manipulate the List internal rep */

#define ListSetIntRep(objPtr, listRepPtr)				\
    do {								\
	Tcl_ObjInternalRep ir;						\
	ir.twoPtrValue.ptr1 = (listRepPtr);				\
	ir.twoPtrValue.ptr2 = NULL;					\
	(listRepPtr)->refCount++;					\
	Tcl_StoreInternalRep((objPtr), tclListTypePtr, &ir);		\
    } while (0)

#define ListGetIntRep(objPtr, listRepPtr)				\
    do {								\
	const Tcl_ObjInternalRep *irPtr;				\
	irPtr = TclFetchInternalRep((objPtr), tclListTypePtr);		\
	(listRepPtr) = irPtr ? (List *)irPtr->twoPtrValue.ptr1 : NULL;	\
    } while (0)

#define ListResetIntRep(objPtr, listRepPtr) \
    TclFetchInternalRep((objPtr), tclListTypePtr)->twoPtrValue.ptr1 = (listRepPtr)

#ifndef TCL_MIN_ELEMENT_GROWTH
#define TCL_MIN_ELEMENT_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Obj *)
#endif

#define ListRepIncrRefs(repPtr_) \
    do {					\
	(repPtr_)->storePtr->refCount++;	\
	if ((repPtr_)->spanPtr) {		\
	    (repPtr_)->spanPtr->refCount++;	\
#define ListRepIncrRefs(repPtr)						\
    do {								\
	(repPtr)->storePtr->refCount++;					\
	if ((repPtr)->spanPtr)						\
	    (repPtr)->spanPtr->refCount++;				\
	}					\
    } while (0)

/* Returns number of free unused slots at the back of the ListRep's ListStore */
#define ListRepNumFreeTail(repPtr_) \
    ((repPtr_)->storePtr->numAllocated \
     - ((repPtr_)->storePtr->firstUsed + (repPtr_)->storePtr->numUsed))
#define ListRepNumFreeTail(repPtr) \
    ((repPtr)->storePtr->numAllocated					\
	- ((repPtr)->storePtr->firstUsed + (repPtr)->storePtr->numUsed))

/* Returns number of free unused slots at the front of the ListRep's ListStore */
#define ListRepNumFreeHead(repPtr_) ((repPtr_)->storePtr->firstUsed)
#define ListRepNumFreeHead(repPtr) \
    ((repPtr)->storePtr->firstUsed)

/* Returns a pointer to the slot corresponding to list index listIdx_ */
#define ListRepSlotPtr(repPtr_, listIdx_) \
    (&(repPtr_)->storePtr->slots[ListRepStart(repPtr_) + (listIdx_)])
/* Returns a pointer to the slot corresponding to list index listIdx */
#define ListRepSlotPtr(repPtr, listIdx) \
    (&(repPtr)->storePtr->slots[ListRepStart(repPtr) + (listIdx)])

/*
 * Macros to replace the internal representation in a Tcl_Obj. There are
 * subtle differences in each so make sure to use the right one to avoid
 * memory leaks, access to freed memory and the like.
 *
 * ListObjStompRep - assumes the Tcl_Obj internal representation can be
 * overwritten AND that the passed ListRep already has reference counts that
 * include the reference from the Tcl_Obj. Basically just copies the pointers
 * and sets the internal Tcl_Obj type to list
 *
 * ListObjOverwriteRep - like ListObjOverwriteRep but additionally
 * increments reference counts on the passed ListRep. Generally used when
 * the string representation of the Tcl_Obj is not to be modified.
 *
 * ListObjReplaceRepAndInvalidate - Like ListObjOverwriteRep but additionally
 * assumes the Tcl_Obj internal rep is valid (and possibly even same as
 * passed ListRep) and frees it first. Additionally invalidates the string
 * representation. Generally used when modifying a Tcl_Obj value.
 */
#define ListObjStompRep(objPtr_, repPtr_)                              \
    do {                                                               \
	(objPtr_)->internalRep.twoPtrValue.ptr1 = (repPtr_)->storePtr; \
	(objPtr_)->internalRep.twoPtrValue.ptr2 = (repPtr_)->spanPtr;  \
	(objPtr_)->typePtr = &tclListType;                             \
#define ListObjStompRep(objPtr, repPtr)					\
    do {								\
	(objPtr)->internalRep.twoPtrValue.ptr1 = (repPtr)->storePtr;	\
	(objPtr)->internalRep.twoPtrValue.ptr2 = (repPtr)->spanPtr;	\
	(objPtr)->typePtr = tclListTypePtr;				\
    } while (0)

#define ListObjOverwriteRep(objPtr_, repPtr_) \
    do {                                      \
	ListRepIncrRefs(repPtr_);             \
	ListObjStompRep(objPtr_, repPtr_);    \
#define ListObjOverwriteRep(objPtr, repPtr_)				\
    do {								\
	ListRepIncrRefs(repPtr_);            				\
	ListObjStompRep(objPtr, repPtr_);   				\
    } while (0)

#define ListObjReplaceRepAndInvalidate(objPtr_, repPtr_)           \
    do {                                                           \
	/* Note order important, don't use ListObjOverwriteRep! */ \
	ListRepIncrRefs(repPtr_);                                  \
	TclFreeInternalRep(objPtr_);                               \
	TclInvalidateStringRep(objPtr_);                           \
	ListObjStompRep(objPtr_, repPtr_);                         \
#define ListObjReplaceRepAndInvalidate(objPtr_, repPtr_)		\
    do {                                                           	\
	/* Note order important, don't use ListObjOverwriteRep! */ 	\
	ListRepIncrRefs(repPtr_);                                  	\
	TclFreeInternalRep(objPtr_);                               	\
	TclInvalidateStringRep(objPtr_);                           	\
	ListObjStompRep(objPtr_, repPtr_);                         	\
    } while (0)

/*
 *------------------------------------------------------------------------
 *
 * ListSpanNew --
 *
 *    Allocates and initializes memory for a new ListSpan. The reference
 *    count on the returned struct is 0.
 *
 * Results:
 *    Non-NULL pointer to the allocated ListSpan.
 *
 * Side effects:
 *    The function will panic on memory allocation failure.
 *
 *------------------------------------------------------------------------
 */
static inline ListSpan *
ListSpanNew(
    Tcl_Size firstSlot, /* Starting slot index of the span */
    Tcl_Size numSlots)  /* Number of slots covered by the span */
    Tcl_Size firstSlot,		/* Starting slot index of the span */
    Tcl_Size numSlots)		/* Number of slots covered by the span */
{
    ListSpan *spanPtr = (ListSpan *) Tcl_Alloc(sizeof(*spanPtr));
    spanPtr->refCount = 0;
    spanPtr->spanStart = firstSlot;
    spanPtr->spanLength = numSlots;
    return spanPtr;
}
294
295
296
297
298
299
300
301
302
303




304
305
306
307
308
309
310
360
361
362
363
364
365
366



367
368
369
370
371
372
373
374
375
376
377







-
-
-
+
+
+
+







 * Side effects:
 *    None.
 *
 *------------------------------------------------------------------------
 */
static inline int
ListSpanMerited(
    Tcl_Size length,                 /* Length of the proposed span */
    Tcl_Size usedStorageLength,      /* Number of slots currently in used */
    Tcl_Size allocatedStorageLength) /* Length of the currently allocation */
    Tcl_Size length,		/* Length of the proposed span. */
    Tcl_Size usedStorageLength,	/* Number of slots currently in use. */
    Tcl_Size allocatedStorageLength)
				/* Length of the current allocation. */
{
    /*
     * Possible optimizations for future consideration
     * - heuristic LIST_SPAN_THRESHOLD
     * - currently, information about the sharing (ref count) of existing
     * storage is not passed. Perhaps it should be. For example if the
     * existing storage has a "large" ref count, then it might make sense
366
367
368
369
370
371
372
373
374
375



376
377
378
379
380
381
382
433
434
435
436
437
438
439



440
441
442
443
444
445
446
447
448
449







-
-
-
+
+
+







 * Side effects:
 *    As above.
 *
 *------------------------------------------------------------------------
 */
static inline void
ObjArrayIncrRefs(
    Tcl_Obj * const *objv,  /* Pointer to the array */
    Tcl_Size startIdx,     /* Starting index of subarray within objv */
    Tcl_Size count)        /* Number of elements in the subarray */
    Tcl_Obj *const *objv,	/* Pointer to the array */
    Tcl_Size startIdx,		/* Starting index of subarray within objv */
    Tcl_Size count)		/* Number of elements in the subarray */
{
    Tcl_Obj *const *end;
    LIST_INDEX_ASSERT(startIdx);
    LIST_COUNT_ASSERT(count);
    objv += startIdx;
    end = objv + count;
    while (objv < end) {
398
399
400
401
402
403
404
405
406
407



408
409
410
411
412
413
414
465
466
467
468
469
470
471



472
473
474
475
476
477
478
479
480
481







-
-
-
+
+
+







 * Side effects:
 *    As above.
 *
 *------------------------------------------------------------------------
 */
static inline void
ObjArrayDecrRefs(
    Tcl_Obj * const *objv, /* Pointer to the array */
    Tcl_Size startIdx,    /* Starting index of subarray within objv */
    Tcl_Size count)       /* Number of elements in the subarray */
    Tcl_Obj *const *objv,	/* Pointer to the array */
    Tcl_Size startIdx,		/* Starting index of subarray within objv */
    Tcl_Size count)		/* Number of elements in the subarray */
{
    Tcl_Obj * const *end;
    LIST_INDEX_ASSERT(startIdx);
    LIST_COUNT_ASSERT(count);
    objv += startIdx;
    end = objv + count;
    while (objv < end) {
430
431
432
433
434
435
436
437
438
439



440
441
442
443
444
445
446
497
498
499
500
501
502
503



504
505
506
507
508
509
510
511
512
513







-
-
-
+
+
+







 * Side effects:
 *    Reference counts on copied Tcl_Obj's are incremented.
 *
 *------------------------------------------------------------------------
 */
static inline void
ObjArrayCopy(
    Tcl_Obj **to,          /* Destination */
    Tcl_Size count,       /* Number of pointers to copy */
    Tcl_Obj *const from[]) /* Source array of Tcl_Obj* */
    Tcl_Obj **to,		/* Destination */
    Tcl_Size count,		/* Number of pointers to copy */
    Tcl_Obj *const from[])	/* Source array of Tcl_Obj* */
{
    Tcl_Obj **end;
    LIST_COUNT_ASSERT(count);
    end = to + count;
    /* TODO - would memmove followed by separate IncrRef loop be faster? */
    while (to < end) {
	Tcl_IncrRefCount(*from);
461
462
463
464
465
466
467
468
469


470
471
472
473
474
475
476
528
529
530
531
532
533
534


535
536
537
538
539
540
541
542
543







-
-
+
+







 * Side effects:
 *    Error message and code are stored in the interpreter if not NULL.
 *
 *------------------------------------------------------------------------
 */
static int
MemoryAllocationError(
    Tcl_Interp *interp, /* Interpreter for error message. May be NULL */
    size_t size)        /* Size of attempted allocation that failed */
    Tcl_Interp *interp,		/* Interpreter for error message. May be NULL */
    size_t size)		/* Size of attempted allocation that failed */
{
    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"list construction failed: unable to alloc %" TCL_Z_MODIFIER
		"u bytes",
		size));
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL);
636
637
638
639
640
641
642
643
644
645
646
647
648






649
650
651
652
653
654
655
703
704
705
706
707
708
709






710
711
712
713
714
715
716
717
718
719
720
721
722







-
-
-
-
-
-
+
+
+
+
+
+







    int lineNum)
{
    ListStore *storePtr = repPtr->storePtr;
    const char *condition;

    (void)storePtr; /* To stop gcc from whining about unused vars */

#define INVARIANT(cond_)        \
    do {                        \
	if (!(cond_)) {         \
	    condition = #cond_; \
	    goto failure;       \
	}                       \
#define INVARIANT(cond) \
    do {								\
	if (!(cond)) {							\
	    condition = #cond;						\
	    goto failure;						\
	}								\
    } while (0)

    /* Separate each condition so line number gives exact reason for failure */
    INVARIANT(storePtr != NULL);
    INVARIANT(storePtr->numAllocated >= 0);
    INVARIANT(storePtr->numAllocated <= LIST_MAX);
    INVARIANT(storePtr->firstUsed >= 0);
672
673
674
675
676
677
678
679
680
681

682
683
684
685
686
687
688
739
740
741
742
743
744
745



746
747
748
749
750
751
752
753







-
-
-
+








#undef INVARIANT

    return;

failure:
    Tcl_Panic("List internal failure in %s line %d. Condition: %s",
	      file,
	      lineNum,
	      condition);
	    file, lineNum, condition);
}

/*
 *------------------------------------------------------------------------
 *
 * TclListObjValidate --
 *
716
717
718
719
720
721
722
723
724
725



726
727
728
729
730



731
732
733
734
735
736
737
781
782
783
784
785
786
787



788
789
790
791
792



793
794
795
796
797
798
799
800
801
802







-
-
-
+
+
+


-
-
-
+
+
+







 * ListStoreNew --
 *
 *	Allocates a new ListStore with space for at least objc elements. objc
 *	must be > 0.  If objv!=NULL, initializes with the first objc values
 *	in that array.  If objv==NULL, initalize 0 elements, with space
 *	to add objc more.
 *
 *      Normally the function allocates the exact space requested unless
 *      the flags arguments has any LISTREP_SPACE_*
 *      bits set. See the comments for those #defines.
 *	Normally the function allocates the exact space requested unless
 *	the flags arguments has any LISTREP_SPACE_*
 *	bits set. See the comments for those #defines.
 *
 * Results:
 *      On success, a pointer to the allocated ListStore is returned.
 *      On allocation failure, panics if LISTREP_PANIC_ON_FAIL is set in
 *      flags; otherwise returns NULL.
 *	On success, a pointer to the allocated ListStore is returned.
 *	On allocation failure, panics if LISTREP_PANIC_ON_FAIL is set in
 *	flags; otherwise returns NULL.
 *
 * Side effects:
 *	The ref counts of the elements in objv are incremented on success
 *	since the returned ListStore references them.
 *
 *----------------------------------------------------------------------
 */
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
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







-
-
+
+

-
-
-
+
+
+





-
+




-
-
+
+







}

/*
 *----------------------------------------------------------------------
 *
 * ListRepInit --
 *
 *      Initializes a ListRep to hold a list internal representation
 *      with space for objc elements.
 *	Initializes a ListRep to hold a list internal representation
 *	with space for objc elements.
 *
 *      objc must be > 0. If objv!=NULL, initializes with the first objc
 *      values in that array. If objv==NULL, initalize list internal rep to
 *      have 0 elements, with space to add objc more.
 *	objc must be > 0. If objv!=NULL, initializes with the first objc
 *	values in that array. If objv==NULL, initalize list internal rep to
 *	have 0 elements, with space to add objc more.
 *
 *	Normally the function allocates the exact space requested unless
 *	the flags arguments has one of the LISTREP_SPACE_* bits set.
 *	See the comments for those #defines.
 *
 *      The reference counts of the ListStore and ListSpan (if present)
 *	The reference counts of the ListStore and ListSpan (if present)
 *	pointed to by the initialized repPtr are set to zero.
 *	Caller has to manage them as necessary.
 *
 * Results:
 *      On success, TCL_OK is returned with *listRepPtr initialized.
 *      On failure, panics if LISTREP_PANIC_ON_FAIL is set in flags; otherwise
 *	On success, TCL_OK is returned with *listRepPtr initialized.
 *	On failure, panics if LISTREP_PANIC_ON_FAIL is set in flags; otherwise
 *	returns TCL_ERROR with *listRepPtr fields set to NULL.
 *
 * Side effects:
 *	The ref counts of the elements in objv are incremented since the
 *	resulting list now refers to them.
 *
 *----------------------------------------------------------------------
912
913
914
915
916
917
918
919

920
921
922
923
924

925
926
927
928
929
930
931
977
978
979
980
981
982
983

984
985
986
987
988

989
990
991
992
993
994
995
996







-
+




-
+







 * ListRepInitAttempt --
 *
 *	Creates a list internal rep with space for objc elements. See
 *	ListRepInit for requirements for parameters (in particular objc must
 *	be > 0). This function only adds error messages to the interpreter if
 *	not NULL.
 *
 *      The reference counts of the ListStore and ListSpan (if present)
 *	The reference counts of the ListStore and ListSpan (if present)
 *	pointed to by the initialized repPtr are set to zero.
 *	Caller has to manage them as necessary.
 *
 * Results:
 *      On success, TCL_OK is returned with *listRepPtr initialized.
 *	On success, TCL_OK is returned with *listRepPtr initialized.
 *	On allocation failure, returnes TCL_ERROR with an error message
 *	in the interpreter if non-NULL.
 *
 * Side effects:
 *	The ref counts of the elements in objv are incremented since the
 *	resulting list now refers to them.
 *
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
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







-
+






-
+



-
+

-
+







-
+







 *	refer to a list object and the object can not be converted to one,
 *	TCL_ERROR is returned and an error message will be left in the
 *	interpreter's result if interp is not NULL.
 *
 * Side effects:
 *	The possible conversion of the object referenced by listPtr
 *	to a list object. *repPtr is initialized to the internal rep
 *      if result is TCL_OK, or set to NULL on error.
 *	if result is TCL_OK, or set to NULL on error.
 *----------------------------------------------------------------------
 */

static int
TclListObjGetRep(
    Tcl_Interp *interp, /* Used to report errors if not NULL. */
    Tcl_Obj *listObj,   /* List object for which an element array is
    Tcl_Obj *listPtr,   /* List object for which an element array is
			 * to be returned. */
    ListRep *repPtr)	/* Location to store descriptor */
{
    if (!TclHasInternalRep(listObj, &tclListType)) {
    if (!TclHasInternalRep(listPtr, tclListTypePtr)) {
	int result;
	result = SetListFromAny(interp, listObj);
	result = TclSetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    /* Init to keep gcc happy wrt uninitialized fields at call site */
	    repPtr->storePtr = NULL;
	    repPtr->spanPtr = NULL;
	    return result;
	}
    }
    ListObjGetRep(listObj, repPtr);
    ListObjGetRep(listPtr, repPtr);
    LISTREP_CHECK(repPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-













-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
+
+
+





-
-
-
-
-
-
-
+
+
+
+
+
+
+















-
-
+
+

-
-
+
+

-
+





-
+


















-
+



-
+




-
-
+
+


-
+









-
+







	ListObjReplaceRepAndInvalidate(objPtr, &listRep);
    } else {
	TclFreeInternalRep(objPtr);
	TclInvalidateStringRep(objPtr);
	Tcl_InitStringRep(objPtr, NULL, 0);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclListObjCopy --
 *
 *	Makes a "pure list" copy of a list value. This provides for the C
 *	level a counterpart of the [lrange $list 0 end] command, while using
 *	internals details to be as efficient as possible.
 *
 * Results:
 *	Normally returns a pointer to a new Tcl_Obj, that contains the same
 *	list value as *listPtr does. The returned Tcl_Obj has a refCount of
 *	zero. If *listPtr does not hold a list, NULL is returned, and if
 *	interp is non-NULL, an error message is recorded there.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclListObjCopy(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *listObj)		/* List object for which an element array is
				 * to be returned. */
{
    Tcl_Obj *copyObj;

    if (!TclHasInternalRep(listObj, &tclListType)) {
	if (TclObjTypeHasProc(listObj, lengthProc)) {
	    return Tcl_DuplicateObj(listObj);
	}
	if (SetListFromAny(interp, listObj) != TCL_OK) {
	    return NULL;
	}
    }

    TclNewObj(copyObj);
    TclInvalidateStringRep(copyObj);
    DupListInternalRep(listObj, copyObj);
    return copyObj;
}

/*
 *------------------------------------------------------------------------
 *
 * ListRepRange --
 *
 *	Initializes a ListRep as a range within the passed ListRep.
 *	The range limits are clamped to the list boundaries.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *      The ListStore and ListSpan referenced by in the returned ListRep
 *      may or may not be the same as those passed in. For example, the
 *      ListStore may differ because the range is small enough that a new
 *      ListStore is more memory-optimal. The ListSpan may differ because
 *      it is NULL or shared. Regardless, reference counts on the returned
 *      values are not incremented. Generally, ListObjReplaceRepAndInvalidate
 *      may be used to store the new ListRep back into an object or a
 *      ListRepIncrRefs followed by ListRepDecrRefs to free in case of errors.
 *	The ListStore and ListSpan referenced by in the returned ListRep
 *	may or may not be the same as those passed in. For example, the
 *	ListStore may differ because the range is small enough that a new
 *	ListStore is more memory-optimal. The ListSpan may differ because
 *	it is NULL or shared. Regardless, reference counts on the returned
 *	values are not incremented. Generally, ListObjReplaceRepAndInvalidate
 *	may be used to store the new ListRep back into an object or a
 *	ListRepIncrRefs followed by ListRepDecrRefs to free in case of errors.
 *	Any other use should be carefully reconsidered.
 *      TODO WARNING:- this is an awkward interface and easy for caller
 *      to get wrong. Mostly due to refcount combinations. Perhaps passing
 *      in the source listObj instead of source listRep might simplify.
 *	TODO WARNING:- this is an awkward interface and easy for caller
 *	to get wrong. Mostly due to refcount combinations. Perhaps passing
 *	in the source listObj instead of source listRep might simplify.
 *
 *------------------------------------------------------------------------
 */
static void
ListRepRange(
    ListRep *srcRepPtr,		/* Contains source of the range */
    Tcl_Size rangeStart,	/* Index of first element to include */
    Tcl_Size rangeEnd,		/* Index of last element to include */
    int preserveSrcRep,		/* If true, srcRepPtr contents must not be
				 * modified (generally because a shared Tcl_Obj
				 * references it) */
    ListRep *rangeRepPtr)	/* Output. Must NOT be == srcRepPtr */
    ListRep *srcRepPtr,	    /* Contains source of the range */
    Tcl_Size fromIdx,	    /* Index of first element to include */
    Tcl_Size toIdx,	    /* Index of last element to include */
    int preserveSrcRep,	    /* If true, srcRepPtr contents must not be
			     * modified (generally because a shared Tcl_Obj
			     * references it) */
    ListRep *rangeRepPtr)   /* Output. Must NOT be == srcRepPtr */
{
    Tcl_Obj **srcElems;
    Tcl_Size numSrcElems = ListRepLength(srcRepPtr);
    Tcl_Size rangeLen;
    Tcl_Size numAfterRangeEnd;

    LISTREP_CHECK(srcRepPtr);

    /* Take the opportunity to garbage collect */
    /* TODO - we probably do not need the preserveSrcRep here unlike later */
    if (!preserveSrcRep) {
	/* T:listrep-1.{4,5,8,9},2.{4:7},3.{15:18},4.{7,8} */
	ListRepFreeUnreferenced(srcRepPtr);
    } /* else T:listrep-2.{4.2,4.3,5.2,5.3,6.2,7.2,8.1} */

    if (rangeStart < 0) {
	rangeStart = 0;
    if (fromIdx < 0) {
	fromIdx = 0;
    }
    if (rangeEnd >= numSrcElems) {
	rangeEnd = numSrcElems - 1;
    if (toIdx >= numSrcElems) {
	toIdx = numSrcElems - 1;
    }
    if (rangeStart > rangeEnd) {
    if (fromIdx > toIdx) {
	/* Empty list of capacity 1. */
	ListRepInit(1, NULL, LISTREP_PANIC_ON_FAIL, rangeRepPtr);
	return;
    }

    rangeLen = rangeEnd - rangeStart + 1;
    rangeLen = toIdx - fromIdx + 1;

    /*
     * We can create a range one of four ways:
     *  (0) Range encapsulates entire list
     *  (1) Special case: deleting in-place from end of an unshared object
     *  (2) Use a ListSpan referencing the current ListStore
     *  (3) Creating a new ListStore
     *  (4) Removing all elements outside the range in the current ListStore
     * Option (4) may only be done if caller has not disallowed it AND
     * the ListStore is not shared.
     *
     * The choice depends on heuristics related to speed and memory.
     * TODO - heuristics below need to be measured and tuned.
     *
     * Note: Even if nothing below cause any changes, we still want the
     * string-canonizing effect of [lrange 0 end] so the Tcl_Obj should not
     * be returned as is even if the range encompasses the whole list.
     */
    if (rangeStart == 0 && rangeEnd == (numSrcElems-1)) {
    if (fromIdx == 0 && toIdx == (numSrcElems-1)) {
	/* Option 0 - entire list. This may be used to canonicalize */
	/* T:listrep-1.10.1,2.8.1 */
	*rangeRepPtr = *srcRepPtr; /* Not ref counts not incremented */
    } else if (rangeStart == 0 && (!preserveSrcRep)
    } else if (fromIdx == 0 && (!preserveSrcRep)
	    && (!ListRepIsShared(srcRepPtr) && srcRepPtr->spanPtr == NULL)) {
	/* Option 1 - Special case unshared, exclude end elements, no span  */
	LIST_ASSERT(srcRepPtr->storePtr->firstUsed == 0); /* If no span */
	ListRepElements(srcRepPtr, numSrcElems, srcElems);
	numAfterRangeEnd = numSrcElems - (rangeEnd + 1);
	/* Assert: Because numSrcElems > rangeEnd earlier */
	numAfterRangeEnd = numSrcElems - (toIdx + 1);
	/* Assert: Because numSrcElems > toIdx earlier */
	if (numAfterRangeEnd != 0) {
	    /* T:listrep-1.{8,9} */
	    ObjArrayDecrRefs(srcElems, rangeEnd + 1, numAfterRangeEnd);
	    ObjArrayDecrRefs(srcElems, toIdx + 1, numAfterRangeEnd);
	}
	/* srcRepPtr->storePtr->firstUsed,numAllocated unchanged */
	srcRepPtr->storePtr->numUsed = rangeLen;
	srcRepPtr->storePtr->flags = 0;
	rangeRepPtr->storePtr = srcRepPtr->storePtr; /* Note no incr ref */
	rangeRepPtr->spanPtr = NULL;
    } else if (ListSpanMerited(rangeLen, srcRepPtr->storePtr->numUsed,
	    srcRepPtr->storePtr->numAllocated)) {
	/* Option 2 - because span would be most efficient */
	Tcl_Size spanStart = ListRepStart(srcRepPtr) + rangeStart;
	Tcl_Size spanStart = ListRepStart(srcRepPtr) + fromIdx;
	if (!preserveSrcRep && srcRepPtr->spanPtr
		&& srcRepPtr->spanPtr->refCount <= 1) {
	    /* If span is not shared reuse it */
	    /* T:listrep-2.7.3,3.{16,18} */
	    srcRepPtr->spanPtr->spanStart = spanStart;
	    srcRepPtr->spanPtr->spanLength = rangeLen;
	    *rangeRepPtr = *srcRepPtr;
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
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







-
-
+
+



















-
+

-
+


-
-
+
+


-
+

-
+
-
-
-
+
+







	    ListRepFreeUnreferenced(rangeRepPtr);
	}
    } else if (preserveSrcRep || ListRepIsShared(srcRepPtr)) {
	/* Option 3 - span or modification in place not allowed/desired */
	/* T:listrep-2.{4,6} */
	ListRepElements(srcRepPtr, numSrcElems, srcElems);
	/* TODO - allocate extra space? */
	ListRepInit(rangeLen, &srcElems[rangeStart], LISTREP_PANIC_ON_FAIL,
		rangeRepPtr);
	ListRepInit(rangeLen, &srcElems[fromIdx], LISTREP_PANIC_ON_FAIL
	    ,rangeRepPtr);
    } else {
	/*
	 * Option 4 - modify in place. Note that because of the invariant
	 * that spanless list stores must start at 0, we have to move
	 * everything to the front.
	 * TODO - perhaps if a span already exists, no need to move to front?
	 * or maybe no need to move all the way to the front?
	 * TODO - if range is small relative to allocation, allocate new?
	 */

	/* Asserts follow from call to ListRepFreeUnreferenced earlier */
	LIST_ASSERT(!preserveSrcRep);
	LIST_ASSERT(!ListRepIsShared(srcRepPtr));
	LIST_ASSERT(ListRepStart(srcRepPtr) == srcRepPtr->storePtr->firstUsed);
	LIST_ASSERT(ListRepLength(srcRepPtr) == srcRepPtr->storePtr->numUsed);

	ListRepElements(srcRepPtr, numSrcElems, srcElems);

	/* Free leading elements outside range */
	if (rangeStart != 0) {
	if (fromIdx != 0) {
	    /* T:listrep-1.4,3.15 */
	    ObjArrayDecrRefs(srcElems, 0, rangeStart);
	    ObjArrayDecrRefs(srcElems, 0, fromIdx);
	}
	/* Ditto for trailing */
	numAfterRangeEnd = numSrcElems - (rangeEnd + 1);
	/* Assert: Because numSrcElems > rangeEnd earlier */
	numAfterRangeEnd = numSrcElems - (toIdx + 1);
	/* Assert: Because numSrcElems > toIdx earlier */
	if (numAfterRangeEnd != 0) {
	    /* T:listrep-3.17 */
	    ObjArrayDecrRefs(srcElems, rangeEnd + 1, numAfterRangeEnd);
	    ObjArrayDecrRefs(srcElems, toIdx + 1, numAfterRangeEnd);
	}
	memmove(&srcRepPtr->storePtr->slots[0],
	memmove(&srcRepPtr->storePtr->slots[0], &srcRepPtr->storePtr
		&srcRepPtr->storePtr
		     ->slots[srcRepPtr->storePtr->firstUsed + rangeStart],
		rangeLen * sizeof(Tcl_Obj *));
	    ->slots[srcRepPtr->storePtr->firstUsed + fromIdx]
	    , rangeLen * sizeof(Tcl_Obj *));
	srcRepPtr->storePtr->firstUsed = 0;
	srcRepPtr->storePtr->numUsed = rangeLen;
	srcRepPtr->storePtr->flags = 0;
	if (srcRepPtr->spanPtr) {
	    /* In case the source has a span, update it for consistency */
	    /* T:listrep-3.{15,17} */
	    srcRepPtr->spanPtr->spanStart = srcRepPtr->storePtr->firstUsed;
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
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







-
+



-
+









+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-
-
-
+
+
+
+


-
+

-
+



-
+

-
-
+
+
+









-
+








/*
 *----------------------------------------------------------------------
 *
 * TclListObjRange --
 *
 *	Makes a slice of a list value.
 *      *listObj must be known to be a valid list.
 *	*listObj must be known to be a valid list.
 *
 * Results:
 *	Returns a pointer to the sliced list.
 *      This may be a new object or the same object if not shared.
 *	This may be a new object or the same object if not shared.
 *	Returns NULL if passed listObj was not a list and could not be
 *	converted to one.
 *
 * Side effects:
 *	The possible conversion of the object referenced by listPtr
 *	to a list object.
 *
 *----------------------------------------------------------------------
 */
int
TclListObjRange(tclObjTypeInterfaceArgsListRange)

Tcl_Obj *
TclListObjRange(
    Tcl_Interp *interp,		/* May be NULL. Used for error messages */
    Tcl_Obj *listObj,		/* List object to take a range from. */
    Tcl_Size rangeStart,	/* Index of first element to include. */
    Tcl_Size rangeEnd)		/* Index of last element to include. */
{
    int status;
    Tcl_Size length;
    status = TclListObjLength(interp, listPtr, &length);
    if (status != TCL_OK) {
	return status;
    }
    if (fromIdx == TCL_INDEX_NONE) {
	fromIdx = 0;
    }
    if (Tcl_LengthIsFinite(length) && toIdx + 1 >= length + 1) {
	toIdx = length-1;
    }

    if (fromIdx + 1 > toIdx + 1) {
	Tcl_Obj *obj;
	TclNewObj(obj);
	*resPtrPtr = obj;
	return TCL_OK;
    }
    return TclObjectDispatch(listPtr, ListObjRange, list,
	range, interp, listPtr, fromIdx, toIdx, resPtrPtr);
}


int
ListObjRange(tclObjTypeInterfaceArgsListRange)
{
    ListRep listRep;
    ListRep resultRep;

    int isShared;
    if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) {
	return NULL;
    int isShared, status;
    status = TclListObjGetRep(interp, listPtr, &listRep);
    if (status != TCL_OK) {
	return status;
    }

    isShared = Tcl_IsShared(listObj);
    isShared = Tcl_IsShared(listPtr);

    ListRepRange(&listRep, rangeStart, rangeEnd, isShared, &resultRep);
    ListRepRange(&listRep, fromIdx, toIdx, isShared, &resultRep);

    if (isShared) {
	/* T:listrep-1.10.1,2.{4.2,4.3,5.2,5.3,6.2,7.2,8.1} */
	TclNewObj(listObj);
	TclNewObj(listPtr);
    } /* T:listrep-1.{4.3,5.1,5.2} */
    ListObjReplaceRepAndInvalidate(listObj, &resultRep);
    return listObj;
    ListObjReplaceRepAndInvalidate(listPtr, &resultRep);
    *resPtrPtr = listPtr;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclListObjGetElement --
 *
 *	Returns a single element from the array of the elements in a list
 *	object, without doing doing any bounds checking.  Caller must ensure
 *	that ObjPtr of of type 'tclListType' and that  index is valid for the
 *	that ObjPtr of of type 'tclListTypePtr' and that  index is valid for the
 *	list.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclListObjGetElement(
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
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







+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+
-
-
-
-
-
+
+
+
+
+
-
-
+
+



-
-
-
-
+

-







 *
 * Side effects:
 *	The possible conversion of the object referenced by listPtr
 *	to a list object.
 *
 *----------------------------------------------------------------------
 */
/*
 *----------------------------------------------------------------------

 *
 * Tcl_ListObjGetElements --
 *
 *	Returns an (objc,objv) array of the elements in a list
 *	object.
 *
 * Results:
 *	The return value is normally TCL_OK; in this case *objcPtr is set to
 *	the count of list elements and *objvPtr is set to a pointer to an
 *	array of (*objcPtr) pointers to each list element. If listPtr does not
 *	refer to a list object and the object can not be converted to one,
 *	TCL_ERROR is returned and an error message will be left in the
 *	interpreter's result if interp is not NULL.
 *
 *	The objects referenced by the returned array should be treated as
 *	readonly and their ref counts are _not_ incremented; the caller must
 *	do that if it holds on to a reference. Furthermore, the pointer and
 *	length returned by this function may change as soon as any function is
 *	called on the list object; be careful about retaining the pointer in a
 *	local data structure.
 *
 * Side effects:
 *	The possible conversion of the object referenced by listPtr
 *	to a list object.
 *
 *----------------------------------------------------------------------
 */
#undef Tcl_ListObjGetElements
int
Tcl_ListObjGetElements(
Tcl_ListObjGetElements(tclObjTypeInterfaceArgsListAll)
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *objPtr,		/* List object for which an element array is
				 * to be returned. */
    Tcl_Size *objcPtr,		/* Where to store the count of objects
				 * referenced by objv. */
{
    return TclObjectDispatch(listPtr, ListObjInterfaceGetElements,
	list, all, interp, listPtr, objcPtr, objvPtr);
}

    Tcl_Obj ***objvPtr)		/* Where to store the pointer to an array of
				 * pointers to the list's objects. */
int
ListObjInterfaceGetElements(tclObjTypeInterfaceArgsListAll)
{
    ListRep listRep;

    if (TclObjTypeHasProc(objPtr, getElementsProc)) {
	return TclObjTypeGetElements(interp, objPtr, objcPtr, objvPtr);
    }
    if (TclListObjGetRep(interp, objPtr, &listRep) != TCL_OK) {
    if (TclListObjGetRep(interp, listPtr, &listRep) != TCL_OK)
	return TCL_ERROR;
    }
    ListRepElements(&listRep, *objcPtr, *objvPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
+
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
+
+
+



+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
+
+

+
+
+
-
+
+
+







-
-
-
+
+
+







 *	converted, if necessary, to list objects. Also, appending the new
 *	elements may cause toObj's array of element pointers to grow.
 *	toObj's old string representation, if any, is invalidated.
 *
 *----------------------------------------------------------------------
 */
int
Tcl_ListObjAppendList(
Tcl_ListObjAppendList(tclObjTypeInterfaceArgsListAppendList)
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *toObj,		/* List object to append elements to. */
    Tcl_Obj *fromObj)		/* List obj with elements to append. */
{
    Tcl_Size objc;
{
    return TclObjectDispatch(listPtr, ListObjAppendList,
	list, appendlist, interp, listPtr, elemListPtr);
}

int
    Tcl_Obj **objv;

    if (Tcl_IsShared(toObj)) {
ListObjAppendList(tclObjTypeInterfaceArgsListAppendList)
{
    int status;
    if (Tcl_IsShared(listPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendList");
    }

    if (TclObjectHasInterface(listPtr, list, replaceList)) {
	TclObjectDispatchNoDefault(interp, status, listPtr, list,
	    replaceList, interp, listPtr, LIST_MAX, 0, elemListPtr);
	return status;
    } else {
	Tcl_Size objc;
	Tcl_ListObjLength(interp, elemListPtr, &objc);
	if (objc == 1) {
	    Tcl_Obj *itemObj;
	    status = Tcl_ListObjIndex(interp, elemListPtr, 0, &itemObj);
    if (TclListObjGetElements(interp, fromObj, &objc, &objv) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
	    if (status != TCL_OK) {
		return TCL_ERROR;
	    }
	    status = Tcl_ListObjAppendElement(interp, listPtr, itemObj);
	    return status;
	} else {
	    Tcl_Obj **objv;
	    /*
     * Insert the new elements starting after the lists's last element.
     * Delete zero existing elements.
     */
	     * Pull the elements to append from elemListPtr.
	     */

	    if (TCL_OK != TclListObjGetElements(interp, elemListPtr, &objc, &objv)) {
		return TCL_ERROR;
	    }
    return TclListObjAppendElements(interp, toObj, objc, objv);
	    return TclListObjAppendElements(interp, listPtr, objc, objv);
	}
}
}

/*
 *------------------------------------------------------------------------
 *
 * TclListObjAppendElements --
 *
 *      Appends multiple elements to a Tcl_Obj list object. If
 *      the passed Tcl_Obj is not a list object, it will be converted to one
 *      and an error raised if the conversion fails.
 *	Appends multiple elements to a Tcl_Obj list object. If
 *	the passed Tcl_Obj is not a list object, it will be converted to one
 *	and an error raised if the conversion fails.
 *
 *	The Tcl_Obj must not be shared though the internal representation
 *	may be.
 *
 * Results:
 *	On success, TCL_OK is returned with the specified elements appended.
 *	On failure, TCL_ERROR is returned with an error message in the
1909
1910
1911
1912
1913
1914
1915














1916
1917
1918
1919
1920
1921
1922
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *	in 'listObj' to grow.  Any preexisting string representation of
 *	'listPtr' is invalidated.
 *
 *----------------------------------------------------------------------
 */
int
Tcl_ListObjAppendElement(
    Tcl_Interp *interp,
    Tcl_Obj *listPtr,
    Tcl_Obj *objPtr)
{
    if (Tcl_IsShared(listPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement");
    }

    return TclObjectDispatch(listPtr, ListObjAppendElement,
	list, append, interp, listPtr, objPtr);
}

int
ListObjAppendElement(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *toObj,		/* List object to append elemObj to. */
    Tcl_Obj *elemObj)		/* Object to append to toObj's list. */
{
    /*
     * TODO - compare perf with 8.6 to see if worth optimizing single
     * element case
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
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







-
+
-
-
-
+
+
+
-
-
+
+
+
+




-
-
+
+



-
-
-
-
-
-
+
+



-
+

-
+










-
+
-
-
+













-


-
+
-
-
-

+
-
-
+
+
-
-
-
-
-
-
-
-
+
+
+
+
-
-
+
-
-
+






-
-
-
-
-
-
-
-
-







 *
 * Effect:
 *	If 'listPtr' is not already of type 'tclListType', it is converted.
 *
 *----------------------------------------------------------------------
 */
int
Tcl_ListObjIndex(
Tcl_ListObjIndex(tclObjTypeInterfaceArgsListIndex)
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *listObj,		/* List object to index into. */
    Tcl_Size index,		/* Index of element to return. */
{
    return TclObjectDispatch(listPtr, ListObjIndex,
	list, index, interp, listPtr, index, resPtrPtr);
    Tcl_Obj **objPtrPtr)	/* The resulting Tcl_Obj* is stored here. */
{
}

int
ListObjIndex(tclObjTypeInterfaceArgsListIndex) {
    Tcl_Obj **elemObjs;
    Tcl_Size numElems;

    /* Empty string => empty list. Avoid unnecessary shimmering */
    if (listObj->bytes == &tclEmptyString) {
	*objPtrPtr = NULL;
    if (listPtr->bytes == &tclEmptyString) {
	*resPtrPtr = NULL;
	return TCL_OK;
    }

    int hasAbstractList = TclObjTypeHasProc(listObj,indexProc) != 0;
    if (hasAbstractList) {
	return TclObjTypeIndex(interp, listObj, index, objPtrPtr);
    }

    if (TclListObjGetElements(interp, listObj, &numElems, &elemObjs) != TCL_OK) {
    if (TclListObjGetElements(interp, listPtr, &numElems, &elemObjs)
	!= TCL_OK) {
	return TCL_ERROR;
    }
    if ((index < 0) || (index >= numElems)) {
	*objPtrPtr = NULL;
	*resPtrPtr = NULL;
    } else {
	*objPtrPtr = elemObjs[index];
	*resPtrPtr = elemObjs[index];
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjLength --
 *
 *	This function returns the number of elements in a list object. If the
 *	Returns the number of elements in a list object. If the object is not
 *	object is not already a list object, an attempt will be made to
 *	convert it to one.
 *	already a list object, attempts to convert it to one.
 *
 * Results:
 *	The return value is normally TCL_OK; in this case *lenPtr will be set
 *	to the integer count of list elements. If listPtr does not refer to a
 *	list object and the object can not be converted to one, TCL_ERROR is
 *	returned and an error message will be left in the interpreter's result
 *	if interp is not NULL.
 *
 * Side effects:
 *	The possible conversion of the argument object to a list object.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_ListObjLength
int
Tcl_ListObjLength(
Tcl_ListObjLength(tclObjTypeInterfaceArgsListLength)
    Tcl_Interp *interp,	/* Used to report errors if not NULL. */
    Tcl_Obj *listObj,	/* List object whose #elements to return. */
    Tcl_Size *lenPtr)	/* The resulting length is stored here. */
{
    return TclObjectDispatch(listPtr, ListObjInterfaceLength,
    ListRep listRep;

	list, length, interp, listPtr, lenPtr);
}
    /* Empty string => empty list. Avoid unnecessary shimmering */
    if (listObj->bytes == &tclEmptyString) {
	*lenPtr = 0;
	return TCL_OK;
    }

    if (TclObjTypeHasProc(listObj, lengthProc)) {
	*lenPtr = TclObjTypeLength(listObj);

int
ListObjInterfaceLength(tclObjTypeInterfaceArgsListLength) {
    ListRep listRep;
	return TCL_OK;
    }


    if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) {
    if (TclListObjGetRep(interp, listPtr, &listRep) != TCL_OK) {
	return TCL_ERROR;
    }
    *lenPtr = ListRepLength(&listRep);
    return TCL_OK;
}

static Tcl_Size
ListLength(
    Tcl_Obj *listPtr)
{
    ListRep listRep;
    ListObjGetRep(listPtr, &listRep);

    return ListRepLength(&listRep);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjReplace --
 *
 *	This function replaces zero or more elements of the list referenced by
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
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







-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
















-
-
-
-
-







 *	replaced objects are decremented. listObj is converted, if necessary,
 *	to a list object. listObj's old string representation, if any, is
 *	freed.
 *
 *----------------------------------------------------------------------
 */
int
Tcl_ListObjReplace(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *listObj,		/* List object whose elements to replace. */
    Tcl_Size first,		/* Index of first element to replace. */
    Tcl_Size numToDelete,	/* Number of elements to replace. */
    Tcl_Size numToInsert,	/* Number of objects to insert. */
    Tcl_Obj *const insertObjs[])/* Tcl objects to insert */
Tcl_ListObjReplace(tclObjTypeInterfaceArgsListReplace)
{
    Tcl_Size length, status;
    if (Tcl_IsShared(listObj)) {
	Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
    }

    if (first < 0) {
	first = 0;
    }

    status = Tcl_ListObjLength(interp, listObj, &length);
    if (status != TCL_OK) {
	return status;
    }

    /* go through the process even in this case to ensure that the result is a
     * cononical list 
    *if (length == 0 && numToInsert == 0) {
    *    return TCL_OK;
    *}
    */

    if (first >= length) {
	first = length;	/* So we'll insert after last element. */
    }

    if (numToDelete < 0) {
	numToDelete = 0;
    } else if (first > INT_MAX - numToDelete /* Handle integer overflow */
	    || length < first+numToDelete) {
	numToDelete = length - first;
    }

    if (numToDelete > LIST_MAX - (length - numToDelete)) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "max length of a Tcl list (%" TCL_Z_MODIFIER
			"u elements) exceeded", LIST_MAX));
	}
	return TCL_ERROR;
    }


    return TclObjectDispatch(listObj, ListObjReplace,
	list, replace, interp, listObj, first, numToDelete, numToInsert, insertObjs);
}


int
ListObjReplace(tclObjTypeInterfaceArgsListReplace)
{
    ListRep listRep;
    Tcl_Size origListLen;
    Tcl_Size lenChange;
    Tcl_Size leadSegmentLen;
    Tcl_Size tailSegmentLen;
    Tcl_Size numFreeSlots;
    Tcl_Size leadShift;
    Tcl_Size tailShift;
    Tcl_Obj **listObjs;
    int favor;

    if (Tcl_IsShared(listObj)) {
	Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
    }

    if (TclObjTypeHasProc(listObj, replaceProc)) {
	return TclObjTypeReplace(interp, listObj, first,
		numToDelete, numToInsert, insertObjs);
    }

    if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) {
	/* Cannot be converted to a list */
	return TCL_ERROR;
    }

    /* Make limits sane */
    origListLen = ListRepLength(&listRep);
2535
2536
2537
2538
2539
2540
2541











2542
2543
2544
2545
2546
2547
2548

2549
2550
2551
2552
2553
2554
2555
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







+
+
+
+
+
+
+
+
+
+
+






-
+







	}
    }

    LISTREP_CHECK(&listRep);
    ListObjReplaceRepAndInvalidate(listObj, &listRep);
    return TCL_OK;
}


int
ListObjStringIsEmpty(tclObjTypeInterfaceArgsStringIsEmpty) {
    int status;
    if (!TclHasInternalRep(listPtr, tclListTypePtr)) {
	Tcl_Panic("%s called Tcl_Obj whose type is not tclListType", "listObjStringIsEmpty");
    }
    status = TclCheckEmptyString(interp, listPtr, res);
    return status;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLindexList --
 *
 *	This procedure handles the 'lindex' command when objc==3.
 *	Handles the 'lindex' command when objc==3.
 *
 * Results:
 *	Returns a pointer to the object extracted, or NULL if an error
 *	occurred. The returned object already includes one reference count for
 *	the pointer returned.
 *
 * Side effects:
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
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







+







-
+









-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+


+
-
-
+
+
+
+
+
+
+
+
+
+
+
+







-







    Tcl_Obj *listObj,		/* List being unpacked. */
    Tcl_Obj *argObj)		/* Index or index list. */
{
    Tcl_Size index;		/* Index into the list. */
    Tcl_Obj *indexListCopy;
    Tcl_Obj **indexObjs;
    Tcl_Size numIndexObjs;
    int status;

    /*
     * Determine whether argPtr designates a list or a single index. We have
     * to be careful about the order of the checks to avoid repeated
     * shimmering; if internal rep is already a list do not shimmer it.
     * see TIP#22 and TIP#33 for the details.
     */
    if (!TclHasInternalRep(argObj, &tclListType)
    if (!TclHasInternalRep(argObj, tclListTypePtr)
	    && TclGetIntForIndexM(NULL, argObj, TCL_SIZE_MAX - 1,
		    &index) == TCL_OK) {
	/*
	 * argPtr designates a single index.
	 */
	return TclLindexFlat(interp, listObj, 1, &argObj);
    }

    /*
     * Here we make a private copy of the index list argument to avoid any
     * shimmering issues that might invalidate the indices array below while
     * we are still using it. This is probably unnecessary. It does not appear
     * that any damaging shimmering is possible, and no test has been devised
     * to show any error when this private copy is not made. But it's cheap,
     * and it offers some future-proofing insurance in case the TclLindexFlat
     * implementation changes in some unexpected way, or some new form of
     * trace or callback permits things to happen that the current
     * implementation does not.
     * Make a private copy of the index list argument to keep the internal
     * representation of the indices array unchanged while it is in use.  This
     * is probably unnecessary. It does not appear that any damaging change to
     * the internal representation is possible, and no test has been devised to
     * show any error when this private copy is not made, But it's cheap, and
     * it offers some future-proofing insurance in case the TclLindexFlat
     * implementation changes in some unexpected way, or some new form of trace
     * or callback permits things to happen that the current implementation
     * does not.
     */

    indexListCopy = TclDuplicatePureObj(interp, argObj, tclListTypePtr);
    indexListCopy = TclListObjCopy(NULL, argObj);
    if (indexListCopy == NULL) {
    if (!indexListCopy) {
	/*
	 * The argument is neither an index nor a well-formed list.
	 * Report the error via TclLindexFlat.
	 * TODO - This is as original code. why not directly return an error?
	 */
	return TclLindexFlat(interp, listObj, 1, &argObj);
    }
    status = TclListObjGetElements(
	interp, indexListCopy, &numIndexObjs, &indexObjs);
    if (status != TCL_OK) {
	Tcl_DecrRefCount(indexListCopy);
	/*
	 * The argument is neither an index nor a well-formed list.
	 * Report the error via TclLindexFlat.
	 * TODO - This is as original code. why not directly return an error?
	 */
	return TclLindexFlat(interp, listObj, 1, &argObj);
    }
    TclListObjGetElements(interp, indexListCopy, &numIndexObjs, &indexObjs);
    listObj = TclLindexFlat(interp, listObj, numIndexObjs, indexObjs);
    Tcl_DecrRefCount(indexListCopy);
    return listObj;
}

/*
 *----------------------------------------------------------------------
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
2790
2791
2792
2793
2794
2795
2796

























2797
2798
2799
2800
2801
2802
2803







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    Tcl_Size indexCount,	/* Count of indices. */
    Tcl_Obj *const indexArray[])/* Array of pointers to Tcl objects that
				 * represent the indices in the list. */
{
    int status;
    Tcl_Size i;

    /* Handle AbstractList as special case */
    if (TclObjTypeHasProc(listObj,indexProc)) {
	Tcl_Size listLen = TclObjTypeLength(listObj);
	Tcl_Size index;
	Tcl_Obj *elemObj = listObj; /* for lindex without indices return list */
	for (i=0 ; i<indexCount && listObj ; i++) {
	    if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1,
		    &index) == TCL_OK) {
		// TODO: ???
	    }
	    if (i==0) {
		if (TclObjTypeIndex(interp, listObj, index, &elemObj) != TCL_OK) {
		    return NULL;
		}
	    } else if (index > 0) {
		// TODO: support nested lists
		Tcl_Obj *e2Obj = TclLindexFlat(interp, elemObj, 1, &indexArray[i]);
		Tcl_DecrRefCount(elemObj);
		elemObj = e2Obj;
	    }
	}
	Tcl_IncrRefCount(elemObj);
	return elemObj;
    }

    Tcl_IncrRefCount(listObj);

    for (i=0 ; i<indexCount && listObj ; i++) {
	Tcl_Size index, listLen = 0;
	Tcl_Obj **elemPtrs = NULL;

	status = Tcl_ListObjLength(interp, listObj, &listLen);
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
+
















-
+







			return NULL;
		    }
		}
		Tcl_DecrRefCount(listObj);
		TclNewObj(listObj);
		Tcl_IncrRefCount(listObj);
	    } else {
		Tcl_Obj *itemObj;
		/*
		 * Must set the internal rep again because it may have been
		 * changed by TclGetIntForIndexM. See test lindex-8.4.
		 */
		if (!TclHasInternalRep(listObj, &tclListType)) {
		    status = SetListFromAny(interp, listObj);
		    if (status != TCL_OK) {
			/* The list is not a list at all => error.  */
			Tcl_DecrRefCount(listObj);
			return NULL;
		    }
		}
		Tcl_Obj* listItem;
		if (TclIndexIsFromEnd(index)
		    && TclObjectHasInterface(listObj, list, indexEnd)
		    && Tcl_LengthIsFinite(listLen)
		    ) {

		    TclObjectDispatchNoDefault(interp, status, listObj,
			list, indexEnd, interp, listObj, index, &listItem);
		    if (status == TCL_OK) {
			Tcl_IncrRefCount(listItem);
			Tcl_DecrRefCount(listObj);
			listObj = listItem;
		    } else {
			Tcl_DecrRefCount(listObj);
			return NULL;
		    }
		} else if (TclObjectHasInterface(listObj, list, index)) {
		    TclObjectDispatchNoDefault(interp, status, listObj,
			list, index, interp, listObj, index, &listItem);
		    if (status == TCL_OK) {
			Tcl_IncrRefCount(listItem);
			Tcl_DecrRefCount(listObj);
			listObj = listItem;
		    } else {
			Tcl_DecrRefCount(listObj);
			return NULL;
		    }
		} else {
		    /*
		     * Must set the internal rep again because it may have been
		     * changed by TclGetIntForIndexM. See test lindex-8.4.
		     */
		    if (!TclHasInternalRep(listObj, tclListTypePtr)) {
			status = TclSetListFromAny(interp, listObj);
			if (status != TCL_OK) {
			    /* The list is not a list at all => error.  */
			    Tcl_DecrRefCount(listObj);
			    return NULL;
			}
		    }

		ListObjGetElements(listObj, listLen, elemPtrs);
		/* increment this reference count first before decrementing
		 * just in case they are the same Tcl_Obj
		 */
		    ListObjGetElements(listObj, listLen, elemPtrs);
		    /* increment this reference count first before decrementing
		     * just in case they are the same Tcl_Obj
		     */
		itemObj = elemPtrs[index];
		Tcl_IncrRefCount(itemObj);
		Tcl_DecrRefCount(listObj);
		/* Extract the pointer to the appropriate element. */
		listObj = itemObj;
		    Tcl_IncrRefCount(elemPtrs[index]);
		    Tcl_DecrRefCount(listObj);
		    /* Extract the pointer to the appropriate element. */
		    listObj = elemPtrs[index];
		}
	    }
	} else {
	    Tcl_DecrRefCount(listObj);
	    listObj = NULL;
	}
    }
    return listObj;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLsetList --
 *
 *	Core of the 'lset' command when objc == 4. Objv[2] may be either a
 *	scalar index or a list of indices.
 *      It also handles 'lpop' when given a NULL value.
 *	It also handles 'lpop' when given a NULL value.
 *
 * Results:
 *	Returns the new value of the list variable, or NULL if there was an
 *	error. The returned object includes one reference count for the
 *	pointer returned.
 *
 * Side effects:
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
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







-
+

-
-
+
+








-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
+
+
+
+
+
-

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
-
-
+
-
-
-
-
-
-
+








-
+


-
-
+
+
-


-
-
-
+
-
-
+
-
-
+
-
-
-

-
-
-
-
-
-
-
-
-


-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+


-
+












-
+
-
-
-
+



-
+
-
-
-
-
-
-
-
+


-
+
+
+
+
+
+







Tcl_Obj *
TclLsetList(
    Tcl_Interp *interp,		/* Tcl interpreter. */
    Tcl_Obj *listObj,		/* Pointer to the list being modified. */
    Tcl_Obj *indexArgObj,	/* Index or index-list arg to 'lset'. */
    Tcl_Obj *valueObj)		/* Value arg to 'lset' or NULL to 'lpop'. */
{
    Tcl_Size indexCount = 0;   /* Number of indices in the index list. */
    Tcl_Size indexCount = 0;	/* Number of indices in the index list. */
    Tcl_Obj **indices = NULL;	/* Vector of indices in the index list. */
    Tcl_Obj *retValueObj;	/* Pointer to the list to be returned. */
    Tcl_Size index;            /* Current index in the list - discarded. */
    Tcl_Obj *resPtr;		/* Pointer to the list to be returned. */
    Tcl_Size index;		/* Current index in the list - discarded. */
    Tcl_Obj *indexListCopy;

    /*
     * Determine whether the index arg designates a list or a single index.
     * We have to be careful about the order of the checks to avoid repeated
     * shimmering; see TIP #22 and #23 for details.
     */

    if (!TclHasInternalRep(indexArgObj, &tclListType)
	    && TclGetIntForIndexM(NULL, indexArgObj, TCL_SIZE_MAX - 1, &index)
		== TCL_OK) {
    if (!TclHasInternalRep(indexArgObj, tclListTypePtr)
	&& TclGetIntForIndexM(NULL, indexArgObj, TCL_SIZE_MAX - 1, &index)
	       == TCL_OK) {
	if (TclObjTypeHasProc(listObj, setElementProc)) {
	    indices = &indexArgObj;
	    retValueObj = TclObjTypeSetElement(
		    interp, listObj, 1, indices, valueObj);
	    if (retValueObj) {
		Tcl_IncrRefCount(retValueObj);
	    }
	} else {
	    /* indexArgPtr designates a single index. */
	    /* T:listrep-1.{2.1,12.1,15.1,19.1},2.{2.3,9.3,10.1,13.1,16.1}, 3.{4,5,6}.3 */
	/* indexArgPtr designates a single index. */
        /* T:listrep-1.{2.1,12.1,15.1,19.1},2.{2.3,9.3,10.1,13.1,16.1}, 3.{4,5,6}.3 */
	    retValueObj = TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
	}


	/* to do: have TclLsetList return a standard return value instead */
	TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj, &resPtr);
	return resPtr;
    }
    } else {

	indexListCopy = TclListObjCopy(NULL,indexArgObj);
	if (!indexListCopy) {
	    /*
	     * indexArgPtr designates something that is neither an index nor a
	     * well formed list. Report the error via TclLsetFlat.
	     */
	    retValueObj = TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
    indexListCopy = TclDuplicatePureObj(
	    interp, indexArgObj, tclListTypePtr);
    if (!indexListCopy) {
	/*
	 * indexArgPtr designates something that is neither an index nor a
	 * well formed list. Report the error via TclLsetFlat.
	 */
	TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj, &resPtr);
	} else {
	    if (TCL_OK != TclListObjGetElements(
		    interp, indexListCopy, &indexCount, &indices)) {
		Tcl_DecrRefCount(indexListCopy);
		/*
		 * indexArgPtr designates something that is neither an index nor a
		 * well formed list. Report the error via TclLsetFlat.
		 */
		retValueObj = TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
	    } else {

		/*
		 * Let TclLsetFlat perform the actual lset operation.
		 */
	return resPtr;
    }
    if (TCL_OK != TclListObjGetElements(
	interp, indexListCopy, &indexCount, &indices)) {
	Tcl_DecrRefCount(indexListCopy);
	/*
	 * indexArgPtr designates something that is neither an index nor a
	 * well formed list. Report the error via TclLsetFlat.
	 */
	TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj, &resPtr);
	return resPtr; 
    }

    /*
     * Let TclLsetFlat perform the actual lset operation.
     */

		retValueObj = TclLsetFlat(interp, listObj, indexCount, indices, valueObj);
    TclLsetFlat(interp, listObj, indexCount, indices, valueObj, &resPtr);
		if (indexListCopy) {
		    Tcl_DecrRefCount(indexListCopy);
    Tcl_DecrRefCount(indexListCopy);
		}
	    }
	}
    }
    assert (retValueObj==NULL || retValueObj->typePtr || retValueObj->bytes);
    return retValueObj;
    return resPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLsetFlat --
 *
 *	Core engine of the 'lset' command.
 *      It also handles 'lpop' when given a NULL value.
 *	It also handles 'lpop' when given a NULL value.
 *
 * Results:
 *	Returns the new value of the list variable, or NULL if an error
 *	occurred. The returned object includes one reference count for the
 *	Returns a standard Tcl value and stores a pointer to the resulting list
 *	value in the given address, or stores NULL if an error occurred. 
 *	pointer returned.
 *
 * Side effects:
 *	On entry, the reference count of the variable value does not reflect
 *	any references held on the stack. The first action of this function is
 *	to determine whether the object is shared, and to duplicate it if it
 *	If the initial value of the list was shared, and this function must
 *	is. The reference count of the duplicate is incremented. At this
 *	point, the reference count will be 1 for either case, so that the
 *	modify the value, the result is a new object having a reference count
 *	object will appear to be unshared.
 *
 *	of 0.
 *	If an error occurs, and the object has been duplicated, the reference
 *	count on the duplicate is decremented so that it is now 0: this
 *	dismisses any memory that was allocated by this function.
 *
 *	If no error occurs, the reference count of the original object is
 *	incremented if the object has not been duplicated, and nothing is done
 *	to a reference count of the duplicate. Now the reference count of an
 *	unduplicated object is 2 (the returned pointer, plus the one stored in
 *	the variable). The reference count of a duplicate object is 1,
 *	reflecting that the returned pointer is the only active reference. The
 *	caller is expected to store the returned value back in the variable
 *	and decrement its reference count. (INST_STORE_* does exactly this.)
 *
 *----------------------------------------------------------------------
 */
Tcl_Obj *
TclLsetFlat(
    Tcl_Interp *interp,		/* Tcl interpreter. */
int
TclLsetFlat(tclObjTypeInterfaceArgsListSetDeep)
{
    int status;
    Tcl_Obj *listObj,		/* Pointer to the list being modified. */
    Tcl_Size indexCount,	/* Number of index args. */
    Tcl_Obj *const indexArray[],
				/* Index args. */
    Tcl_Obj *valueObj)		/* Value arg to 'lset' or NULL to 'lpop'. */
    status = TclObjectDispatch(listObj, LsetFlat,
	list, setDeep, interp, listObj, indexCount, indexArray, valueObj, resPtrPtr);
    return status;
}


int
LsetFlat(tclObjTypeInterfaceArgsListSetDeep)
{
    Tcl_Size index, len;
    int result;
    int copied = 0, result;
    Tcl_Obj *subListObj, *retValueObj;
    Tcl_Obj *pendingInvalidates[10];
    Tcl_Obj **pendingInvalidatesPtr = pendingInvalidates;
    Tcl_Size numPendingInvalidates = 0;

    /*
     * If there are no indices, simply return the new value.  (Without
     * indices, [lset] is a synonym for [set].
     * [lpop] does not use this but protect for NULL valueObj just in case.
     */

    if (indexCount == 0) {
	if (valueObj != NULL) {
	*resPtrPtr = valueObj;
	    Tcl_IncrRefCount(valueObj);
	}
	return valueObj;
	return TCL_OK;
    }

    /*
     * If the list is shared, make a copy we can modify (copy-on-write).  We
     * If the list is shared, make a copy to modify (copy-on-write). The string
     * use Tcl_DuplicateObj() instead of TclListObjCopy() for a few reasons:
     * 1) we have not yet confirmed listObj is actually a list; 2) We make a
     * verbatim copy of any existing string rep, and when we combine that with
     * the delayed invalidation of string reps of modified Tcl_Obj's
     * implemented below, the outcome is that any error condition that causes
     * this routine to return NULL, will leave the string rep of listObj and
     * all elements to be unchanged.
     * representation and internal representation of listObj remains unchanged.
     */

    subListObj = Tcl_IsShared(listObj) ? Tcl_DuplicateObj(listObj) : listObj;
    subListObj = Tcl_IsShared(listObj)
	? TclDuplicatePureObj(interp, listObj, tclListTypePtr) : listObj;
    if (!subListObj) {
	*resPtrPtr = NULL;
	return TCL_ERROR;
    }

    /*
     * Anchor the linked list of Tcl_Obj's whose string reps must be
     * invalidated if the operation succeeds.
     */

    retValueObj = subListObj;
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
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







-
+
+






-
-
-
+
+
+
-










-
+
+
+
+
+
+
+

















+
-
+
+
+
+
+
+
+
+
+
+
+







	}
	if (index < 0 || index > elemCount
		|| (valueObj == NULL && index >= elemCount)) {
	    /* ...the index points outside the sublist. */
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"index \"%s\" out of range", TclGetString(indexArray[-1])));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE", (char *)NULL);
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE"
			, (char *)NULL);
	    }
	    result = TCL_ERROR;
	    break;
	}

	/*
	 * No error conditions.  As long as we're not yet on the last index,
	 * determine the next sublist for the next pass through the loop,
	 * and take steps to make sure it is an unshared copy, as we intend
	 * No error conditions.  If this is not the last index, determine the
	 * next sublist for the next pass through the loop, and take steps to
	 * make sure it is unshared in order to modify it.
	 * to modify it.
	 */

	if (--indexCount) {
	    parentList = subListObj;
	    if (index == elemCount) {
		TclNewObj(subListObj);
	    } else {
		subListObj = elemPtrs[index];
	    }
	    if (Tcl_IsShared(subListObj)) {
		subListObj = Tcl_DuplicateObj(subListObj);
		subListObj = TclDuplicatePureObj(
		    interp, subListObj, tclListTypePtr);
		if (!subListObj) {
		    *resPtrPtr = NULL;
		    return TCL_ERROR;
		}
		copied = 1;
	    }

	    /*
	     * Replace the original elemPtr[index] in parentList with a copy
	     * we know to be unshared.  This call will also deal with the
	     * situation where parentList shares its internalrep with other
	     * Tcl_Obj's.  Dealing with the shared internalrep case can
	     * cause subListObj to become shared again, so detect that case
	     * and make and store another copy.
	     */

	    if (index == elemCount) {
		Tcl_ListObjAppendElement(NULL, parentList, subListObj);
	    } else {
		TclListObjSetElement(NULL, parentList, index, subListObj);
	    }
	    if (Tcl_IsShared(subListObj)) {
		Tcl_Obj * newSubListObj;
		subListObj = Tcl_DuplicateObj(subListObj);
		newSubListObj = TclDuplicatePureObj(
		    interp, subListObj, tclListTypePtr);
		if (copied) {
		    Tcl_DecrRefCount(subListObj);
		}
		if (newSubListObj) {
		    subListObj = newSubListObj;
		} else {
		    *resPtrPtr = NULL;
		    return TCL_ERROR;
		}
		TclListObjSetElement(NULL, parentList, index, subListObj);
	    }

	    /*
	     * The TclListObjSetElement() calls do not spoil the string rep
	     * of parentList, and that's fine for now, since all we've done
	     * so far is replace a list element with an unshared copy.  The
3081
3082
3083
3084
3085
3086
3087

3088

3089
3090
3091
3092
3093
3094
3095
3215
3216
3217
3218
3219
3220
3221
3222

3223
3224
3225
3226
3227
3228
3229
3230







+
-
+







	 * Error return; message is already in interp. Clean up any excess
	 * memory.
	 */

	if (retValueObj != listObj) {
	    Tcl_DecrRefCount(retValueObj);
	}
	*resPtrPtr = NULL;
	return NULL;
	return result;
    }

    /*
     * Store valueObj in proper sublist and return. The -1 is to avoid a
     * compiler warning (not a problem because we checked that we have a
     * proper list - or something convertible to one - above).
     */
3103
3104
3105
3106
3107
3108
3109
3110
3111


3112
3113
3114
3115
3116
3117
3118
3238
3239
3240
3241
3242
3243
3244


3245
3246
3247
3248
3249
3250
3251
3252
3253







-
-
+
+







	/* T:listrep-1.2.1,2.{2.3,9.3},3.{4,5,6}.3 */
	Tcl_ListObjAppendElement(NULL, subListObj, valueObj);
    } else {
	/* T:listrep-1.{12.1,15.1,19.1},2.{10,13,16}.1 */
	TclListObjSetElement(NULL, subListObj, index, valueObj);
	TclInvalidateStringRep(subListObj);
    }
    Tcl_IncrRefCount(retValueObj);
    return retValueObj;
    *resPtrPtr = retValueObj;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclListObjSetElement --
 *
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
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







-
+
-
-
-
-
+
+
+
+
+
-
-
-
+
+


-
+







 *	ref count of the object at the specified index within the list,
 *	replaces with the object designated by valueObj, and increments the
 *	ref count of the replacement object.
 *
 *----------------------------------------------------------------------
 */
int
TclListObjSetElement(
TclListObjSetElement(tclObjTypeInterfaceArgsListSet)
    Tcl_Interp *interp,		/* Tcl interpreter; used for error reporting
				 * if not NULL. */
    Tcl_Obj *listObj,		/* List object in which element should be
				 * stored. */
{
    return TclObjectDispatch(listObj, ListObjSetElement,
	list, set, interp, listObj, index, valueObj);
}

    Tcl_Size index,		/* Index of element to store. */
    Tcl_Obj *valueObj)		/* Tcl object to store in the designated list
				 * element. */
int
ListObjSetElement(tclObjTypeInterfaceArgsListSet)
{
    ListRep listRep;
    Tcl_Obj **elemPtrs;         /* Pointers to elements of the list. */
    Tcl_Obj **elemPtrs;		/* Pointers to elements of the list. */
    Tcl_Size elemCount;		/* Number of elements in the list. */

    /* Ensure that the listObj parameter designates an unshared list. */

    if (Tcl_IsShared(listObj)) {
	Tcl_Panic("%s called with shared object", "TclListObjSetElement");
    }
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3331
3332
3333
3334
3335
3336
3337

3338
3339
3340
3341
3342
3343
3344







-







     */
    Tcl_IncrRefCount(valueObj);
    Tcl_DecrRefCount(elemPtrs[index]);
    elemPtrs[index] = valueObj;

    /* Internal rep may be cloned so replace */
    ListObjReplaceRepAndInvalidate(listObj, &listRep);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeListInternalRep --
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
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







-
+














-
-
+
+














+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+







    ListObjGetRep(srcObj, &listRep);
    ListObjOverwriteRep(copyObj, &listRep);
}

/*
 *----------------------------------------------------------------------
 *
 * SetListFromAny --
 * TclSetListFromAny --
 *
 *	Attempt to generate a list internal form for the Tcl object "objPtr".
 *
 * Results:
 *	The return value is TCL_OK or TCL_ERROR. If an error occurs during
 *	conversion, an error message is left in the interpreter's result
 *	unless "interp" is NULL.
 *
 * Side effects:
 *	If no error occurs, a list is stored as "objPtr"s internal
 *	representation.
 *
 *----------------------------------------------------------------------
 */
static int
SetListFromAny(
int
TclSetListFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr)		/* The object to convert. */
{
    Tcl_Obj **elemPtrs;
    ListRep listRep;

    /*
     * Dictionaries are a special case; they have a string representation such
     * that *all* valid dictionaries are valid lists. Hence we can convert
     * more directly. Only do this when there's no existing string rep; if
     * there is, it is the string rep that's authoritative (because it could
     * describe duplicate keys).
     */

    if (TclObjectHasInterface(objPtr, list, index)) {
	int status;
	Tcl_Size index, length, storeSize, offset;
	Tcl_Obj *itemPtr, **lastElemPtr;
	status = Tcl_ListObjLength(interp, objPtr, &length);
	if (status != TCL_OK) {
	    return status;
	}
	storeSize = length;
	if (ListRepInitAttempt(
		interp, length > 8 ? storeSize : 8, NULL, &listRep)
	    != TCL_OK) {
	    return TCL_ERROR;
	}
	elemPtrs = listRep.storePtr->slots;
	lastElemPtr = elemPtrs + listRep.storePtr->numAllocated - 1;
	index = 0;
	Tcl_IncrRefCount(objPtr);
	while (index < length || length < 0) {
	    TclObjectDispatchNoDefault(interp, status, objPtr, list,
		index, interp, objPtr, index, &itemPtr);
	    if (status != TCL_OK) {
		status = Tcl_ListObjLength(interp, objPtr, &length);
		if (status != TCL_OK) {
		    TclUndoRefCount(objPtr);
		    return status;
		}
		continue;
	    }
	    if (elemPtrs == lastElemPtr) {
		ListStore *newStorePtr;
		storeSize += storeSize / 2;
		offset = elemPtrs - listRep.storePtr->slots;
		newStorePtr = ListStoreReallocate(listRep.storePtr, storeSize);
		if (newStorePtr == NULL) {
		    TclUndoRefCount(objPtr);
		    return MemoryAllocationError(interp, LIST_SIZE(storeSize));
		}
		elemPtrs = newStorePtr->slots + offset;
		listRep.storePtr = newStorePtr;
		lastElemPtr = elemPtrs + listRep.storePtr->numAllocated - 1;
	    }
	    listRep.storePtr->numUsed++;
	    if (itemPtr == objPtr) {
		*elemPtrs = Tcl_DuplicateObj(itemPtr);
		TclBounceRefCount(itemPtr);
	    } else {
		*elemPtrs = itemPtr;
	    }
	    Tcl_IncrRefCount(*elemPtrs);
	    elemPtrs++;
	    index++;
	}
	TclUndoRefCount(objPtr);
    if (!TclHasStringRep(objPtr) && TclHasInternalRep(objPtr, &tclDictType)) {
    } else if (!TclHasStringRep(objPtr) && TclHasInternalRep(objPtr, tclDictTypePtr)) {
	Tcl_Obj *keyPtr, *valuePtr;
	Tcl_DictSearch search;
	int done;
	Tcl_Size size;

	/*
	 * Create the new list representation. Note that we do not need to do
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
3522
3523
3524
3525
3526
3527
3528


























3529
3530

3531
3532
3533
3534
3535
3536
3537
3538







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
+







	while (!done) {
	    *elemPtrs++ = keyPtr;
	    *elemPtrs++ = valuePtr;
	    Tcl_IncrRefCount(keyPtr);
	    Tcl_IncrRefCount(valuePtr);
	    Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
	}
    } else if (TclObjTypeHasProc(objPtr,indexProc)) {
	Tcl_Size elemCount, i;

	elemCount = TclObjTypeLength(objPtr);

	if (ListRepInitAttempt(interp, elemCount, NULL, &listRep) != TCL_OK) {
	    return TCL_ERROR;
	}

	LIST_ASSERT(listRep.spanPtr == NULL); /* Guard against future changes */
	LIST_ASSERT(listRep.storePtr->firstUsed == 0);

	elemPtrs = listRep.storePtr->slots;

	/* Each iteration, store a list element */
	for (i = 0; i < elemCount; i++) {
	    if (TclObjTypeIndex(interp, objPtr, i, elemPtrs) != TCL_OK) {
		return TCL_ERROR;
	    }
	    Tcl_IncrRefCount(*elemPtrs++);/* Since list now holds ref to it. */
	}

	LIST_ASSERT((Tcl_Size)(elemPtrs - listRep.storePtr->slots) == elemCount);

	listRep.storePtr->numUsed = elemCount;

    } else {
	Tcl_Size estCount, length;
	const char *limit, *nextElem = TclGetStringFromObj(objPtr, &length);
	const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length);

	/*
	 * Allocate enough space to hold a (Tcl_Obj *) for each
	 * (possible) list element.
	 */

	estCount = TclMaxListLength(nextElem, length, &limit);
3440
3441
3442
3443
3444
3445
3446
3447

3448
3449
3450
3451
3452
3453
3454
3602
3603
3604
3605
3606
3607
3608

3609
3610
3611
3612
3613
3614
3615
3616







-
+







     * So do NOT use ListObjReplaceRepAndInvalidate. InternalRep to be freed AFTER
     * IncrRefs so do not use ListObjOverwriteRep
     */
    ListRepIncrRefs(&listRep);
    TclFreeInternalRep(objPtr);
    objPtr->internalRep.twoPtrValue.ptr1 = listRep.storePtr;
    objPtr->internalRep.twoPtrValue.ptr2 = listRep.spanPtr;
    objPtr->typePtr = &tclListType;
    objPtr->typePtr = tclListTypePtr;

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
+















-
+







	flagPtr = localFlags;
    } else {
	/* We know numElems <= LIST_MAX, so this is safe. */
	flagPtr = (char *)Tcl_Alloc(numElems);
    }
    for (i = 0; i < numElems; i++) {
	flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
	elem = TclGetStringFromObj(elemPtrs[i], &length);
	elem = Tcl_GetStringFromObj(elemPtrs[i], &length);
	bytesNeeded += TclScanElement(elem, length, flagPtr+i);
	if (bytesNeeded > SIZE_MAX - numElems) {
	    Tcl_Panic("max size for a Tcl value (%" TCL_Z_MODIFIER "u bytes) exceeded", SIZE_MAX);
	}
    }
    bytesNeeded += numElems - 1;

    /*
     * Pass 2: copy into string rep buffer.
     */

    start = dst = Tcl_InitStringRep(listObj, NULL, bytesNeeded);
    TclOOM(dst, bytesNeeded);
    for (i = 0; i < numElems; i++) {
	flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
	elem = TclGetStringFromObj(elemPtrs[i], &length);
	elem = Tcl_GetStringFromObj(elemPtrs[i], &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
	*dst++ = ' ';
    }

    /* Set the string length to what was actually written, the safe choice */
    (void) Tcl_InitStringRep(listObj, NULL, dst - 1 - start);

Changes to generic/tclLiteral.c.

















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








-
-
-
-
-
-







/*
 * Copyright © 1997-1998 Sun Microsystems, Inc.
 * Copyright © 2004 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclLiteral.c --
 *
 *	Implementation of the global and ByteCode-local literal tables used to
 *	manage the Tcl objects created for literal values during compilation
 *	of Tcl scripts. This implementation borrows heavily from the more
 *	general hashtable implementation of Tcl hash tables that appears in
 *	tclHash.c.
 *
 * Copyright © 1997-1998 Sun Microsystems, Inc.
 * Copyright © 2004 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"
#include "tclCompile.h"

/*
 * When there are this many entries per bucket, on average, rebuild a
54
55
56
57
58
59
60
61

62
63
64
65
66
67
68
69
65
66
67
68
69
70
71

72

73
74
75
76
77
78
79







-
+
-







 *	The literal table is made ready for use.
 *
 *----------------------------------------------------------------------
 */

void
TclInitLiteralTable(
    LiteralTable *tablePtr)
    LiteralTable *tablePtr)	/* Pointer to table structure, which is
				/* Pointer to table structure, which is
				 * supplied by the caller. */
{
#if (TCL_SMALL_HASH_TABLE != 4)
    Tcl_Panic("%s: TCL_SMALL_HASH_TABLE is %d, not 4", "TclInitLiteralTable",
	    TCL_SMALL_HASH_TABLE);
#endif

172
173
174
175
176
177
178
179

180
181
182
183



184
185
186
187
188
189
190
182
183
184
185
186
187
188

189
190



191
192
193
194
195
196
197
198
199
200







-
+

-
-
-
+
+
+







 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclCreateLiteral(
    Interp *iPtr,
    const char *bytes,	/* The start of the string. Note that this is
    const char *bytes,		/* The start of the string. Note that this is
				 * not a NUL-terminated string. */
    Tcl_Size length,	/* Number of bytes in the string. */
    size_t hash, /* The string's hash. If the value is
				         * TCL_INDEX_NONE, it will be computed here. */
    Tcl_Size length,		/* Number of bytes in the string. */
    size_t hash,		/* The string's hash. If the value is
				 * TCL_INDEX_NONE, it will be computed here. */
    int *newPtr,
    Namespace *nsPtr,
    int flags,
    LiteralEntry **globalPtrPtr)
{
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    LiteralEntry *globalPtr;
207
208
209
210
211
212
213
214

215
216
217
218
219
220
221
217
218
219
220
221
222
223

224
225
226
227
228
229
230
231







-
+







	     * Literals should always have UTF-8 representations... but this
	     * is not guaranteed so we need to be careful anyway.
	     *
	     * https://stackoverflow.com/q/54337750/301832
	     */

	    Tcl_Size objLength;
	    const char *objBytes = TclGetStringFromObj(objPtr, &objLength);
	    const char *objBytes = Tcl_GetStringFromObj(objPtr, &objLength);

	    if ((objLength == length) && ((length == 0)
		    || ((objBytes[0] == bytes[0])
		    && (memcmp(objBytes, bytes, length) == 0)))) {
		/*
		 * A literal was found: return it
		 */
385
386
387
388
389
390
391
392

393
394

395
396
397

398
399
400
401
402
403
404
395
396
397
398
399
400
401

402
403

404
405
406

407
408
409
410
411
412
413
414







-
+

-
+


-
+







 *	buffer holding the result of backslash substitutions.
 *
 *----------------------------------------------------------------------
 */

int /* Do NOT change this type. Should not be wider than TclEmitPush operand*/
TclRegisterLiteral(
    void *ePtr,		/* Points to the CompileEnv in whose object
    void *ePtr,			/* Points to the CompileEnv in whose object
				 * array an object is found or created. */
    const char *bytes,	/* Points to string for which to find or
    const char *bytes,		/* Points to string for which to find or
				 * create an object in CompileEnv's object
				 * array. */
    Tcl_Size length,			/* Number of bytes in the string. If -1, the
    Tcl_Size length,		/* Number of bytes in the string. If -1, the
				 * string consists of all bytes up to the
				 * first null character. */
    int flags)			/* If LITERAL_ON_HEAP then the caller already
				 * malloc'd bytes and ownership is passed to
				 * this function. If LITERAL_CMD_NAME then
				 * the literal should not be shared across
				 * namespaces. */
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
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







-
+









-
+







 *----------------------------------------------------------------------
 */

static LiteralEntry *
LookupLiteralEntry(
    Tcl_Interp *interp,		/* Interpreter for which objPtr was created to
				 * hold a literal. */
    Tcl_Obj *objPtr)	/* Points to a Tcl object holding a literal
    Tcl_Obj *objPtr)		/* Points to a Tcl object holding a literal
				 * that was previously created by a call to
				 * TclRegisterLiteral. */
{
    Interp *iPtr = (Interp *) interp;
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    LiteralEntry *entryPtr;
    const char *bytes;
    size_t globalHash, length;

    bytes = TclGetStringFromObj(objPtr, &length);
    bytes = Tcl_GetStringFromObj(objPtr, &length);
    globalHash = (HashString(bytes, length) & globalTablePtr->mask);
    for (entryPtr=globalTablePtr->buckets[globalHash] ; entryPtr!=NULL;
	    entryPtr=entryPtr->nextPtr) {
	if (entryPtr->objPtr == objPtr) {
	    return entryPtr;
	}
    }
549
550
551
552
553
554
555
556

557
558
559
560
561
562
563
559
560
561
562
563
564
565

566
567
568
569
570
571
572
573







-
+







 *----------------------------------------------------------------------
 */

void
TclHideLiteral(
    Tcl_Interp *interp,		/* Interpreter for which objPtr was created to
				 * hold a literal. */
    CompileEnv *envPtr,/* Points to CompileEnv whose literal array
    CompileEnv *envPtr,		/* Points to CompileEnv whose literal array
				 * contains the entry being hidden. */
    int index)			/* The index of the entry in the literal
				 * array. */
{
    LiteralEntry **nextPtrPtr, *entryPtr, *lPtr;
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    size_t localHash;
575
576
577
578
579
580
581
582

583
584
585
586
587
588
589
585
586
587
588
589
590
591

592
593
594
595
596
597
598
599







-
+







     */

    newObjPtr = Tcl_DuplicateObj(lPtr->objPtr);
    Tcl_IncrRefCount(newObjPtr);
    TclReleaseLiteral(interp, lPtr->objPtr);
    lPtr->objPtr = newObjPtr;

    bytes = TclGetStringFromObj(newObjPtr, &length);
    bytes = Tcl_GetStringFromObj(newObjPtr, &length);
    localHash = HashString(bytes, length) & localTablePtr->mask;
    nextPtrPtr = &localTablePtr->buckets[localHash];

    for (entryPtr=*nextPtrPtr ; entryPtr!=NULL ; entryPtr=*nextPtrPtr) {
	if (entryPtr == lPtr) {
	    *nextPtrPtr = lPtr->nextPtr;
	    lPtr->nextPtr = NULL;
613
614
615
616
617
618
619
620

621
622
623
624
625
626
627
623
624
625
626
627
628
629

630
631
632
633
634
635
636
637







-
+







 *	literal object.
 *
 *----------------------------------------------------------------------
 */

int
TclAddLiteralObj(
    CompileEnv *envPtr,/* Points to CompileEnv in whose literal array
    CompileEnv *envPtr,		/* Points to CompileEnv in whose literal array
				 * the object is to be inserted. */
    Tcl_Obj *objPtr,		/* The object to insert into the array. */
    LiteralEntry **litPtrPtr)	/* The location where the pointer to the new
				 * literal entry should be stored. May be
				 * NULL. */
{
    LiteralEntry *lPtr;
666
667
668
669
670
671
672
673

674
675
676
677
678
679
680
676
677
678
679
680
681
682

683
684
685
686
687
688
689
690







-
+







 *	array of the CompileEnv's literal array if it becomes too large.
 *
 *----------------------------------------------------------------------
 */

static size_t
AddLocalLiteralEntry(
    CompileEnv *envPtr,/* Points to CompileEnv in whose literal array
    CompileEnv *envPtr,		/* Points to CompileEnv in whose literal array
				 * the object is to be inserted. */
    Tcl_Obj *objPtr,		/* The literal to add to the CompileEnv. */
    int localHash)		/* Hash value for the literal's string. */
{
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    LiteralEntry *localPtr;
    size_t objIndex;
712
713
714
715
716
717
718
719

720
721
722
723
724
725
726
722
723
724
725
726
727
728

729
730
731
732
733
734
735
736







-
+







		if (localPtr->objPtr == objPtr) {
		    found = 1;
		}
	    }
	}

	if (!found) {
	    bytes = TclGetStringFromObj(objPtr, &length);
	    bytes = Tcl_GetStringFromObj(objPtr, &length);
	    Tcl_Panic("%s: literal \"%.*s\" wasn't found locally",
		    "AddLocalLiteralEntry", (length>60? 60 : (int)length), bytes);
	}
    }
#endif /*TCL_COMPILE_DEBUG*/

    return objIndex;
744
745
746
747
748
749
750
751

752
753
754
755
756
757
758
754
755
756
757
758
759
760

761
762
763
764
765
766
767
768







-
+







 *	The local literal table is updated to refer to the new entries.
 *
 *----------------------------------------------------------------------
 */

static void
ExpandLocalLiteralArray(
    CompileEnv *envPtr)/* Points to the CompileEnv whose object array
    CompileEnv *envPtr)		/* Points to the CompileEnv whose object array
				 * must be enlarged. */
{
    /*
     * The current allocated local literal entries are stored between elements
     * 0 and (envPtr->literalArrayNext - 1) [inclusive].
     */

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
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







-
+















-
+







 *----------------------------------------------------------------------
 */

void
TclReleaseLiteral(
    Tcl_Interp *interp,		/* Interpreter for which objPtr was created to
				 * hold a literal. */
    Tcl_Obj *objPtr)	/* Points to a literal object that was
    Tcl_Obj *objPtr)		/* Points to a literal object that was
				 * previously created by a call to
				 * TclRegisterLiteral. */
{
    Interp *iPtr = (Interp *) interp;
    LiteralTable *globalTablePtr;
    LiteralEntry *entryPtr, *prevPtr;
    const char *bytes;
    size_t index;
    Tcl_Size length;

    if (iPtr == NULL) {
	goto done;
    }

    globalTablePtr = &iPtr->literalTable;
    bytes = TclGetStringFromObj(objPtr, &length);
    bytes = Tcl_GetStringFromObj(objPtr, &length);
    index = HashString(bytes, length) & globalTablePtr->mask;

    /*
     * Check to see if the object is in the global literal table and remove
     * this reference. The object may not be in the table if it is a hidden
     * local literal.
     */
906
907
908
909
910
911
912
913
914


915
916
917
918
919
920
921
916
917
918
919
920
921
922


923
924
925
926
927
928
929
930
931







-
-
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static size_t
HashString(
    const char *string,	/* String for which to compute hash value. */
    size_t length)			/* Number of bytes in the string. */
    const char *string,		/* String for which to compute hash value. */
    size_t length)		/* Number of bytes in the string. */
{
    size_t result = 0;

    /*
     * I tried a zillion different hash functions and asked many other people
     * for advice. Many people had their own favorite functions, all
     * different, but no-one had much idea why they were good ones. I chose
970
971
972
973
974
975
976
977

978
979
980
981
982
983
984
985
980
981
982
983
984
985
986

987

988
989
990
991
992
993
994







-
+
-







 *	Memory gets reallocated and entries get rehashed into new buckets.
 *
 *----------------------------------------------------------------------
 */

static void
RebuildLiteralTable(
    LiteralTable *tablePtr)
    LiteralTable *tablePtr)	/* Local or global table to enlarge. */
				/* Local or global table to enlarge. */
{
    LiteralEntry **oldBuckets;
    LiteralEntry **oldChainPtr, **newChainPtr;
    LiteralEntry *entryPtr;
    LiteralEntry **bucketPtr;
    const char *bytes;
    size_t oldSize, count, index;
1015
1016
1017
1018
1019
1020
1021
1022

1023
1024
1025
1026
1027
1028
1029
1024
1025
1026
1027
1028
1029
1030

1031
1032
1033
1034
1035
1036
1037
1038







-
+








    /*
     * Rehash all of the existing entries into the new bucket array.
     */

    for (oldChainPtr=oldBuckets ; oldSize>0 ; oldSize--,oldChainPtr++) {
	for (entryPtr=*oldChainPtr ; entryPtr!=NULL ; entryPtr=*oldChainPtr) {
	    bytes = TclGetStringFromObj(entryPtr->objPtr, &length);
	    bytes = Tcl_GetStringFromObj(entryPtr->objPtr, &length);
	    index = (HashString(bytes, length) & tablePtr->mask);

	    *oldChainPtr = entryPtr->nextPtr;
	    bucketPtr = &tablePtr->buckets[index];
	    entryPtr->nextPtr = *bucketPtr;
	    *bucketPtr = entryPtr;
	}
1186
1187
1188
1189
1190
1191
1192
1193

1194
1195
1196
1197
1198
1199
1200
1195
1196
1197
1198
1199
1200
1201

1202
1203
1204
1205
1206
1207
1208
1209







-
+







    size_t i, length, count = 0;

    for (i=0 ; i<localTablePtr->numBuckets ; i++) {
	for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL;
		localPtr=localPtr->nextPtr) {
	    count++;
	    if (localPtr->refCount != TCL_INDEX_NONE) {
		bytes = TclGetStringFromObj(localPtr->objPtr, &length);
		bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
		Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %" TCL_Z_MODIFIER "u",
			"TclVerifyLocalLiteralTable",
			(length>60? 60 : (int) length), bytes, localPtr->refCount);
	    }
	    if (localPtr->objPtr->bytes == NULL) {
		Tcl_Panic("%s: literal has NULL string rep",
			"TclVerifyLocalLiteralTable");
1235
1236
1237
1238
1239
1240
1241
1242

1243
1244
1245
1246
1247
1248
1249
1244
1245
1246
1247
1248
1249
1250

1251
1252
1253
1254
1255
1256
1257
1258







-
+







    size_t i, length, count = 0;

    for (i=0 ; i<globalTablePtr->numBuckets ; i++) {
	for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL;
		globalPtr=globalPtr->nextPtr) {
	    count++;
	    if (globalPtr->refCount + 1 < 2) {
		bytes = TclGetStringFromObj(globalPtr->objPtr, &length);
		bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length);
		Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %" TCL_Z_MODIFIER "u",
			"TclVerifyGlobalLiteralTable",
			(length>60? 60 : (int)length), bytes, globalPtr->refCount);
	    }
	    if (globalPtr->objPtr->bytes == NULL) {
		Tcl_Panic("%s: literal has NULL string rep",
			"TclVerifyGlobalLiteralTable");
Changes to generic/tclLoad.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclLoad.c --
 *
 *	This file provides the generic portion (those that are the same on all
 *	platforms) of Tcl's dynamic loading facilities.
 *
 * Copyright © 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclLoad.c --
 *
 *	This file provides the generic portion (those that are the same on all
 *	platforms) of Tcl's dynamic loading facilities.
 */

#include "tclInt.h"

/*
 * The following structure describes a library that has been loaded either
 * dynamically (with the "load" command) or statically (as indicated by a call
 * to Tcl_StaticLibrary). All such libraries are linked together into a
 * single list for the process.
152
153
154
155
156
157
158
159


160
161
162
163
164
165
166
163
164
165
166
167
168
169

170
171
172
173
174
175
176
177
178







-
+
+







	if (TclGetString(objv[1])[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	++objv; --objc;
	++objv;
	--objc;
	if (LOAD_GLOBAL == index) {
	    flags |= TCL_LOAD_GLOBAL;
	} else if (LOAD_LAZY == index) {
	    flags |= TCL_LOAD_LAZY;
	} else {
		break;
	}
993
994
995
996
997
998
999
1000

1001
1002
1003
1004
1005
1006
1007
1005
1006
1007
1008
1009
1010
1011

1012
1013
1014
1015
1016
1017
1018
1019







-
+








void
Tcl_StaticLibrary(
    Tcl_Interp *interp,		/* If not NULL, it means that the library has
				 * already been loaded into the given
				 * interpreter by calling the appropriate init
				 * proc. */
    const char *prefix,	/* Prefix. */
    const char *prefix,		/* Prefix. */
    Tcl_LibraryInitProc *initProc,
				/* Function to call to incorporate this
				 * library into a trusted interpreter. */
    Tcl_LibraryInitProc *safeInitProc)
				/* Function to call to incorporate this
				 * library into a safe interpreter (one that
				 * will execute untrusted scripts). NULL means
Changes to generic/tclLoadNone.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclLoadNone.c --
 *
 *	This procedure provides a version of the TclpDlopen for use in
 *	systems that don't support dynamic loading; it just returns an error.
 *
 * Copyright © 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclLoadNone.c --
 *
 *	This procedure provides a version of the TclpDlopen for use in
 *	systems that don't support dynamic loading; it just returns an error.
 */

#include "tclInt.h"

/*
 *----------------------------------------------------------------------
 *
 * TclpDlopen --
 *
Changes to generic/tclMain.c.


















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









-
-
-
-
-
-
-







/*
 * Copyright © 1988-1994 The Regents of the University of California.
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 * Copyright © 2000 Ajuba Solutions.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclMain.c --
 *
 *	Main program for Tcl shells and other Tcl-based applications.
 *	This file contains a generic main program for Tcl shells and other
 *	Tcl-based applications. It can be used as-is for many applications,
 *	just by supplying a different appInitProc function for each specific
 *	application. Or, it can be used as a template for creating new main
 *	programs for Tcl applications.
 *
 * Copyright © 1988-1994 The Regents of the University of California.
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 * Copyright © 2000 Ajuba Solutions.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * On Windows, this file needs to be compiled twice, once with UNICODE and
 * _UNICODE defined. This way both Tcl_Main and Tcl_MainExW can be
 * implemented, sharing the same source code.
 */
272
273
274
275
276
277
278
279

280
281
282
283
284
285
286
283
284
285
286
287
288
289

290
291
292
293
294
295
296
297







-
+







 *	interpreted.
 *
 *----------------------------------------------------------------------
 */

TCL_NORETURN void
Tcl_MainEx(
    Tcl_Size argc,			/* Number of arguments. */
    Tcl_Size argc,		/* Number of arguments. */
    TCHAR **argv,		/* Array of argument strings. */
    Tcl_AppInitProc *appInitProc,
				/* Application-specific initialization
				 * function to call after most initialization
				 * but before starting to execute commands. */
    Tcl_Interp *interp)
{
731
732
733
734
735
736
737
738

739
740
741
742
743
744
745
742
743
744
745
746
747
748

749
750
751
752
753
754
755
756







-
+







 *	Could be almost arbitrary, depending on the command that's typed.
 *
 *----------------------------------------------------------------------
 */

static void
StdinProc(
    void *clientData,	/* The state of interactive cmd line */
    void *clientData,		/* The state of interactive cmd line */
    TCL_UNUSED(int) /*mask*/)
{
    int code;
    Tcl_Size length;
    InteractiveState *isPtr = (InteractiveState *)clientData;
    Tcl_Channel chan = isPtr->input;
    Tcl_Obj *commandPtr = isPtr->commandPtr;
Changes to generic/tclNamesp.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
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

-
-
-
-
-
-
-
-
















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclNamesp.c --
 *
 *	Contains support for namespaces, which provide a separate context of
 *	commands and global variables. The global :: namespace is the
 *	traditional Tcl "global" scope. Other namespaces are created as
 *	children of the global namespace. These other namespaces contain
 *	special-purpose commands and variables for packages.
 *
 * Copyright © 1993-1997 Lucent Technologies.
 * Copyright © 1997 Sun Microsystems, Inc.
 * Copyright © 1998-1999 Scriptics Corporation.
 * Copyright © 2002-2005 Donal K. Fellows.
 * Copyright © 2006 Neil Madden.
 * Contributions from Don Porter, NIST, 2007. (not subject to US copyright)
 *
 * Originally implemented by
 *   Michael J. McLennan
 *   Bell Labs Innovations for Lucent Technologies
 *   mmclennan@lucent.com
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclNamesp.c --
 *
 *	Contains support for namespaces, which provide a separate context of
 *	commands and global variables. The global :: namespace is the
 *	traditional Tcl "global" scope. Other namespaces are created as
 *	children of the global namespace. These other namespaces contain
 *	special-purpose commands and variables for packages.
 */

#include "tclInt.h"
#include "tclCompile.h" /* for TclLogCommandInfo visibility */
#include <assert.h>

/*
 * Thread-local storage used to avoid having a global lock on data that is not
 * limited to a single interpreter.
87
88
89
90
91
92
93
94

95
96
97
98
99
100
101
102
103
98
99
100
101
102
103
104

105


106
107
108
109
110
111
112







-
+
-
-







			    const char *name2, int flags);
static char *		EstablishErrorInfoTraces(void *clientData,
			    Tcl_Interp *interp, const char *name1,
			    const char *name2, int flags);
static void		FreeNsNameInternalRep(Tcl_Obj *objPtr);
static int		GetNamespaceFromObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
static int		InvokeImportedNRCmd(void *clientData,
static Tcl_ObjCmdProc	InvokeImportedNRCmd;
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static Tcl_ObjCmdProc	NamespaceChildrenCmd;
static Tcl_ObjCmdProc	NamespaceCodeCmd;
static Tcl_ObjCmdProc	NamespaceCurrentCmd;
static Tcl_ObjCmdProc	NamespaceDeleteCmd;
static Tcl_ObjCmdProc	NamespaceEvalCmd;
static Tcl_ObjCmdProc	NRNamespaceEvalCmd;
static Tcl_ObjCmdProc	NamespaceExistsCmd;
129
130
131
132
133
134
135
136

137
138
139
140
141
142
143
138
139
140
141
142
143
144

145
146
147
148
149
150
151
152







-
+








static const Tcl_ObjType nsNameType = {
    "nsName",			/* the type's name */
    FreeNsNameInternalRep,	/* freeIntRepProc */
    DupNsNameInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    SetNsNameFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V0
	0
};

#define NsNameSetInternalRep(objPtr, nnPtr) \
    do {								\
	Tcl_ObjInternalRep ir;						\
	(nnPtr)->refCount++;						\
	ir.twoPtrValue.ptr1 = (nnPtr);					\
510
511
512
513
514
515
516
517

518
519
520
521
522
523
524
519
520
521
522
523
524
525

526
527
528
529
530
531
532
533







-
+







    }

    if (framePtr->varTablePtr != NULL) {
	TclDeleteVars(iPtr, framePtr->varTablePtr);
	Tcl_Free(framePtr->varTablePtr);
	framePtr->varTablePtr = NULL;
    }
    if (framePtr->numCompiledLocals > 0) {
    if (framePtr->numCompiledLocals + 1 > 1) {
	TclDeleteCompiledLocalVars(iPtr, framePtr);
	if (framePtr->localCachePtr->refCount-- <= 1) {
	    TclFreeLocalCache(interp, framePtr->localCachePtr);
	}
	framePtr->localCachePtr = NULL;
    }

1712
1713
1714
1715
1716
1717
1718
1719

1720
1721
1722
1723
1724
1725
1726
1721
1722
1723
1724
1725
1726
1727

1728
1729
1730
1731
1732
1733
1734
1735







-
+








    /*
     * From the pattern, find the namespace from which we are importing and
     * get the simple pattern (no namespace qualifiers or ::'s) at the end.
     */

    if (strlen(pattern) == 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("empty import pattern",-1));
	Tcl_SetObjResult(interp, Tcl_NewStringObj("empty import pattern", -1));
	Tcl_SetErrorCode(interp, "TCL", "IMPORT", "EMPTY", (char *)NULL);
	return TCL_ERROR;
    }
    TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY,
	    &importNsPtr, &dummyPtr, &dummyPtr, &simplePattern);

    if (importNsPtr == NULL) {
2305
2306
2307
2308
2309
2310
2311
2312

2313
2314
2315
2316
2317
2318
2319
2314
2315
2316
2317
2318
2319
2320

2321
2322
2323
2324
2325
2326
2327
2328







-
+







				 * NULL. */
    const char **simpleNamePtr) /* Address where function stores the simple
				 * name at end of the qualName, or NULL if
				 * qualName is "::" or the flag
				 * TCL_FIND_ONLY_NS was specified. */
{
    Interp *iPtr = (Interp *) interp;
    Namespace *nsPtr = cxtNsPtr, *lastNsPtr = NULL, *lastAltNsPtr = NULL;
    Namespace *nsPtr = cxtNsPtr;
    Namespace *altNsPtr;
    Namespace *globalNsPtr = iPtr->globalNsPtr;
    const char *start, *end;
    const char *nsName;
    Tcl_HashEntry *entryPtr;
    Tcl_DString buffer;
    int len;
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
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







-
-
-
+
-
-
+
-













-
-









-
-
-
-
-
-
-
-
-
-
-







		nsPtr = (Namespace *)
			Tcl_CreateNamespace(interp, nsName, NULL, NULL);
		TclPopStackFrame(interp);

		if (nsPtr == NULL) {
		    Tcl_Panic("Could not create namespace '%s'", nsName);
		}
	    } else {
		/*
		 * Namespace not found and was not created.
	    } else {			/* Namespace not found and was not
		 * Remember last found namespace for TCL_FIND_IF_NOT_SIMPLE.
		 */
					 * created. */
		lastNsPtr = nsPtr;
		nsPtr = NULL;
	    }
	}

	/*
	 * Look up the namespace qualifier in the alternate search path too.
	 */

	if (altNsPtr != NULL) {
	    entryPtr = FindChildEntry(altNsPtr, nsName);
	    if (entryPtr != NULL) {
		altNsPtr = (Namespace *) Tcl_GetHashValue(entryPtr);
	    } else {
		/* Remember last found in alternate path */
		lastAltNsPtr = altNsPtr;
		altNsPtr = NULL;
	    }
	}

	/*
	 * If both search paths have failed, return NULL results.
	 */

	if ((nsPtr == NULL) && (altNsPtr == NULL)) {
	    if (flags & TCL_FIND_IF_NOT_SIMPLE) {
		/*
		 * return last found NS, regardless simple name or not,
		 * e. g. ::A::B::C::D -> ::A::B and C::D, if namespace C
		 * cannot be found in ::A::B
		 */
		nsPtr = lastNsPtr;
		altNsPtr = lastAltNsPtr;
		*simpleNamePtr = start;
		goto done;
	    }
	    *simpleNamePtr = NULL;
	    goto done;
	}

	start = end;
    }

3263
3264
3265
3266
3267
3268
3269
3270

3271
3272
3273
3274
3275
3276
3277
3255
3256
3257
3258
3259
3260
3261

3262
3263
3264
3265
3266
3267
3268
3269







-
+







     * If "arg" is already a scoped value, then return it directly.
     * Take care to only check for scoping in precisely the style that
     * [::namespace code] generates it.  Anything more forgiving can have
     * the effect of failing in namespaces that contain their own custom
     " "namespace" command.  [Bug 3202171].
     */

    arg = TclGetStringFromObj(objv[1], &length);
    arg = Tcl_GetStringFromObj(objv[1], &length);
    if (*arg==':' && length > 20
	    && strncmp(arg, "::namespace inscope ", 20) == 0) {
	Tcl_SetObjResult(interp, objv[1]);
	return TCL_OK;
    }

    /*
3841
3842
3843
3844
3845
3846
3847
3848

3849
3850
3851
3852
3853
3854
3855
3833
3834
3835
3836
3837
3838
3839

3840
3841
3842
3843
3844
3845
3846
3847







-
+







	TclNewObj(listPtr);
	for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
		hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    Command *cmdPtr = (Command *) Tcl_GetHashValue(hPtr);

	    if (cmdPtr->deleteProc == DeleteImportedCmd) {
		Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj(
			(char *) Tcl_GetHashKey(&nsPtr->cmdTable, hPtr), -1));
			(char *)Tcl_GetHashKey(&nsPtr->cmdTable, hPtr), -1));
	    }
	}
	Tcl_SetObjResult(interp, listPtr);
	return TCL_OK;
    }

    /*
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
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







+
















+
+
+
+
-
+







    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Command cmd, origCmd;
    Tcl_Obj *resultPtr;
    int isEmpty, status;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }

    cmd = Tcl_GetCommandFromObj(interp, objv[1]);
    if (cmd == NULL) {
	goto namespaceOriginError;
    }
    origCmd = TclGetOriginalCommand(cmd);
    if (origCmd == NULL) {
	origCmd = cmd;
    }
    TclNewObj(resultPtr);
    Tcl_GetCommandFullName(interp, origCmd, resultPtr);
    status = TclCheckEmptyString(interp ,resultPtr, &isEmpty);
    if (status) {
	return TCL_ERROR;
    }
    if (TclCheckEmptyString(resultPtr) == TCL_EMPTYSTRING_YES) {
    if (isEmpty == TCL_EMPTYSTRING_YES) {
	Tcl_DecrRefCount(resultPtr);
	goto namespaceOriginError;
    }
    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;

  namespaceOriginError:
4765
4766
4767
4768
4769
4770
4771
4772

4773
4774
4775
4776
4777
4778
4779
4780
4781

4782
4783
4784
4785
4786
4787
4788
4762
4763
4764
4765
4766
4767
4768

4769
4770
4771
4772
4773
4774
4775
4776
4777

4778
4779
4780
4781
4782
4783
4784
4785







-
+








-
+







	    goto badArgs;
	}
    }

    TclNewObj(resultPtr);
    switch (lookupType) {
    case 0: {				/* -command */
	Tcl_Command cmd = Tcl_GetCommandFromObj(interp, objv[objc-1]);
	Tcl_Command cmd = Tcl_GetCommandFromObj(interp, objv[objc - 1]);

	if (cmd != NULL) {
	    Tcl_GetCommandFullName(interp, cmd, resultPtr);
	}
	break;
    }
    case 1: {				/* -variable */
	Tcl_Var var = Tcl_FindNamespaceVar(interp,
		TclGetString(objv[objc-1]), NULL, /*flags*/ 0);
		TclGetString(objv[objc - 1]), NULL, /*flags*/ 0);

	if (var != NULL) {
	    Tcl_GetVariableFullName(interp, var, resultPtr);
	}
	break;
    }
    }
4903
4904
4905
4906
4907
4908
4909
4910

4911
4912
4913
4914
4915
4916
4917
4900
4901
4902
4903
4904
4905
4906

4907
4908
4909
4910
4911
4912
4913
4914







-
+








    if (interp == NULL) {
	return TCL_ERROR;
    }

    name = TclGetString(objPtr);
    TclGetNamespaceForQualName(interp, name, NULL, TCL_FIND_ONLY_NS,
	     &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
	    &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);

    if ((nsPtr == NULL) || (nsPtr->flags & NS_DYING)) {
	return TCL_ERROR;
    }

    /*
     * If we found a namespace, then create a new ResolvedNsName structure
Changes to generic/tclNotify.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
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

-
-
-
-
-
-
-
-









+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclNotify.c --
 *
 *	This file implements the generic portion of the Tcl notifier. The
 *	notifier is lowest-level part of the event system. It manages an event
 *	queue that holds Tcl_Event structures. The platform specific portion
 *	of the notifier is defined in the tcl*Notify.c files in each platform
 *	directory.
 *
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 * Copyright © 1998 Scriptics Corporation.
 * Copyright © 2003 Kevin B. Kenny.  All rights reserved.
 * Copyright © 2021 Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclNotify.c --
 *
 *	This file implements the generic portion of the Tcl notifier. The
 *	notifier is lowest-level part of the event system. It manages an event
 *	queue that holds Tcl_Event structures. The platform specific portion
 *	of the notifier is defined in the tcl*Notify.c files in each platform
 *	directory.
 */

#include "tclInt.h"

/*
 * Notifier hooks that are checked in the public wrappers for the default
 * notifier functions (for overriding via Tcl_SetNotifier).
 */

67
68
69
70
71
72
73
74

75
76
77
78
79
80
81
78
79
80
81
82
83
84

85
86
87
88
89
90
91
92







-
+







				 * elapsed time for the next block. */
    int inTraversal;		/* 1 if Tcl_SetMaxBlockTime is being called
				 * during an event source traversal. */
    EventSource *firstEventSourcePtr;
				/* Pointer to first event source in list of
				 * event sources for this thread. */
    Tcl_ThreadId threadId;	/* Thread that owns this notifier instance. */
    void *clientData;	/* Opaque handle for platform specific
    void *clientData;		/* Opaque handle for platform specific
				 * notifier. */
    int initialized;		/* 1 if notifier has been initialized. */
    struct ThreadSpecificData *nextPtr;
				/* Next notifier in global list of notifiers.
				 * Access is controlled by the listLock global
				 * mutex. */
} ThreadSpecificData;
301
302
303
304
305
306
307
308

309
310
311
312
313
314
315
312
313
314
315
316
317
318

319
320
321
322
323
324
325
326







-
+







Tcl_CreateEventSource(
    Tcl_EventSetupProc *setupProc,
				/* Function to invoke to figure out what to
				 * wait for. */
    Tcl_EventCheckProc *checkProc,
				/* Function to call after waiting to see what
				 * happened. */
    void *clientData)	/* One-word argument to pass to setupProc and
    void *clientData)		/* One-word argument to pass to setupProc and
				 * checkProc. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    EventSource *sourcePtr = (EventSource *)Tcl_Alloc(sizeof(EventSource));

    sourcePtr->setupProc = setupProc;
    sourcePtr->checkProc = checkProc;
340
341
342
343
344
345
346
347

348
349
350
351
352
353
354
351
352
353
354
355
356
357

358
359
360
361
362
363
364
365







-
+







Tcl_DeleteEventSource(
    Tcl_EventSetupProc *setupProc,
				/* Function to invoke to figure out what to
				 * wait for. */
    Tcl_EventCheckProc *checkProc,
				/* Function to call after waiting to see what
				 * happened. */
    void *clientData)	/* One-word argument to pass to setupProc and
    void *clientData)		/* One-word argument to pass to setupProc and
				 * checkProc. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    EventSource *sourcePtr, *prevPtr;

    for (sourcePtr = tsdPtr->firstEventSourcePtr, prevPtr = NULL;
	    sourcePtr != NULL;
552
553
554
555
556
557
558
559

560
561
562
563
564
565
566
563
564
565
566
567
568
569

570
571
572
573
574
575
576
577







-
+







 *
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteEvents(
    Tcl_EventDeleteProc *proc,	/* The function to call. */
    void *clientData)	/* The type-specific data. */
    void *clientData)		/* The type-specific data. */
{
    Tcl_Event *evPtr;		/* Pointer to the event being examined */
    Tcl_Event *prevPtr;		/* Pointer to evPtr's predecessor, or NULL if
				 * evPtr designates the first event in the
				 * queue for the thread. */
    Tcl_Event *hold;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1249
1250
1251
1252
1253
1254
1255
1256

1257
1258
1259
1260
1261
1262
1263
1260
1261
1262
1263
1264
1265
1266

1267
1268
1269
1270
1271
1272
1273
1274







-
+







 *	See the platform-specific implementations.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AlertNotifier(
    void *clientData)	/* Pointer to thread data. */
    void *clientData)		/* Pointer to thread data. */
{
    if (tclNotifierHooks.alertNotifierProc) {
	tclNotifierHooks.alertNotifierProc(clientData);
    } else {
	TclpAlertNotifier(clientData);
    }
}
1306
1307
1308
1309
1310
1311
1312
1313

1314
1315
1316
1317
1318
1319
1320
1317
1318
1319
1320
1321
1322
1323

1324
1325
1326
1327
1328
1329
1330
1331







-
+







 *	See the platform-specific implementations.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetTimer(
    const Tcl_Time *timePtr)		/* Timeout value, may be NULL. */
    const Tcl_Time *timePtr)	/* Timeout value, may be NULL. */
{
    if (tclNotifierHooks.setTimerProc) {
	tclNotifierHooks.setTimerProc(timePtr);
    } else {
	TclpSetTimer(timePtr);
    }
}
1337
1338
1339
1340
1341
1342
1343
1344

1345
1346
1347
1348
1349
1350
1351
1348
1349
1350
1351
1352
1353
1354

1355
1356
1357
1358
1359
1360
1361
1362







-
+







 *	Queues file events that are detected by the notifier.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_WaitForEvent(
    const Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
    const Tcl_Time *timePtr)	/* Maximum block time, or NULL. */
{
    if (tclNotifierHooks.waitForEventProc) {
	return tclNotifierHooks.waitForEventProc(timePtr);
    } else {
	return TclpWaitForEvent(timePtr);
    }
}
1376
1377
1378
1379
1380
1381
1382
1383

1384
1385
1386
1387
1388
1389
1390
1387
1388
1389
1390
1391
1392
1393

1394
1395
1396
1397
1398
1399
1400
1401







-
+







    int fd,			/* Handle of stream to watch. */
    int mask,			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION: indicates
				 * conditions under which proc should be
				 * called. */
    Tcl_FileProc *proc,		/* Function to call for each selected
				 * event. */
    void *clientData)	/* Arbitrary data to pass to proc. */
    void *clientData)		/* Arbitrary data to pass to proc. */
{
    if (tclNotifierHooks.createFileHandlerProc) {
	tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData);
    } else {
	TclpCreateFileHandler(fd, mask, proc, clientData);
    }
}
Changes to generic/tclOO.c.
1
2
3
4
5
6
7
8
9
10
11
12















13
14
15
16
17
18
19
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

-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclOO.c --
 *
 *	This file contains the object-system core (NB: not Tcl_Obj, but ::oo)
 *
 * Copyright © 2005-2019 Donal K. Fellows
 * Copyright © 2017 Nathan Coulter
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclOO.c --
 *
 *	This file contains the object-system core (NB: not Tcl_Obj, but ::oo)
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"

/*
98
99
100
101
102
103
104
105
106
107



108
109
110
111
112
113
114
109
110
111
112
113
114
115



116
117
118
119
120
121
122
123
124
125







-
-
-
+
+
+







 * Methods in the oo::object and oo::class classes. First, we define a helper
 * macro that makes building the method type declaration structure a lot
 * easier. No point in making life harder than it has to be!
 *
 * Note that the core methods don't need clone or free proc callbacks.
 */

#define DCM(name,visibility,proc) \
    {name,visibility,\
	{TCL_OO_METHOD_VERSION_CURRENT,"core method: "#name,proc,NULL,NULL}}
#define DCM(name, visibility, proc) \
    {name, visibility, \
	{TCL_OO_METHOD_VERSION_CURRENT, "core method: "#name, proc, NULL, NULL}}

static const DeclaredClassMethod objMethods[] = {
    DCM("destroy", 1,	TclOO_Object_Destroy),
    DCM("eval", 0,	TclOO_Object_Eval),
    DCM("unknown", 0,	TclOO_Object_Unknown),
    DCM("variable", 0,	TclOO_Object_LinkVar),
    DCM("varname", 0,	TclOO_Object_VarName),
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
146
147
148
149
150
151
152



153
154
155
156
157
158
159







-
-
-








/*
 * Scripted parts of TclOO. First, the main script (cannot be outside this
 * file).
 */

static const char initScript[] =
#ifndef TCL_NO_DEPRECATED
"package ifneeded TclOO " TCLOO_PATCHLEVEL " {# Already present, OK?};"
#endif
"package ifneeded tcl::oo " TCLOO_PATCHLEVEL " {# Already present, OK?};"
"namespace eval ::oo { variable version " TCLOO_VERSION " };"
"namespace eval ::oo { variable patchlevel " TCLOO_PATCHLEVEL " };";
/* "tcl_findLibrary tcloo $oo::version $oo::version" */
/* " tcloo.tcl OO_LIBRARY oo::library;"; */

/*
177
178
179
180
181
182
183
184

185
186

187
188
189
190
191
192
193
185
186
187
188
189
190
191

192
193

194
195
196
197
198
199
200
201







-
+

-
+







 */

#define Destructing(oPtr)	((oPtr)->flags & OBJECT_DESTRUCTING)
#define IsRootObject(ocPtr)	((ocPtr)->flags & ROOT_OBJECT)
#define IsRootClass(ocPtr)	((ocPtr)->flags & ROOT_CLASS)
#define IsRoot(ocPtr)		((ocPtr)->flags & (ROOT_OBJECT|ROOT_CLASS))

#define RemoveItem(type, lst, i) \
#define RemoveItem(type, lst, idx) \
    do {						\
	Remove ## type ((lst).list, (lst).num, i);	\
	Remove ## type ((lst).list, (lst).num, idx);	\
	(lst).num--;					\
    } while (0)

/*
 * ----------------------------------------------------------------------
 *
 * RemoveClass, RemoveObject --
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
265
266
267
268
269
270
271




272
273
274
275
276
277
278







-
-
-
-







     * to be fully provided.
     */

    if (Tcl_EvalEx(interp, initScript, TCL_INDEX_NONE, 0) != TCL_OK) {
	return TCL_ERROR;
    }

#ifndef TCL_NO_DEPRECATED
    Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL,
	    &tclOOStubs);
#endif
    return Tcl_PkgProvideEx(interp, "tcl::oo", TCLOO_PATCHLEVEL,
	    &tclOOStubs);
}

/*
 * ----------------------------------------------------------------------
 *
2832
2833
2834
2835
2836
2837
2838
2839

2840
2841
2842
2843
2844
2845
2846
2836
2837
2838
2839
2840
2841
2842

2843
2844
2845
2846
2847
2848
2849
2850







-
+







    }

    /*
     * Invoke the call chain, locking the object structure against deletion
     * for the duration.
     */

    TclNRAddCallback(interp, FinalizeObjectCall, contextPtr, NULL,NULL,NULL);
    TclNRAddCallback(interp, FinalizeObjectCall, contextPtr, NULL, NULL, NULL);
    return TclOOInvokeContext(contextPtr, interp, objc, objv);
}

static int
FinalizeObjectCall(
    void *data[],
    TCL_UNUSED(Tcl_Interp *),
Changes to generic/tclOO.decls.












1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-







# Copyright © 2008-2013 Donal K. Fellows.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# tclOO.decls --
#
#	This file contains the declarations for all supported public functions
#	that are exported by the TclOO package that is embedded within the Tcl
#	library via the stubs table.  This file is used to generate the
#	tclOODecls.h, tclOOIntDecls.h and tclOOStubInit.c files.
#
# Copyright © 2008-2013 Donal K. Fellows.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

library tclOO

######################################################################
# Public API, exposed for general users of TclOO.
#

Changes to generic/tclOO.h.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclOO.h --
 *
 *	This file contains the public API definitions and some of the function
 *	declarations for the object-system (NB: not Tcl_Obj, but ::oo).
 *
 * Copyright (c) 2006-2010 by Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclOO.h --
 *
 *	This file contains the public API definitions and some of the function
 *	declarations for the object-system (NB: not Tcl_Obj, but ::oo).
 */

#ifndef TCLOO_H_INCLUDED
#define TCLOO_H_INCLUDED

/*
 * Be careful when it comes to versioning; need to make sure that the
 * standalone TclOO version matches. Also make sure that this matches the
 * version in the files:
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
69
70
71
72
73
74
75

76
77



78
79
80
81
82
83
84







-


-
-
-







 * Public datatypes for callbacks and structures used in the TIP#257 (OO)
 * implementation. These are used to implement custom types of method calls
 * and to allow the attachment of arbitrary data to objects and classes.
 */

typedef int (Tcl_MethodCallProc)(void *clientData, Tcl_Interp *interp,
	Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv);
#if TCL_MAJOR_VERSION > 8
typedef int (Tcl_MethodCallProc2)(void *clientData, Tcl_Interp *interp,
	Tcl_ObjectContext objectContext, Tcl_Size objc, Tcl_Obj *const *objv);
#else
#define Tcl_MethodCallProc2 Tcl_MethodCallProc
#endif
typedef void (Tcl_MethodDeleteProc)(void *clientData);
typedef int (Tcl_CloneProc)(Tcl_Interp *interp, void *oldClientData,
	void **newClientData);
typedef void (Tcl_ObjectMetadataDeleteProc)(void *clientData);
typedef int (Tcl_ObjectMapMethodNameProc)(Tcl_Interp *interp,
	Tcl_Object object, Tcl_Class *startClsPtr, Tcl_Obj *methodNameObj);

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
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







-
















-
-
-







				 * data, or NULL if the type-specific data
				 * does not need deleting. */
    Tcl_CloneProc *cloneProc;	/* How to copy this method's type-specific
				 * data, or NULL if the type-specific data can
				 * be copied directly. */
} Tcl_MethodType;

#if TCL_MAJOR_VERSION > 8
typedef struct Tcl_MethodType2 {
    int version;		/* Structure version field. Always to be equal
				 * to TCL_OO_METHOD_VERSION_2 in
				 * declarations. */
    const char *name;		/* Name of this type of method, mostly for
				 * debugging purposes. */
    Tcl_MethodCallProc2 *callProc;
				/* How to invoke this method. */
    Tcl_MethodDeleteProc *deleteProc;
				/* How to delete this method's type-specific
				 * data, or NULL if the type-specific data
				 * does not need deleting. */
    Tcl_CloneProc *cloneProc;	/* How to copy this method's type-specific
				 * data, or NULL if the type-specific data can
				 * be copied directly. */
} Tcl_MethodType2;
#else
#define Tcl_MethodType2 Tcl_MethodType
#endif

/*
 * The correct value for the version field of the Tcl_MethodType structure.
 * This allows new versions of the structure to be introduced without breaking
 * binary compatibility.
 */
enum TclOOMethodVersion {
Changes to generic/tclOOBasic.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclOOBasic.c --
 *
 *	This file contains implementations of the "simple" commands and
 *	methods from the object-system core.
 *
 * Copyright © 2005-2013 Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclOOBasic.c --
 *
 *	This file contains implementations of the "simple" commands and
 *	methods from the object-system core.
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"
#include "tclTomMath.h"

931
932
933
934
935
936
937
938

939
940
941
942
943
944
945
942
943
944
945
946
947
948

949
950
951
952
953
954
955
956







-
+







    context = (Tcl_ObjectContext) framePtr->clientData;

    /*
     * Invoke the (advanced) method call context in the caller context. Note
     * that this is like [uplevel 1] and not [eval].
     */

    TclNRAddCallback(interp, NextRestoreFrame, framePtr, NULL,NULL,NULL);
    TclNRAddCallback(interp, NextRestoreFrame, framePtr, NULL, NULL, NULL);
    iPtr->varFramePtr = framePtr->callerVarPtr;
    return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1);
}

int
TclOONextToObjCmd(
    TCL_UNUSED(void *),
Changes to generic/tclOOCall.c.
















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
-
-







/*
 * Copyright © 2005-2019 Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclOOCall.c --
 *
 *	This file contains the method call chain management code for the
 *	object-system core. It also contains everything else that does
 *	inheritance hierarchy traversal.
 *
 * Copyright © 2005-2019 Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"
158
159
160
161
162
163
164
165

166
167
168
169
170
171
172
169
170
171
172
173
174
175

176
177
178
179
180
181
182
183







-
+








static const Tcl_ObjType methodNameType = {
    "TclOO method name",
    FreeMethodNameRep,
    DupMethodNameRep,
    NULL,
    NULL,
    TCL_OBJTYPE_V0
	0
};

/*
 * ----------------------------------------------------------------------
 *
 * TclOODeleteContext --
 *
362
363
364
365
366
367
368
369

370
371

372
373
374
375
376
377
378
373
374
375
376
377
378
379

380
381

382
383
384
385
386
387
388
389







-
+

-
+







    }

    /*
     * Save whether we were in a filter and set up whether we are now.
     */

    if (contextPtr->oPtr->flags & FILTER_HANDLING) {
	TclNRAddCallback(interp, SetFilterFlags, contextPtr, NULL,NULL,NULL);
	TclNRAddCallback(interp, SetFilterFlags, contextPtr, NULL, NULL, NULL);
    } else {
	TclNRAddCallback(interp, ResetFilterFlags,contextPtr,NULL,NULL,NULL);
	TclNRAddCallback(interp, ResetFilterFlags, contextPtr, NULL, NULL, NULL);
    }
    if (isFilter || contextPtr->callPtr->flags & FILTER_HANDLING) {
	contextPtr->oPtr->flags |= FILTER_HANDLING;
    } else {
	contextPtr->oPtr->flags &= ~FILTER_HANDLING;
    }

Changes to generic/tclOODecls.h.









1
2
3

4
5
6
7
8
9
10
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
+
+
+
+
+
+
+
+
+



+







/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * This file is (mostly) automatically generated from tclOO.decls.
 */


#ifndef _TCLOODECLS
#define _TCLOODECLS

#ifndef TCLAPI
#   ifdef BUILD_tcl
#	define TCLAPI extern DLLEXPORT
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
276
277
278
279
280
281
282










283







-
-
-
-
-
-
-
-
-
-

#define Tcl_NewMethod2 \
	(tclOOStubsPtr->tcl_NewMethod2) /* 34 */

#endif /* defined(USE_TCLOO_STUBS) */

/* !END!: Do not edit above this line. */

#if TCL_MAJOR_VERSION < 9
    /* TIP #630 for 8.7 */
#   undef Tcl_MethodIsType2
#   define Tcl_MethodIsType2 Tcl_MethodIsType
#   undef Tcl_NewInstanceMethod2
#   define Tcl_NewInstanceMethod2 Tcl_NewInstanceMethod
#   undef Tcl_NewMethod2
#   define Tcl_NewMethod2 Tcl_NewMethod
#endif

#endif /* _TCLOODECLS */
Changes to generic/tclOODefineCmds.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclOODefineCmds.c --
 *
 *	This file contains the implementation of the ::oo::define command,
 *	part of the object-system core (NB: not Tcl_Obj, but ::oo).
 *
 * Copyright © 2006-2019 Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclOODefineCmds.c --
 *
 *	This file contains the implementation of the ::oo::define command,
 *	part of the object-system core (NB: not Tcl_Obj, but ::oo).
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"

/*
35
36
37
38
39
40
41
42

43
44
45
46
47
48
49
46
47
48
49
50
51
52

53
54
55
56
57
58
59
60







-
+







typedef struct DeclaredSlot {
    const char *name;
    const Tcl_MethodType getterType;
    const Tcl_MethodType setterType;
    const Tcl_MethodType resolverType;
} DeclaredSlot;

#define SLOT(name,getter,setter,resolver)				\
#define SLOT(name, getter, setter, resolver)				\
    {"::oo::" name,							\
	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Getter", \
		    getter, NULL, NULL},				\
	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Setter", \
		    setter, NULL, NULL},				\
	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Resolver", \
		    resolver, NULL, NULL}}
798
799
800
801
802
803
804
805

806
807
808
809
810
811
812
809
810
811
812
813
814
815

816
817
818
819
820
821
822
823







-
+







	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_UNKNOWN", (char *)NULL);
	return TCL_ERROR;
    }
    if (TclOOGetDefineCmdContext(interp) == NULL) {
	return TCL_ERROR;
    }

    soughtStr = TclGetStringFromObj(objv[1], &soughtLen);
    soughtStr = Tcl_GetStringFromObj(objv[1], &soughtLen);
    if (soughtLen == 0) {
	goto noMatch;
    }
    hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
    while (hPtr != NULL) {
	const char *nameStr = (const char *)
		Tcl_GetHashKey(&nsPtr->cmdTable, hPtr);
861
862
863
864
865
866
867
868

869
870
871
872
873
874
875
872
873
874
875
876
877
878

879
880
881
882
883
884
885
886







-
+







static Tcl_Command
FindCommand(
    Tcl_Interp *interp,
    Tcl_Obj *stringObj,
    Tcl_Namespace *const namespacePtr)
{
    Tcl_Size length;
    const char *nameStr, *string = TclGetStringFromObj(stringObj, &length);
    const char *nameStr, *string = Tcl_GetStringFromObj(stringObj, &length);
    Namespace *const nsPtr = (Namespace *) namespacePtr;
    FOREACH_HASH_DECLS;
    Tcl_Command cmd, cmd2;

    /*
     * If someone is playing games, we stop playing right now.
     */
1099
1100
1101
1102
1103
1104
1105
1106

1107
1108
1109
1110
1111
1112
1113
1110
1111
1112
1113
1114
1115
1116

1117
1118
1119
1120
1121
1122
1123
1124







-
+







    const char *typeOfSubject)	/* Part of the message, saying whether it was
				 * an object, class or class-as-object that
				 * was being configured. */
{
    Tcl_Size length;
    Tcl_Obj *realNameObj = Tcl_ObjectDeleted((Tcl_Object) oPtr)
	    ? savedNameObj : TclOOObjectName(interp, oPtr);
    const char *objName = TclGetStringFromObj(realNameObj, &length);
    const char *objName = Tcl_GetStringFromObj(realNameObj, &length);
    int limit = OBJNAME_LENGTH_IN_ERRORINFO_LIMIT;
    int overflow = (length > limit);

    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (in definition script for %s \"%.*s%s\" line %d)",
	    typeOfSubject, (overflow ? limit : (int) length), objName,
	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1844
1845
1846
1847
1848
1849
1850

1851
1852
1853
1854
1855
1856
1857







-








    if (clsPtr == NULL) {
	return TCL_ERROR;
    } else if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "body");
	return TCL_ERROR;
    }


    (void) TclGetStringFromObj(objv[1], &bodyLength);
    if (bodyLength > 0) {
	/*
	 * Create the method structure.
	 */

2674
2675
2676
2677
2678
2679
2680
2681

2682
2683
2684
2685
2686
2687
2688
2684
2685
2686
2687
2688
2689
2690

2691
2692
2693
2694
2695
2696
2697
2698







-
+







		goto failedAfterAlloc;
	    }
	    for (j = 0; j < i; j++) {
		if (superclasses[j] == superclasses[i]) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "class should only be a direct superclass once",
			    -1));
		    Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",(char *)NULL);
		    Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS", (char *)NULL);
		    goto failedAfterAlloc;
		}
	    }
	    if (TclOOIsReachable(clsPtr, superclasses[i])) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"attempt to form circular dependency graph", -1));
		Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", (char *)NULL);
Changes to generic/tclOOInfo.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclOODefineCmds.c --
 *
 *	This file contains the implementation of the ::oo-related [info]
 *	subcommands.
 *
 * Copyright © 2006-2019 Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclOODefineCmds.c --
 *
 *	This file contains the implementation of the ::oo-related [info]
 *	subcommands.
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"

static Tcl_ObjCmdProc InfoObjectCallCmd;
Changes to generic/tclOOInt.h.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclOOInt.h --
 *
 *	This file contains the structure definitions and some of the function
 *	declarations for the object-system (NB: not Tcl_Obj, but ::oo).
 *
 * Copyright (c) 2006-2012 by Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclOOInt.h --
 *
 *	This file contains the structure definitions and some of the function
 *	declarations for the object-system (NB: not Tcl_Obj, but ::oo).
 */

#ifndef TCL_OO_INTERNAL_H
#define TCL_OO_INTERNAL_H 1

#include "tclInt.h"
#include "tclOO.h"

/*
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
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







-
-
-
+
+
+









-
+












-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+







-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+












/*
 * A convenience macro for iterating through the lists used in the internal
 * memory management of objects.
 * REQUIRES DECLARATION: Tcl_Size i;
 */

#define FOREACH(var,ary) \
    for(i=0 ; i<(ary).num; i++) if ((ary).list[i] == NULL) { \
	continue; \
#define FOREACH(var, ary) \
    for(i=0 ; i<(ary).num; i++) if ((ary).list[i] == NULL) {		\
	continue;							\
    } else if ((var) = (ary).list[i], 1)

/*
 * A variation where the array is an array of structs. There's no issue with
 * possible NULLs; every element of the array will be iterated over and the
 * variable set to a pointer to each of those elements in turn.
 * REQUIRES DECLARATION: Tcl_Size i; See [96551aca55] for more FOREACH_STRUCT details.
 */

#define FOREACH_STRUCT(var,ary) \
#define FOREACH_STRUCT(var, ary) \
    if (i=0, (ary).num>0) for(; var=&((ary).list[i]), i<(ary).num; i++)

/*
 * Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS
 * sets up the declarations needed for the main macro, FOREACH_HASH, which
 * does the actual iteration. FOREACH_HASH_VALUE is a restricted version that
 * only iterates over values.
 * REQUIRES DECLARATION: FOREACH_HASH_DECLS;
 */

#define FOREACH_HASH_DECLS \
    Tcl_HashEntry *hPtr;Tcl_HashSearch search
#define FOREACH_HASH(key,val,tablePtr) \
    for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \
	    (*(void **)&(key)=Tcl_GetHashKey((tablePtr),hPtr),\
	    *(void **)&(val)=Tcl_GetHashValue(hPtr),1):0; hPtr=Tcl_NextHashEntry(&search))
#define FOREACH_HASH_VALUE(val,tablePtr) \
    for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \
	    (*(void **)&(val)=Tcl_GetHashValue(hPtr),1):0;hPtr=Tcl_NextHashEntry(&search))
#define FOREACH_HASH(key, val, tablePtr) \
    for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ?	\
	    (*(void **)&(key)=Tcl_GetHashKey((tablePtr),hPtr),		\
	    *(void **)&(val)=Tcl_GetHashValue(hPtr),1):0;		\
	    hPtr=Tcl_NextHashEntry(&search))
#define FOREACH_HASH_VALUE(val, tablePtr) \
    for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ?	\
	    (*(void **)&(val)=Tcl_GetHashValue(hPtr),1):0;		\
	    hPtr=Tcl_NextHashEntry(&search))

/*
 * Convenience macro for duplicating a list. Needs no external declaration,
 * but all arguments are used multiple times and so must have no side effects.
 */

#undef DUPLICATE /* prevent possible conflict with definition in WINAPI nb30.h */
#define DUPLICATE(target,source,type) \
    do { \
	size_t len = sizeof(type) * ((target).num=(source).num);\
	if (len != 0) { \
	    memcpy(((target).list=(type*)Tcl_Alloc(len)), (source).list, len); \
	} else { \
	    (target).list = NULL; \
	} \
#define DUPLICATE(target, source, type) \
    do {								\
	size_t len = sizeof(type) * ((target).num=(source).num);	\
	if (len != 0) {							\
	    memcpy(((target).list=(type*)				\
		    Tcl_Alloc(len)), (source).list, len);		\
	} else {							\
	    (target).list = NULL;					\
	}								\
    } while(0)

#endif /* TCL_OO_INTERNAL_H */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclOOIntDecls.h.









1
2
3

4
5
6
7
8
9
10
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
+
+
+
+
+
+
+
+
+



+







/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * This file is (mostly) automatically generated from tclOO.decls.
 */


#ifndef _TCLOOINTDECLS
#define _TCLOOINTDECLS

/* !BEGIN!: Do not edit below this line. */

#ifdef __cplusplus
Changes to generic/tclOOMethod.c.
1
2
3
4
5
6
7
8
9
10
11















12
13
14
15
16
17
18
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

-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclOOMethod.c --
 *
 *	This file contains code to create and manage methods.
 *
 * Copyright © 2005-2011 Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclOOMethod.c --
 *
 *	This file contains code to create and manage methods.
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"
#include "tclCompile.h"

1196
1197
1198
1199
1200
1201
1202
1203

1204
1205
1206
1207
1208
1209
1210
1207
1208
1209
1210
1211
1212
1213

1214
1215
1216
1217
1218
1219
1220
1221







-
+







 *
 * ----------------------------------------------------------------------
 */

// TODO: Check whether Tcl_AppendLimitedToObj() can work here.

#define LIMIT 60
#define ELLIPSIFY(str,len) \
#define ELLIPSIFY(str, len) \
	((len) > LIMIT ? LIMIT : (int)(len)), (str), ((len) > LIMIT ? "..." : "")

static void
MethodErrorHandler(
    Tcl_Interp *interp,
    TCL_UNUSED(Tcl_Obj *) /*methodNameObj*/)
	// We pull the method name out of context instead of from argument
Changes to generic/tclOOProp.c.
192
193
194
195
196
197
198
199

200
201
202
203
204
205
206
192
193
194
195
196
197
198

199
200
201
202
203
204
205
206







-
+







	     *
	     * We cache the list here so it doesn't vanish from under our
	     * feet if a property implementation does something crazy like
	     * changing the set of properties. The type of copy this does
	     * means that the copy holds the references to the names in the
	     * table.
	     */
	    tablePtr->listPtr = TclListObjCopy(NULL, listPtr);
	    tablePtr->listPtr = TclDuplicatePureObj(interp ,listPtr ,tclListTypePtr);
	    Tcl_IncrRefCount(tablePtr->listPtr);
	    *cachePtr = tablePtr;
	} else {
	    tablePtr->listPtr = NULL;
	}
    }
    int result = Tcl_GetIndexFromObjStruct(interp, namePtr, tablePtr->names,
Changes to generic/tclOOScript.h.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

















16
17
18
19
20
21
22
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

-
-
-
-
-
-








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclOOScript.h --
 *
 *	This file contains support scripts for TclOO. They are defined here so
 *	that the code can be definitely run even in safe interpreters; TclOO's
 *	core setup is safe.
 *
 * Copyright (c) 2012-2018 Donal K. Fellows
 * Copyright (c) 2013 Andreas Kupries
 * Copyright (c) 2017 Gerald Lester
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclOOScript.h --
 *
 *	This file contains support scripts for TclOO. They are defined here so
 *	that the code can be definitely run even in safe interpreters; TclOO's
 *	core setup is safe.
 */

#ifndef TCL_OO_SCRIPT_H
#define TCL_OO_SCRIPT_H

/*
 * The scripted part of the definitions of TclOO.
 *
 * Compiled from tools/tclOOScript.tcl by tools/makeHeader.tcl, which
Changes to generic/tclOOStubInit.c.









1
2
3
4
5
6
7
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
+
+
+
+
+
+
+
+
+







/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * This file is (mostly) automatically generated from tclOO.decls.
 * It is compiled and linked in with the tclOO package proper.
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
Changes to generic/tclOOStubLib.c.









1
2
3
4
5
6
7
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
+
+
+
+
+
+
+
+
+







/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * ORIGINAL SOURCE: tk/generic/tkStubLib.c, version 1.9 2004/03/17
 */

#include "tclOOInt.h"

MODULE_SCOPE const TclOOStubs *tclOOStubsPtr;
Changes to generic/tclObj.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
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

-
-
-
-
-





+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




+








+
+
+
+







/*
 * tclObj.c --
 *
 *	This file contains Tcl object-related functions that are used by many
 *	Tcl commands.
 *
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 * Copyright © 1999 Scriptics Corporation.
 * Copyright © 2001 ActiveState Corporation.
 * Copyright © 2005 Kevin B. Kenny.  All rights reserved.
 * Copyright © 2007 Daniel A. Steffen <das@users.sourceforge.net>
 * Copyright © 2021 Nathan Coulter.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclObj.c --
 *
 *	This file contains Tcl object-related functions that are used by many
 *	Tcl commands.
 */

#include "tclInt.h"
#include "tclTomMath.h"
#include <math.h>
#include <assert.h>


/*
 * Table of all object types.
 */

static Tcl_HashTable typeTable;
static int typeTableInitialized = 0;	/* 0 means not yet initialized. */
TCL_DECLARE_MUTEX(tableMutex)

TclObjectTypeType TclObjectTypeType0 = {
	(int *)1
};

/*
 * Head of the list of free Tcl_Obj structs we maintain.
 */

Tcl_Obj *tclFreeObjList = NULL;

93
94
95
96
97
98
99
100

101
102
103
104
105
106
107
110
111
112
113
114
115
116

117
118
119
120
121
122
123
124







-
+







				 * that a Tcl_Obj was not allocated by some
				 * other thread. */
#endif /* TCL_MEM_DEBUG && TCL_THREADS */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

static void             TclThreadFinalizeContLines(void *clientData);
static void		TclThreadFinalizeContLines(void *clientData);
static ThreadSpecificData *TclGetContLineTable(void);

/*
 * Nested Tcl_Obj deletion management support
 *
 * All context references used in the object freeing code are pointers to this
 * structure; every thread will have its own structure instance. The purpose
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
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







-
+

-
-
+
+

-
-
+
+
















-
-
+
+







 * These are separated out so that some semantic content is attached
 * to them.
 */
#define ObjDeletionLock(contextPtr)	((contextPtr)->deletionCount++)
#define ObjDeletionUnlock(contextPtr)	((contextPtr)->deletionCount--)
#define ObjDeletePending(contextPtr)	((contextPtr)->deletionCount > 0)
#define ObjOnStack(contextPtr)		((contextPtr)->deletionStack != NULL)
#define PushObjToDelete(contextPtr,objPtr)                              \
#define PushObjToDelete(contextPtr, objPtr) \
    /* The string rep is already invalidated so we can use the bytes value \
     * for our pointer chain: push onto the head of the stack. */       \
    (objPtr)->bytes = (char *) ((contextPtr)->deletionStack);           \
     * for our pointer chain: push onto the head of the stack. */	\
    (objPtr)->bytes = (char *) ((contextPtr)->deletionStack);	\
    (contextPtr)->deletionStack = (objPtr)
#define PopObjToDelete(contextPtr,objPtrVar)                            \
    (objPtrVar) = (contextPtr)->deletionStack;                          \
#define PopObjToDelete(contextPtr, objPtrVar) \
    (objPtrVar) = (contextPtr)->deletionStack;				\
    (contextPtr)->deletionStack = (Tcl_Obj *) (objPtrVar)->bytes

/*
 * Macro to set up the local reference to the deletion context.
 */
#if !TCL_THREADS
static PendingObjData pendingObjData;
#define ObjInitDeletionContext(contextPtr) \
    PendingObjData *const contextPtr = &pendingObjData
#elif defined(HAVE_FAST_TSD)
static __thread PendingObjData pendingObjData;
#define ObjInitDeletionContext(contextPtr) \
    PendingObjData *const contextPtr = &pendingObjData
#else
static Tcl_ThreadDataKey pendingObjDataKey;
#define ObjInitDeletionContext(contextPtr) \
    PendingObjData *const contextPtr =     \
	    (PendingObjData *)Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData))
    PendingObjData *const contextPtr = (PendingObjData *)		\
	    Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData))
#endif

/*
 * Macros to pack/unpack a bignum's fields in a Tcl_Obj internal rep
 */

#define PACK_BIGNUM(bignum, objPtr) \
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
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







+
+
+















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








-
+




-
-
+
+
+

+
+
-
+
+
+
+





+
-
+

-
+
+
+
+





+
-
+

+
+
+
-
+





+
-
+

+
+
+







static void		UpdateStringOfDouble(Tcl_Obj *objPtr);
static void		UpdateStringOfInt(Tcl_Obj *objPtr);
static void		FreeBignum(Tcl_Obj *objPtr);
static void		DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static void		UpdateStringOfBignum(Tcl_Obj *objPtr);
static int		GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int copy, mp_int *bignumValue);
static int		SetDuplicatePureObj(Tcl_Interp *interp,
			    Tcl_Obj *dupPtr, Tcl_Obj *objPtr,
			    const Tcl_ObjType *typePtr);

/*
 * Prototypes for the array hash key methods.
 */

static Tcl_HashEntry *	AllocObjEntry(Tcl_HashTable *tablePtr, void *keyPtr);

/*
 * Prototypes for the CommandName object type.
 */

static void		DupCmdNameInternalRep(Tcl_Obj *objPtr,
			    Tcl_Obj *copyPtr);
static void		FreeCmdNameInternalRep(Tcl_Obj *objPtr);
static int		SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);

static int		ScalarObjIndex(tclObjTypeInterfaceArgsListIndex);
static int		ScalarObjInterfaceListLength(tclObjTypeInterfaceArgsListLength);
static int		ScalarObjRange(tclObjTypeInterfaceArgsListRange);

ObjInterface tclScalarInterface = {
    1,
    {},
    {
	NULL,
	NULL,				/* append */
	NULL,				/* appendList */
	NULL,				/* contains */
	ScalarObjIndex,			/* index */
	NULL,				/* indexEnd */  
	NULL,				/* isSorted */
	ScalarObjInterfaceListLength,	/* length */
	ScalarObjRange,			/* range */
	NULL,				/* rangeEnd */
	NULL,				/* replace */
	NULL,				/* replaceList */
	NULL,				/* reverse */
	NULL,				/* set */
	NULL,				/* setList */
    },
};


/*
 * The structures below defines the Tcl object types defined in this file by
 * means of functions that can be invoked by generic object code. See also
 * tclStringObj.c, tclListObj.c, tclByteCode.c for other type manager
 * implementations.
 */

const Tcl_ObjType tclBooleanType= {
const ObjectType tclBooleanObjType= {
    "boolean",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    NULL,			/* updateStringProc */
    TclSetBooleanFromAny,	/* setFromAnyProc */
    TCL_OBJTYPE_V1(TclLengthOne)
    TclSetBooleanFromAny,		/* setFromAnyProc */
    2,
    (Tcl_ObjInterface *)&tclScalarInterface
};


const Tcl_ObjType tclDoubleType= {
MODULE_SCOPE const Tcl_ObjType *tclBooleanTypePtr
	= (Tcl_ObjType *)&tclBooleanObjType;

const ObjectType tclDoubleObjType= {
    "double",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    UpdateStringOfDouble,	/* updateStringProc */
    SetDoubleFromAny,		/* setFromAnyProc */
    2,
    TCL_OBJTYPE_V1(TclLengthOne)
    (Tcl_ObjInterface *)&tclScalarInterface
};
const Tcl_ObjType tclIntType = {

MODULE_SCOPE const Tcl_ObjType *tclDoubleTypePtr = (Tcl_ObjType *)&tclDoubleObjType;

const ObjectType tclIntObjType = {
    "int",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    UpdateStringOfInt,		/* updateStringProc */
    SetIntFromAny,		/* setFromAnyProc */
    2,
    TCL_OBJTYPE_V1(TclLengthOne)
    (Tcl_ObjInterface *)&tclScalarInterface
};

MODULE_SCOPE const Tcl_ObjType *tclIntTypePtr = (Tcl_ObjType *)&tclIntObjType;

const Tcl_ObjType tclBignumType = {
const ObjectType tclBignumObjType = {
    "bignum",			/* name */
    FreeBignum,			/* freeIntRepProc */
    DupBignum,			/* dupIntRepProc */
    UpdateStringOfBignum,	/* updateStringProc */
    NULL,			/* setFromAnyProc */
    2,
    TCL_OBJTYPE_V1(TclLengthOne)
    (Tcl_ObjInterface *)&tclScalarInterface
};

MODULE_SCOPE const Tcl_ObjType *tclBignumTypePtr
	= (Tcl_ObjType *)&tclBignumObjType;

/*
 * The structure below defines the Tcl obj hash key type.
 */

const Tcl_HashKeyType tclObjHashKeyType = {
    TCL_HASH_KEY_TYPE_VERSION,	/* version */
296
297
298
299
300
301
302
303

304
305
306
307
308
309
310
361
362
363
364
365
366
367

368
369
370
371
372
373
374
375







-
+








Tcl_ObjType tclCmdNameType = {
    "cmdName",			/* name */
    FreeCmdNameInternalRep,	/* freeIntRepProc */
    DupCmdNameInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    SetCmdNameFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V0
    0
};

/*
 * Structure containing a cached pointer to a command that is the result of
 * resolving the command's name in some namespace. It is the internal
 * representation for a cmdName object. It contains the pointer along with
 * some information that is used to check the pointer's validity.
374
375
376
377
378
379
380
381
382
383



384
385
386
387
388
389
390
439
440
441
442
443
444
445



446
447
448
449
450
451
452
453
454
455







-
-
-
+
+
+







    Tcl_MutexLock(&tableMutex);
    typeTableInitialized = 1;
    Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS);
    Tcl_MutexUnlock(&tableMutex);

    Tcl_RegisterObjType(&tclByteCodeType);
    Tcl_RegisterObjType(&tclCmdNameType);
    Tcl_RegisterObjType(&tclDictType);
    Tcl_RegisterObjType(&tclDoubleType);
    Tcl_RegisterObjType(&tclListType);
    Tcl_RegisterObjType(tclDictTypePtr);
    Tcl_RegisterObjType(tclDoubleTypePtr);
    Tcl_RegisterObjType(tclListTypePtr);
    Tcl_RegisterObjType(&tclProcBodyType);
    Tcl_RegisterObjType(&tclRegexpType);
    Tcl_RegisterObjType(&tclStringType);

#ifdef TCL_COMPILE_STATS
    Tcl_MutexLock(&tclObjMutex);
    tclObjsAlloced = 0;
511
512
513
514
515
516
517
518

519
520
521
522
523
524
525
576
577
578
579
580
581
582

583
584
585
586
587
588
589
590







-
+







     */

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->lineCLPtr) {
	tsdPtr->lineCLPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS);
	Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL);
	Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines, NULL);
    }
    return tsdPtr;
}

/*
 *----------------------------------------------------------------------
 *
573
574
575
576
577
578
579
580

581
582
583
584
585
586
587
638
639
640
641
642
643
644

645
646
647
648
649
650
651
652







-
+







	 */

	Tcl_Free(Tcl_GetHashValue(hPtr));
    }

    clLocPtr->num = num;
    memcpy(&clLocPtr->loc, loc, num*sizeof(Tcl_Size));
    clLocPtr->loc[num] = CLL_END;       /* Sentinel */
    clLocPtr->loc[num] = CLL_END;	/* Sentinel */
    Tcl_SetHashValue(hPtr, clLocPtr);

    return clLocPtr;
}

/*
 *----------------------------------------------------------------------
632
633
634
635
636
637
638
639
640


641
642
643
644
645
646
647
697
698
699
700
701
702
703


704
705
706
707
708
709
710
711
712







-
-
+
+







     */

    /*
     * First compute the range of the word within the script. (Is there a
     * better way which doesn't shimmer?)
     */

    (void)TclGetStringFromObj(objPtr, &length);
    end = start + length;       /* First char after the word */
    (void)Tcl_GetStringFromObj(objPtr, &length);
    end = start + length;	/* First char after the word */

    /*
     * Then compute the table slice covering the range of the word.
     */

    while (*wordCLLast >= 0 && *wordCLLast < end) {
	wordCLLast++;
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
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







+
+
+
+
+
+
+
+
+
+
+
+
+



















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+










+

-
+







	Tcl_Free(Tcl_GetHashValue(hPtr));
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(tsdPtr->lineCLPtr);
    Tcl_Free(tsdPtr->lineCLPtr);
    tsdPtr->lineCLPtr = NULL;
}

ObjInterface *
TclObjInterface(Tcl_Obj *objPtr) {
    ObjectType *otPtr = (ObjectType *)objPtr->typePtr;
    if (!otPtr) {
	return NULL;
    }
    if (otPtr->version < 2) {
	return NULL;
    }
    ObjInterface *ifPtr = (ObjInterface *)otPtr->ifPtr;
    return ifPtr;
}

/*
 *--------------------------------------------------------------
 *
 * Tcl_RegisterObjType --
 *
 *	This function is called to register a new Tcl object type in the table
 *	of all object types supported by Tcl.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The type is registered in the Tcl type table. If there was already a
 *	type with the same name as in typePtr, it is replaced with the new
 *	type.
 *
 *--------------------------------------------------------------
 */

int TclObjTypeVersion (
	const Tcl_ObjType *typePtr)
{
    ObjectType *otPtr = (ObjectType *)typePtr;
    if ((void *)otPtr->name == (void *)&TclObjectTypeType0) {
	return otPtr->version;
    }
    return 1;
}


const char *TclObjTypeName(
	const Tcl_ObjType *typePtr)
{
    ObjectType *otPtr = (ObjectType *)typePtr;
    return otPtr->name;
}


void
Tcl_RegisterObjType(
    const Tcl_ObjType *typePtr)	/* Information about object type; storage must
				 * be statically allocated (must live
				 * forever). */
{
    int isNew;

    Tcl_MutexLock(&tableMutex);
    const char *name = TclObjTypeName(typePtr);
    Tcl_SetHashValue(
	    Tcl_CreateHashEntry(&typeTable, typePtr->name, &isNew), typePtr);
	    Tcl_CreateHashEntry(&typeTable, name, &isNew), typePtr);
    Tcl_MutexUnlock(&tableMutex);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendAllObjTypes --
936
937
938
939
940
941
942
943

944
945
946
947
948
949
950
1034
1035
1036
1037
1038
1039
1040

1041
1042
1043
1044
1045
1046
1047
1048







-
+







    const Tcl_ObjType *typePtr)	/* The target type. */
{
    if (objPtr->typePtr == typePtr) {
	return TCL_OK;
    }

    /*
     * Use the target type's Tcl_SetFromAnyProc to set "objPtr"s internal form
     * Use the target type's setFromAnyProc to set "objPtr"s internal form
     * as appropriate for the target type. This frees the old internal
     * representation.
     */

    if (typePtr->setFromAnyProc == NULL) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
1030
1031
1032
1033
1034
1035
1036
1037

1038
1039

1040
1041
1042
1043
1044
1045
1046
1128
1129
1130
1131
1132
1133
1134

1135
1136

1137
1138
1139
1140
1141
1142
1143
1144







-
+

-
+







 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG
void
TclDbInitNewObj(
    Tcl_Obj *objPtr,
    const char *file,	/* The name of the source file calling this
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)		/* Line number in the source file; used for
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    objPtr->refCount = 0;
    objPtr->typePtr = NULL;
    TclInitEmptyStringRep(objPtr);

#if TCL_THREADS
1158
1159
1160
1161
1162
1163
1164
1165

1166
1167

1168
1169
1170
1171
1172
1173
1174
1256
1257
1258
1259
1260
1261
1262

1263
1264

1265
1266
1267
1268
1269
1270
1271
1272







-
+

-
+







 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG

Tcl_Obj *
Tcl_DbNewObj(
    const char *file,	/* The name of the source file calling this
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)		/* Line number in the source file; used for
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    Tcl_Obj *objPtr;

    /*
     * Use the macro defined in tclInt.h - it will use the correct allocator.
     */
1265
1266
1267
1268
1269
1270
1271
1272

1273
1274
1275
1276
1277
1278
1279
1363
1364
1365
1366
1367
1368
1369

1370
1371
1372
1373
1374
1375
1376
1377







-
+







 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG
void
TclFreeObj(
    Tcl_Obj *objPtr)	/* The object to be freed. */
    Tcl_Obj *objPtr)		/* The object to be freed. */
{
    const Tcl_ObjType *typePtr = objPtr->typePtr;

    /*
     * This macro declares a variable, so must come here...
     */

1390
1391
1392
1393
1394
1395
1396
1397

1398
1399
1400
1401
1402
1403
1404
1488
1489
1490
1491
1492
1493
1494

1495
1496
1497
1498
1499
1500
1501
1502







-
+







	}
    }
}
#else /* TCL_MEM_DEBUG */

void
TclFreeObj(
    Tcl_Obj *objPtr)	/* The object to be freed. */
    Tcl_Obj *objPtr)		/* The object to be freed. */
{
    /*
     * Invalidate the string rep first so we can use the bytes value for our
     * pointer chain, and signal an obj deletion (as opposed to shimmering)
     * with 'length == -1'.
     */

1511
1512
1513
1514
1515
1516
1517








1518
1519
1520
1521
1522
1523
1524
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630







+
+
+
+
+
+
+
+







/*
 *----------------------------------------------------------------------
 *
 * Tcl_DuplicateObj --
 *
 *	Create and return a new object that is a duplicate of the argument
 *	object.
 *
 * TclDuplicatePureObj --
 *	Like Tcl_DuplicateObj, except that it converts the duplicate to the
 *	specifid typ, does not duplicate the 'bytes'
 *	field unless it is necessary, i.e. the duplicated Tcl_Obj provides no
 *	updateStringProc.  This can avoid an expensive memory allocation since
 *	the data in the 'bytes' field of each Tcl_Obj must reside in allocated
 *	memory.
 *
 * Results:
 *	The return value is a pointer to a newly created Tcl_Obj. This object
 *	has reference count 0 and the same type, if any, as the source object
 *	objPtr. Also:
 *	  1) If the source object has a valid string rep, we copy it;
 *	     otherwise, the duplicate's string rep is set NULL to mark it
1533
1534
1535
1536
1537
1538
1539
1540

1541
1542
1543
1544
1545
1546
1547
1639
1640
1641
1642
1643
1644
1645

1646
1647
1648
1649
1650
1651
1652
1653







-
+







 *	objects it points to will not actually be copied but will be shared
 *	with the duplicate list. That is, the ref counts of the element
 *	objects will be incremented.
 *
 *----------------------------------------------------------------------
 */

#define SetDuplicateObj(dupPtr, objPtr)					\
#define SetDuplicateObj(dupPtr, objPtr) \
    {									\
	const Tcl_ObjType *typePtr = (objPtr)->typePtr;			\
	const char *bytes = (objPtr)->bytes;				\
	if (bytes) {							\
	    TclInitStringRep((dupPtr), bytes, (objPtr)->length);	\
	} else {							\
	    (dupPtr)->bytes = NULL;					\
1562
1563
1564
1565
1566
1567
1568











































































































1569
1570
1571
1572
1573
1574
1575
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







{
    Tcl_Obj *dupPtr;

    TclNewObj(dupPtr);
    SetDuplicateObj(dupPtr, objPtr);
    return dupPtr;
}


/*
 *----------------------------------------------------------------------
 *
 * TclDuplicatePureObj --
 *
 *	Duplicates a Tcl_Obj and converts the internal representation of the
 *	duplicate to the given type, changing neither the 'bytes' field
 *	nor the internal representation of the original object, and without
 *	duplicating the bytes field unless necessary, i.e. unless the
 *	duplicate provides no updateStringProc after conversion.  This can
 *	avoid an expensive memory allocation since the data in the 'bytes'
 *	field of each Tcl_Obj must reside in allocated memory.
 *
 * Results:
 *	A pointer to a newly-created Tcl_Obj or NULL if there was an error.
 *	This object has reference count 0.  Also:
 *
 *----------------------------------------------------------------------
 */
int SetDuplicatePureObj(
    Tcl_Interp *interp,
    Tcl_Obj *dupPtr,
    Tcl_Obj *objPtr,
    const Tcl_ObjType *typePtr)
{
    char *bytes = objPtr->bytes;
    int status = TCL_OK;
    const Tcl_ObjType *useTypePtr =
        objPtr->typePtr ? objPtr->typePtr : typePtr;

    TclInvalidateStringRep(dupPtr);
    assert(dupPtr->typePtr == NULL);

    if (objPtr->typePtr && objPtr->typePtr->dupIntRepProc) {
	objPtr->typePtr->dupIntRepProc(objPtr, dupPtr);
    } else {
	dupPtr->internalRep = objPtr->internalRep;
	dupPtr->typePtr = objPtr->typePtr;
    }

    if (typePtr != NULL && dupPtr->typePtr != useTypePtr) {
	if (bytes) {
	    dupPtr->bytes = bytes;
	    dupPtr->length = objPtr->length;
	}
	/* borrow bytes from original object */
	status = Tcl_ConvertToType(interp, dupPtr, useTypePtr);
	if (bytes) {
	    dupPtr->bytes = NULL;
	    dupPtr->length = 0;
	}
	if (status != TCL_OK) {
	    return status;
	}
    }

    /* tclStringType is treated as a special case because a Tcl_Obj having this
     * type can not always update the string representation.  This happens, for
     * example, when Tcl_GetCharLength() converts the internal representation
     * to tclStringType in order to store the number of characters, but does
     * not store enough information to generate the string representation.
     *
     * Perhaps in the future this can be remedied and this special treatment
     * removed.
     */


    if (bytes && (dupPtr->typePtr == NULL
	|| dupPtr->typePtr->updateStringProc == NULL
	|| useTypePtr == &tclStringType
	)
    ) {
	if (!TclAttemptInitStringRep(dupPtr, bytes, objPtr->length)) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"insufficient memory to initialize string", -1));
		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    }
	    status = TCL_ERROR;
	}
    }
    return status;
}

Tcl_Obj *
TclDuplicatePureObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    const Tcl_ObjType *typePtr
)		/* The object to duplicate. */
{
    int status;
    Tcl_Obj *dupPtr;

    TclNewObj(dupPtr);
    status = SetDuplicatePureObj(interp, dupPtr, objPtr, typePtr);
    if (status == TCL_OK) {
	return dupPtr;
    } else {
	Tcl_DecrRefCount(dupPtr);
	return NULL;
    }
}



void
TclSetDuplicateObj(
    Tcl_Obj *dupPtr,
    Tcl_Obj *objPtr)
{
    if (Tcl_IsShared(dupPtr)) {
1600
1601
1602
1603
1604
1605
1606
1607

1608
1609
1610
1611
1612
1613
1614
1813
1814
1815
1816
1817
1818
1819

1820
1821
1822
1823
1824
1825
1826
1827







-
+







 *
 *----------------------------------------------------------------------
 */

#undef Tcl_GetString
char *
Tcl_GetString(
    Tcl_Obj *objPtr)	/* Object whose string rep byte pointer should
    Tcl_Obj *objPtr)		/* Object whose string rep byte pointer should
				 * be returned. */
{
    if (objPtr->bytes == NULL) {
	/*
	 * Note we do not check for objPtr->typePtr == NULL.  An invariant
	 * of a properly maintained Tcl_Obj is that at least  one of
	 * objPtr->bytes and objPtr->typePtr must not be NULL.  If broken
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
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







-
+



















-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+








-
+







    }
    return objPtr->bytes;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetStringFromObj/TclGetStringFromObj --
 * Tcl_GetStringFromObj
 *
 *	Returns the string representation's byte array pointer and length for
 *	an object.
 *
 * Results:
 *	Returns a pointer to the string representation of objPtr. If lengthPtr
 *	isn't NULL, the length of the string representation is stored at
 *	*lengthPtr. The byte array referenced by the returned pointer must not
 *	be modified by the caller. Furthermore, the caller must copy the bytes
 *	if they need to retain them since the object's string rep can change
 *	as a result of other operations.
 *
 * Side effects:
 *	May call the object's updateStringProc to update the string
 *	representation from the internal representation.
 *
 *----------------------------------------------------------------------
 */

#if !defined(TCL_NO_DEPRECATED)
#undef TclGetStringFromObj
char *
TclGetStringFromObj(
    Tcl_Obj *objPtr,	/* Object whose string rep byte pointer should
				 * be returned. */
    void *lengthPtr)	/* If non-NULL, the location where the string
				 * rep's byte array length should * be stored.
				 * If NULL, no length is stored. */
{
    if (objPtr->bytes == NULL) {
	/*
	 * Note we do not check for objPtr->typePtr == NULL.  An invariant
	 * of a properly maintained Tcl_Obj is that at least  one of
	 * objPtr->bytes and objPtr->typePtr must not be NULL.  If broken
	 * extensions fail to maintain that invariant, we can crash here.
	 */

	if (objPtr->typePtr->updateStringProc == NULL) {
	    /*
	     * Those Tcl_ObjTypes which choose not to define an
	     * updateStringProc must be written in such a way that
	     * (objPtr->bytes) never becomes NULL.
	     */
	    Tcl_Panic("UpdateStringProc should not be invoked for type %s",
		    objPtr->typePtr->name);
	}
	objPtr->typePtr->updateStringProc(objPtr);
	if (objPtr->bytes == NULL || objPtr->length == TCL_INDEX_NONE
		|| objPtr->bytes[objPtr->length] != '\0') {
	    Tcl_Panic("UpdateStringProc for type '%s' "
		    "failed to create a valid string rep",
		    objPtr->typePtr->name);
	}
    }
    if (lengthPtr != NULL) {
	if (objPtr->length > INT_MAX) {
	    Tcl_Panic("Tcl_GetStringFromObj with 'int' lengthPtr"
		    " cannot handle such long strings. Please use 'Tcl_Size'");
	}
	*(int *)lengthPtr = (int)objPtr->length;
    }
    return objPtr->bytes;
}
#endif /* !defined(TCL_NO_DEPRECATED) */

#undef Tcl_GetStringFromObj
char *
Tcl_GetStringFromObj(
    Tcl_Obj *objPtr,	/* Object whose string rep byte pointer should
    Tcl_Obj *objPtr,		/* Object whose string rep byte pointer should
				 * be returned. */
    Tcl_Size *lengthPtr)	/* If non-NULL, the location where the string
				 * rep's byte array length should * be stored.
				 * If NULL, no length is stored. */
{
    if (objPtr->bytes == NULL) {
	/*
	 * Note we do not check for objPtr->typePtr == NULL.  An invariant
	 * of a properly maintained Tcl_Obj is that at least  one of
	 * of a properly maintained Tcl_Obj is that at least one of
	 * objPtr->bytes and objPtr->typePtr must not be NULL.  If broken
	 * extensions fail to maintain that invariant, we can crash here.
	 */

	if (objPtr->typePtr->updateStringProc == NULL) {
	    /*
	     * Those Tcl_ObjTypes which choose not to define an
1786
1787
1788
1789
1790
1791
1792
1793

1794
1795
1796
1797
1798
1799
1800
1952
1953
1954
1955
1956
1957
1958

1959
1960
1961
1962
1963
1964
1965
1966







-
+







 *	As described above.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_InitStringRep(
    Tcl_Obj *objPtr,	/* Object whose string rep is to be set */
    Tcl_Obj *objPtr,		/* Object whose string rep is to be set */
    const char *bytes,
    size_t numBytes)
{
    assert(objPtr->bytes == NULL || bytes == NULL);

    if (objPtr->bytes == NULL) {
	/* Start with no string rep */
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
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







-
+



















-
+







 *	the string representation NULL to mark it invalid.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_InvalidateStringRep(
    Tcl_Obj *objPtr)	/* Object whose string rep byte pointer should
    Tcl_Obj *objPtr)		/* Object whose string rep byte pointer should
				 * be freed. */
{
    TclInvalidateStringRep(objPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_HasStringRep --
 *
 *	This function reports whether object has a string representation.
 *
 * Results:
 *	Boolean.
 *----------------------------------------------------------------------
 */

int
Tcl_HasStringRep(
    Tcl_Obj *objPtr)	/* Object to test */
    Tcl_Obj *objPtr)		/* Object to test */
{
    return TclHasStringRep(objPtr);
}

/*
 *----------------------------------------------------------------------
 *
1908
1909
1910
1911
1912
1913
1914
1915


1916
1917
1918
1919
1920
1921
1922
2074
2075
2076
2077
2078
2079
2080

2081
2082
2083
2084
2085
2086
2087
2088
2089







-
+
+







 *----------------------------------------------------------------------
 */

void
Tcl_StoreInternalRep(
    Tcl_Obj *objPtr,		/* Object whose internal rep should be set. */
    const Tcl_ObjType *typePtr,	/* New type for the object */
    const Tcl_ObjInternalRep *irPtr)	/* New internalrep for the object */
    const Tcl_ObjInternalRep *irPtr)
				/* New internalrep for the object */
{
    /* Clear out any existing internalrep ( "shimmer" ) */
    TclFreeInternalRep(objPtr);

    /* When irPtr == NULL, just leave objPtr with no internalrep for typePtr */
    if (irPtr) {
	/* Copy the new internalrep into place */
1969
1970
1971
1972
1973
1974
1975
1976

1977
1978
1979
1980
1981
1982
1983
2136
2137
2138
2139
2140
2141
2142

2143
2144
2145
2146
2147
2148
2149
2150







-
+







 *	Sets typePtr field to NULL.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_FreeInternalRep(
    Tcl_Obj *objPtr)	/* Object whose internal rep should be freed. */
    Tcl_Obj *objPtr)		/* Object whose internal rep should be freed. */
{
    TclFreeInternalRep(objPtr);
}

/*
 *----------------------------------------------------------------------
 *
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
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







-


-
-
+
+

-
+



+
-
+





-
-
+
+
+
+
+





-
+
+
+



-
+
















-
+




















-
-
+
+
+
+
+



-


-
-
-
+
+
+

-
+
+







 *
 * Side effects:
 *	The internalrep of *objPtr may be changed.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_GetBoolFromObj
int
Tcl_GetBoolFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,	/* The object from which to get boolean. */
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,		/* The object from which to get boolean. */
    int flags,
    char *charPtr)	/* Place to store resulting boolean. */
    char *charPtr)		/* Place to store resulting boolean. */
{
    int result;

    if ((flags & TCL_NULL_OK)
    if ((flags & TCL_NULL_OK) && (objPtr == NULL || Tcl_GetString(objPtr)[0] == '\0')) {
	    && (objPtr == NULL || Tcl_GetString(objPtr)[0] == '\0')) {
	result = -1;
	goto boolEnd;
    } else if (objPtr == NULL) {
	if (interp) {
	    TclNewObj(objPtr);
	    TclParseNumber(interp, objPtr, (flags & TCL_NULL_OK)
		    ? "boolean value or \"\"" : "boolean value", NULL, TCL_INDEX_NONE, NULL, 0);
	    TclParseNumber(interp, objPtr,
		    (flags & TCL_NULL_OK)
			    ? "boolean value or \"\""
			    : "boolean value",
		    NULL, TCL_INDEX_NONE, NULL, 0);
	    Tcl_DecrRefCount(objPtr);
	}
	return TCL_ERROR;
    }
    do {
	if (TclHasInternalRep(objPtr, &tclIntType) || TclHasInternalRep(objPtr, &tclBooleanType)) {
	if (TclHasInternalRep(objPtr, tclIntTypePtr)
	    || TclHasInternalRep(objPtr, tclBooleanTypePtr)) {

	    result = (objPtr->internalRep.wideValue != 0);
	    goto boolEnd;
	}
	if (TclHasInternalRep(objPtr, &tclDoubleType)) {
	if (TclHasInternalRep(objPtr, tclDoubleTypePtr)) {
	    /*
	     * Caution: Don't be tempted to check directly for the "double"
	     * Tcl_ObjType and then compare the internalrep to 0.0. This isn't
	     * reliable because a "double" Tcl_ObjType can hold the NaN value.
	     * Use the API Tcl_GetDoubleFromObj, which does the checking and
	     * sets the proper error message for us.
	     */

	    double d;

	    if (Tcl_GetDoubleFromObj(interp, objPtr, &d) != TCL_OK) {
		return TCL_ERROR;
	    }
	    result = (d != 0.0);
	    goto boolEnd;
	}
	if (TclHasInternalRep(objPtr, &tclBignumType)) {
	if (TclHasInternalRep(objPtr, tclBignumTypePtr)) {
	    result = 1;
	boolEnd:
	    if (charPtr != NULL) {
		flags &= (TCL_NULL_OK-2);
		if (flags) {
		    if (flags == (int)sizeof(int)) {
			*(int *)charPtr = result;
			return TCL_OK;
		    } else if (flags == (int)sizeof(short)) {
			*(short *)charPtr = result;
			return TCL_OK;
		    } else {
			Tcl_Panic("Wrong bool var for %s", "Tcl_GetBoolFromObj");
		    }
		}
		*charPtr = result;
	    }
	    return TCL_OK;
	}
    } while ((ParseBoolean(objPtr) == TCL_OK) || (TCL_OK ==
	    TclParseNumber(interp, objPtr, (flags & TCL_NULL_OK)
		    ? "boolean value or \"\"" : "boolean value", NULL,-1,NULL,0)));
	    TclParseNumber(interp, objPtr,
		    (flags & TCL_NULL_OK)
			    ? "boolean value or \"\""
			    : "boolean value",
		    NULL, -1, NULL, 0)));
    return TCL_ERROR;
}

#undef Tcl_GetBooleanFromObj
int
Tcl_GetBooleanFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,	/* The object from which to get boolean. */
    int *intPtr)	/* Place to store resulting boolean. */
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,		/* The object from which to get boolean. */
    int *intPtr)		/* Place to store resulting boolean. */
{
    return Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof(int), (char *)(void *)intPtr);
    return Tcl_GetBoolFromObj(interp, objPtr,
	    (TCL_NULL_OK - 2) & (int) sizeof(int), (char *)(void *)intPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclSetBooleanFromAny --
 *
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
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







-
+








-
+






-
+



-
+







 *
 *----------------------------------------------------------------------
 */

int
TclSetBooleanFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr)	/* The object to convert. */
    Tcl_Obj *objPtr)		/* The object to convert. */
{
    /*
     * For some "pure" numeric Tcl_ObjTypes (no string rep), we can determine
     * whether a boolean conversion is possible without generating the string
     * rep.
     */

    if (objPtr->bytes == NULL) {
	if (TclHasInternalRep(objPtr, &tclIntType)) {
	if (TclHasInternalRep(objPtr, tclIntTypePtr)) {
	    if ((Tcl_WideUInt)objPtr->internalRep.wideValue < 2) {
		return TCL_OK;
	    }
	    goto badBoolean;
	}

	if (TclHasInternalRep(objPtr, &tclBignumType)) {
	if (TclHasInternalRep(objPtr, tclBignumTypePtr)) {
	    goto badBoolean;
	}

	if (TclHasInternalRep(objPtr, &tclDoubleType)) {
	if (TclHasInternalRep(objPtr, tclDoubleTypePtr)) {
	    goto badBoolean;
	}
    }

    if (ParseBoolean(objPtr) == TCL_OK) {
	return TCL_OK;
    }
2142
2143
2144
2145
2146
2147
2148
2149

2150
2151
2152
2153
2154
2155
2156
2317
2318
2319
2320
2321
2322
2323

2324
2325
2326
2327
2328
2329
2330
2331







-
+







	Tcl_SetErrorCode(interp, "TCL", "VALUE", "BOOLEAN", (char *)NULL);
    }
    return TCL_ERROR;
}

static int
ParseBoolean(
    Tcl_Obj *objPtr)	/* The object to parse/convert. */
    Tcl_Obj *objPtr)		/* The object to parse/convert. */
{
    int newBool;
    char lowerCase[6];
    Tcl_Size i, length;
    const char *str = Tcl_GetStringFromObj(objPtr, &length);

    if ((length < 1) || (length > 5)) {
2247
2248
2249
2250
2251
2252
2253
2254

2255
2256
2257
2258
2259
2260

2261
2262
2263
2264
2265
2266
2267
2422
2423
2424
2425
2426
2427
2428

2429
2430
2431
2432
2433
2434

2435
2436
2437
2438
2439
2440
2441
2442







-
+





-
+







     * as possible to allow the conversion code, in particular
     * Tcl_GetStringFromObj, to use that old internalRep.
     */

  goodBoolean:
    TclFreeInternalRep(objPtr);
    objPtr->internalRep.wideValue = newBool;
    objPtr->typePtr = &tclBooleanType;
    objPtr->typePtr = tclBooleanTypePtr;
    return TCL_OK;

  numericBoolean:
    TclFreeInternalRep(objPtr);
    objPtr->internalRep.wideValue = newBool;
    objPtr->typePtr = &tclIntType;
    objPtr->typePtr = tclIntTypePtr;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewDoubleObj --
2284
2285
2286
2287
2288
2289
2290
2291

2292
2293
2294
2295
2296
2297
2298
2299
2300

2301
2302
2303
2304
2305
2306
2307
2459
2460
2461
2462
2463
2464
2465

2466
2467
2468
2469
2470
2471
2472
2473
2474

2475
2476
2477
2478
2479
2480
2481
2482







-
+








-
+







 */

#ifdef TCL_MEM_DEBUG
#undef Tcl_NewDoubleObj

Tcl_Obj *
Tcl_NewDoubleObj(
    double dblValue)	/* Double used to initialize the object. */
    double dblValue)		/* Double used to initialize the object. */
{
    return Tcl_DbNewDoubleObj(dblValue, "unknown", 0);
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_NewDoubleObj(
    double dblValue)	/* Double used to initialize the object. */
    double dblValue)		/* Double used to initialize the object. */
{
    Tcl_Obj *objPtr;

    TclNewDoubleObj(objPtr, dblValue);
    return objPtr;
}
#endif /* if TCL_MEM_DEBUG */
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
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







-
+












-
+







-
+







 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG

Tcl_Obj *
Tcl_DbNewDoubleObj(
    double dblValue,	/* Double used to initialize the object. */
    double dblValue,		/* Double used to initialize the object. */
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    Tcl_Obj *objPtr;

    TclDbNewObj(objPtr, file, line);
    /* Optimized TclInvalidateStringRep() */
    objPtr->bytes = NULL;

    objPtr->internalRep.doubleValue = dblValue;
    objPtr->typePtr = &tclDoubleType;
    objPtr->typePtr = tclDoubleTypePtr;
    return objPtr;
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_DbNewDoubleObj(
    double dblValue,	/* Double used to initialize the object. */
    double dblValue,		/* Double used to initialize the object. */
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    return Tcl_NewDoubleObj(dblValue);
}
#endif /* TCL_MEM_DEBUG */

2381
2382
2383
2384
2385
2386
2387
2388
2389


2390
2391
2392
2393
2394
2395
2396
2556
2557
2558
2559
2560
2561
2562


2563
2564
2565
2566
2567
2568
2569
2570
2571







-
-
+
+







 *	rep is freed.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetDoubleObj(
    Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
    double dblValue)	/* Double used to set the object's value. */
    Tcl_Obj *objPtr,		/* Object whose internal rep to init. */
    double dblValue)		/* Double used to set the object's value. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetDoubleObj");
    }

    TclSetDoubleObj(objPtr, dblValue);
}
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
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







-
-
-
+
+
+


-
+












-
+



-
+







 *	old internal representation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetDoubleFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,	/* The object from which to get a double. */
    double *dblPtr)	/* Place to store resulting double. */
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,		/* The object from which to get a double. */
    double *dblPtr)		/* Place to store resulting double. */
{
    do {
	if (TclHasInternalRep(objPtr, &tclDoubleType)) {
	if (TclHasInternalRep(objPtr, tclDoubleTypePtr)) {
	    if (isnan(objPtr->internalRep.doubleValue)) {
		if (interp != NULL) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "floating point value is Not a Number", -1));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "DOUBLE", "NAN",
			    (char *)NULL);
		}
		return TCL_ERROR;
	    }
	    *dblPtr = (double) objPtr->internalRep.doubleValue;
	    return TCL_OK;
	}
	if (TclHasInternalRep(objPtr, &tclIntType)) {
	if (TclHasInternalRep(objPtr, tclIntTypePtr)) {
	    *dblPtr = (double) objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
	if (TclHasInternalRep(objPtr, &tclBignumType)) {
	if (TclHasInternalRep(objPtr, tclBignumTypePtr)) {
	    mp_int big;

	    TclUnpackBignum(objPtr, big);
	    *dblPtr = TclBignumToDouble(&big);
	    return TCL_OK;
	}
    } while (SetDoubleFromAny(interp, objPtr) == TCL_OK);
2469
2470
2471
2472
2473
2474
2475
2476

2477
2478
2479
2480
2481
2482
2483
2644
2645
2646
2647
2648
2649
2650

2651
2652
2653
2654
2655
2656
2657
2658







-
+







 *
 *----------------------------------------------------------------------
 */

static int
SetDoubleFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr)	/* The object to convert. */
    Tcl_Obj *objPtr)		/* The object to convert. */
{
    return TclParseNumber(interp, objPtr, "floating-point number", NULL, -1,
	    NULL, 0);
}

/*
 *----------------------------------------------------------------------
2497
2498
2499
2500
2501
2502
2503
2504

2505
2506
2507
2508
2509
2510
2511
2672
2673
2674
2675
2676
2677
2678

2679
2680
2681
2682
2683
2684
2685
2686







-
+







 *	double-to-string conversion.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfDouble(
    Tcl_Obj *objPtr)	/* Double obj with string rep to update. */
    Tcl_Obj *objPtr)		/* Double obj with string rep to update. */
{
    char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_DOUBLE_SPACE);

    TclOOM(dst, TCL_DOUBLE_SPACE + 1);

    Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, dst);
    (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst));
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547



2548
2549
2550
2551
2552
2553
2554
2713
2714
2715
2716
2717
2718
2719



2720
2721
2722
2723
2724
2725
2726
2727
2728
2729







-
-
-
+
+
+







 *	representation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetIntFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,	/* The object from which to get a int. */
    int *intPtr)	/* Place to store resulting int. */
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,		/* The object from which to get a int. */
    int *intPtr)		/* Place to store resulting int. */
{
#if (LONG_MAX == INT_MAX)
    return TclGetLongFromObj(interp, objPtr, (long *) intPtr);
#else
    long l;

    if (TclGetLongFromObj(interp, objPtr, &l) != TCL_OK) {
2563
2564
2565
2566
2567
2568
2569













2570
2571
2572
2573
2574
2575
2576
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







+
+
+
+
+
+
+
+
+
+
+
+
+







	}
	return TCL_ERROR;
    }
    *intPtr = (int) l;
    return TCL_OK;
#endif
}


int
ScalarObjInterfaceListLength(
    TCL_UNUSED(Tcl_Interp *),	/* Used to report errors if not NULL. */ \
    TCL_UNUSED(Tcl_Obj *),	/* List object whose #elements to return. */ \
    Tcl_Size *lenPtr	/* The resulting length is stored here. */
)
{
    *lenPtr = 1;
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * SetIntFromAny --
 *
 *	Attempts to force the internal representation for a Tcl object to
2610
2611
2612
2613
2614
2615
2616
2617

2618
2619
2620
2621
2622
2623
2624
2798
2799
2800
2801
2802
2803
2804

2805
2806
2807
2808
2809
2810
2811
2812







-
+







 *	int-to-string conversion.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfInt(
    Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
    Tcl_Obj *objPtr)		/* Int object whose string rep to update. */
{
    char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE);

    TclOOM(dst, TCL_INTEGER_SPACE + 1);
    (void) Tcl_InitStringRep(objPtr, NULL,
	    TclFormatInt(dst, objPtr->internalRep.wideValue));
}
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
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







-
-
-
+
+
+



-
+




-
+


















-
+








-
+







 *	any old internal representation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetLongFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,	/* The object from which to get a long. */
    long *longPtr)	/* Place to store resulting long. */
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,		/* The object from which to get a long. */
    long *longPtr)		/* Place to store resulting long. */
{
    do {
#ifdef TCL_WIDE_INT_IS_LONG
	if (TclHasInternalRep(objPtr, &tclIntType)) {
	if (TclHasInternalRep(objPtr, tclIntTypePtr)) {
	    *longPtr = objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
#else
	if (TclHasInternalRep(objPtr, &tclIntType)) {
	if (TclHasInternalRep(objPtr, tclIntTypePtr)) {
	    /*
	     * We return any integer in the range LONG_MIN to ULONG_MAX
	     * converted to a long, ignoring overflow. The rule preserves
	     * existing semantics for conversion of integers on input, but
	     * avoids inadvertent demotion of wide integers to 32-bit ones in
	     * the internal rep.
	     */

	    Tcl_WideInt w = objPtr->internalRep.wideValue;

	    if (w >= (Tcl_WideInt)(LONG_MIN)
		    && w <= (Tcl_WideInt)(ULONG_MAX)) {
		*longPtr = (long)w;
		return TCL_OK;
	    }
	    goto tooLarge;
	}
#endif
	if (TclHasInternalRep(objPtr, &tclDoubleType)) {
	if (TclHasInternalRep(objPtr, tclDoubleTypePtr)) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"expected integer but got \"%s\"",
			TclGetString(objPtr)));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (char *)NULL);
	    }
	    return TCL_ERROR;
	}
	if (TclHasInternalRep(objPtr, &tclBignumType)) {
	if (TclHasInternalRep(objPtr, tclBignumTypePtr)) {
	    /*
	     * Must check for those bignum values that can fit in a long, even
	     * when auto-narrowing is enabled. Only those values in the signed
	     * long range get auto-narrowed to tclIntType, while all the
	     * values in the unsigned long range will fit in a long.
	     */

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
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







-
-
+









-
-
+







 */

#ifdef TCL_MEM_DEBUG
#undef Tcl_NewWideIntObj

Tcl_Obj *
Tcl_NewWideIntObj(
    Tcl_WideInt wideValue)
				/* Wide integer used to initialize the new
    Tcl_WideInt wideValue)	/* Wide integer used to initialize the new
				 * object. */
{
    return Tcl_DbNewWideIntObj(wideValue, "unknown", 0);
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_NewWideIntObj(
    Tcl_WideInt wideValue)
				/* Wide integer used to initialize the new
    Tcl_WideInt wideValue)	/* Wide integer used to initialize the new
				 * object. */
{
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    TclSetIntObj(objPtr, wideValue);
    return objPtr;
2800
2801
2802
2803
2804
2805
2806
2807

2808
2809
2810
2811
2812
2813
2814
2815
2986
2987
2988
2989
2990
2991
2992

2993

2994
2995
2996
2997
2998
2999
3000







-
+
-







 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_NewWideUIntObj(
    Tcl_WideUInt uwideValue)
    Tcl_WideUInt uwideValue)	/* Wide integer used to initialize the new
				/* Wide integer used to initialize the new
				 * object. */
{
    Tcl_Obj *objPtr;

    TclNewUIntObj(objPtr, uwideValue);
    return objPtr;
}
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
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







-
-
+

















-
-
+







 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG

Tcl_Obj *
Tcl_DbNewWideIntObj(
    Tcl_WideInt wideValue,
				/* Wide integer used to initialize the new
    Tcl_WideInt wideValue,	/* Wide integer used to initialize the new
				 * object. */
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    Tcl_Obj *objPtr;

    TclDbNewObj(objPtr, file, line);
    TclSetIntObj(objPtr, wideValue);
    return objPtr;
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_DbNewWideIntObj(
    Tcl_WideInt wideValue,
				/* Long integer used to initialize the new
    Tcl_WideInt wideValue,	/* Long integer used to initialize the new
				 * object. */
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    return Tcl_NewWideIntObj(wideValue);
}
#endif /* TCL_MEM_DEBUG */
2895
2896
2897
2898
2899
2900
2901
2902
2903


2904
2905
2906
2907
2908
2909
2910
2911
3078
3079
3080
3081
3082
3083
3084


3085
3086

3087
3088
3089
3090
3091
3092
3093







-
-
+
+
-







 *	rep is freed.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetWideIntObj(
    Tcl_Obj *objPtr,	/* Object w. internal rep to init. */
    Tcl_WideInt wideValue)
    Tcl_Obj *objPtr,		/* Object w. internal rep to init. */
    Tcl_WideInt wideValue)	/* Wide integer used to initialize the
				/* Wide integer used to initialize the
				 * object's value. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetWideIntObj");
    }

    TclSetIntObj(objPtr, wideValue);
2927
2928
2929
2930
2931
2932
2933
2934
2935


2936
2937
2938
2939
2940
2941
2942
2943
3109
3110
3111
3112
3113
3114
3115


3116
3117

3118
3119
3120
3121
3122
3123
3124







-
-
+
+
-







 *	rep is freed.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetWideUIntObj(
    Tcl_Obj *objPtr,	/* Object w. internal rep to init. */
    Tcl_WideUInt uwideValue)
    Tcl_Obj *objPtr,		/* Object w. internal rep to init. */
    Tcl_WideUInt uwideValue)	/* Wide integer used to initialize the
				/* Wide integer used to initialize the
				 * object's value. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetWideUIntObj");
    }

    if (uwideValue > WIDE_MAX) {
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
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







-
-
-
+
+
+
-


-
+



-
+








-
+












-
+
+







 *	any old internal representation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetWideIntFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,	/* Object from which to get a wide int. */
    Tcl_WideInt *wideIntPtr)
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,		/* Object from which to get a wide int. */
    Tcl_WideInt *wideIntPtr)	/* Place to store resulting long. */
				/* Place to store resulting long. */
{
    do {
	if (TclHasInternalRep(objPtr, &tclIntType)) {
	if (TclHasInternalRep(objPtr, tclIntTypePtr)) {
	    *wideIntPtr = objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
	if (TclHasInternalRep(objPtr, &tclDoubleType)) {
	if (TclHasInternalRep(objPtr, tclDoubleTypePtr)) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"expected integer but got \"%s\"",
			TclGetString(objPtr)));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (char *)NULL);
	    }
	    return TCL_ERROR;
	}
	if (TclHasInternalRep(objPtr, &tclBignumType)) {
	if (TclHasInternalRep(objPtr, tclBignumTypePtr)) {
	    /*
	     * Must check for those bignum values that can fit in a
	     * Tcl_WideInt, even when auto-narrowing is enabled.
	     */

	    mp_int big;
	    Tcl_WideUInt value = 0;
	    size_t numBytes;
	    Tcl_WideInt scratch;
	    unsigned char *bytes = (unsigned char *) &scratch;

	    TclUnpackBignum(objPtr, big);
	    if (mp_to_ubin(&big, bytes, sizeof(Tcl_WideInt), &numBytes) == MP_OKAY) {
	    if (mp_to_ubin(&big, bytes, sizeof(Tcl_WideInt),
		    &numBytes) == MP_OKAY) {
		while (numBytes-- > 0) {
		    value = (value << CHAR_BIT) | *bytes++;
		}
		if (big.sign) {
		    if (value <= 1 + ~(Tcl_WideUInt)WIDE_MIN) {
			*wideIntPtr = (Tcl_WideInt)(-value);
			return TCL_OK;
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
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







-
-
-
+
+
+
-


-
+













-
+


-
+















-
+
+







 *	any old internal representation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetWideUIntFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,	/* Object from which to get a wide int. */
    Tcl_WideUInt *wideUIntPtr)
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,		/* Object from which to get a wide int. */
    Tcl_WideUInt *wideUIntPtr)	/* Place to store resulting long. */
				/* Place to store resulting long. */
{
    do {
	if (TclHasInternalRep(objPtr, &tclIntType)) {
	if (TclHasInternalRep(objPtr, tclIntTypePtr)) {
	    if (objPtr->internalRep.wideValue < 0) {
	wideUIntOutOfRange:
		if (interp != NULL) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "expected unsigned integer but got \"%s\"",
			    TclGetString(objPtr)));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (char *)NULL);
		}
		return TCL_ERROR;
	    }
	    *wideUIntPtr = (Tcl_WideUInt)objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
	if (TclHasInternalRep(objPtr, &tclDoubleType)) {
	if (TclHasInternalRep(objPtr, tclDoubleTypePtr)) {
	    goto wideUIntOutOfRange;
	}
	if (TclHasInternalRep(objPtr, &tclBignumType)) {
	if (TclHasInternalRep(objPtr, tclBignumTypePtr)) {
	    /*
	     * Must check for those bignum values that can fit in a
	     * Tcl_WideUInt, even when auto-narrowing is enabled.
	     */

	    mp_int big;
	    Tcl_WideUInt value = 0;
	    size_t numBytes;
	    Tcl_WideUInt scratch;
	    unsigned char *bytes = (unsigned char *) &scratch;

	    TclUnpackBignum(objPtr, big);
	    if (big.sign == MP_NEG) {
		goto wideUIntOutOfRange;
	    }
	    if (mp_to_ubin(&big, bytes, sizeof(Tcl_WideUInt), &numBytes) == MP_OKAY) {
	    if (mp_to_ubin(&big, bytes, sizeof(Tcl_WideUInt),
		    &numBytes) == MP_OKAY) {
		while (numBytes-- > 0) {
		    value = (value << CHAR_BIT) | *bytes++;
		}
		*wideUIntPtr = (Tcl_WideUInt)value;
		return TCL_OK;
	    }

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
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







-
-
-
+
+
+


-
+



-
+








-
+







 *	conversion will free any old internal representation.
 *
 *----------------------------------------------------------------------
 */

int
TclGetWideBitsFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,            /* Object from which to get a wide int. */
    Tcl_WideInt *wideIntPtr)    /* Place to store resulting wide integer. */
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,		/* Object from which to get a wide int. */
    Tcl_WideInt *wideIntPtr)	/* Place to store resulting wide integer. */
{
    do {
	if (TclHasInternalRep(objPtr, &tclIntType)) {
	if (TclHasInternalRep(objPtr, tclIntTypePtr)) {
	    *wideIntPtr = objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
	if (TclHasInternalRep(objPtr, &tclDoubleType)) {
	if (TclHasInternalRep(objPtr, tclDoubleTypePtr)) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"expected integer but got \"%s\"",
			TclGetString(objPtr)));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (char *)NULL);
	    }
	    return TCL_ERROR;
	}
	if (TclHasInternalRep(objPtr, &tclBignumType)) {
	if (TclHasInternalRep(objPtr, tclBignumTypePtr)) {
	    mp_int big;
	    mp_err err;

	    Tcl_WideUInt value = 0, scratch;
	    size_t numBytes;
	    unsigned char *bytes = (unsigned char *) &scratch;

3204
3205
3206
3207
3208
3209
3210
3211
3212
3213



3214
3215
3216
3217
3218
3219
3220
3385
3386
3387
3388
3389
3390
3391



3392
3393
3394
3395
3396
3397
3398
3399
3400
3401







-
-
-
+
+
+







 * Side effects:
 *	The function may free up any existing internal representation.
 *
 *----------------------------------------------------------------------
 */
int
Tcl_GetSizeIntFromObj(
    Tcl_Interp *interp, /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,	/* The object from which to get a int. */
    Tcl_Size *sizePtr)  /* Place to store resulting int. */
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,		/* The object from which to get a int. */
    Tcl_Size *sizePtr)		/* Place to store resulting int. */
{
    if (sizeof(Tcl_Size) == sizeof(int)) {
	return TclGetIntFromObj(interp, objPtr, (int *)sizePtr);
    } else {
	Tcl_WideInt wide;
	if (TclGetWideIntFromObj(interp, objPtr, &wide) != TCL_OK) {
	    return TCL_ERROR;
3271
3272
3273
3274
3275
3276
3277
3278

3279
3280
3281
3282
3283
3284
3285
3452
3453
3454
3455
3456
3457
3458

3459
3460
3461
3462
3463
3464
3465
3466







-
+







DupBignum(
    Tcl_Obj *srcPtr,
    Tcl_Obj *copyPtr)
{
    mp_int bignumVal;
    mp_int bignumCopy;

    copyPtr->typePtr = &tclBignumType;
    copyPtr->typePtr = tclBignumTypePtr;
    TclUnpackBignum(srcPtr, bignumVal);
    if (mp_init_copy(&bignumCopy, &bignumVal) != MP_OKAY) {
	Tcl_Panic("initialization failure in DupBignum");
    }
    PACK_BIGNUM(bignumCopy, copyPtr);
}

3441
3442
3443
3444
3445
3446
3447
3448

3449
3450
3451
3452
3453
3454
3455
3622
3623
3624
3625
3626
3627
3628

3629
3630
3631
3632
3633
3634
3635
3636







-
+







GetBignumFromObj(
    Tcl_Interp *interp,		/* Tcl interpreter for error reporting */
    Tcl_Obj *objPtr,		/* Object to read */
    int copy,			/* Whether to copy the returned bignum value */
    mp_int *bignumValue)	/* Returned bignum value. */
{
    do {
	if (TclHasInternalRep(objPtr, &tclBignumType)) {
	if (TclHasInternalRep(objPtr, tclBignumTypePtr)) {
	    if (copy || Tcl_IsShared(objPtr)) {
		mp_int temp;

		TclUnpackBignum(objPtr, temp);
		if (mp_init_copy(bignumValue, &temp) != MP_OKAY) {
		    return TCL_ERROR;
		}
3466
3467
3468
3469
3470
3471
3472
3473

3474
3475
3476
3477
3478
3479
3480

3481
3482
3483
3484
3485
3486
3487
3647
3648
3649
3650
3651
3652
3653

3654
3655
3656
3657
3658
3659
3660

3661
3662
3663
3664
3665
3666
3667
3668







-
+






-
+







		 */
		if (objPtr->bytes == NULL) {
		    TclInitEmptyStringRep(objPtr);
		}
	    }
	    return TCL_OK;
	}
	if (TclHasInternalRep(objPtr, &tclIntType)) {
	if (TclHasInternalRep(objPtr, tclIntTypePtr)) {
	    if (mp_init_i64(bignumValue,
		    objPtr->internalRep.wideValue) != MP_OKAY) {
		return TCL_ERROR;
	    }
	    return TCL_OK;
	}
	if (TclHasInternalRep(objPtr, &tclDoubleType)) {
	if (TclHasInternalRep(objPtr, tclDoubleTypePtr)) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"expected integer but got \"%s\"",
			TclGetString(objPtr)));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (char *)NULL);
	    }
	    return TCL_ERROR;
3516
3517
3518
3519
3520
3521
3522
3523

3524
3525
3526
3527
3528
3529
3530
3697
3698
3699
3700
3701
3702
3703

3704
3705
3706
3707
3708
3709
3710
3711







-
+







 *----------------------------------------------------------------------
 */

int
Tcl_GetBignumFromObj(
    Tcl_Interp *interp,		/* Tcl interpreter for error reporting */
    Tcl_Obj *objPtr,		/* Object to read */
    void *bignumValue)	/* Returned bignum value. */
    void *bignumValue)		/* Returned bignum value. */
{
    return GetBignumFromObj(interp, objPtr, 1, (mp_int *)bignumValue);
}

/*
 *----------------------------------------------------------------------
 *
3551
3552
3553
3554
3555
3556
3557
3558

3559
3560
3561
3562
3563
3564
3565
3732
3733
3734
3735
3736
3737
3738

3739
3740
3741
3742
3743
3744
3745
3746







-
+







 *----------------------------------------------------------------------
 */

int
Tcl_TakeBignumFromObj(
    Tcl_Interp *interp,		/* Tcl interpreter for error reporting */
    Tcl_Obj *objPtr,		/* Object to read */
    void *bignumValue)	/* Returned bignum value. */
    void *bignumValue)		/* Returned bignum value. */
{
    return GetBignumFromObj(interp, objPtr, 0, (mp_int *)bignumValue);
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
+



















-
+


-
-
+
+
-
-
+


-
-
+
+













-
+








-
+




-
+










-
+









-
-
-
+
+
+
+
+
+





-
+








void
TclSetBignumInternalRep(
    Tcl_Obj *objPtr,
    void *big)
{
    mp_int *bignumValue = (mp_int *)big;
    objPtr->typePtr = &tclBignumType;
    objPtr->typePtr = tclBignumTypePtr;
    PACK_BIGNUM(*bignumValue, objPtr);

    /*
     * Clear the mp_int value.
     *
     * Don't call mp_clear() because it would free the digit array we just
     * packed into the Tcl_Obj.
     */

    bignumValue->dp = NULL;
    bignumValue->alloc = bignumValue->used = 0;
    bignumValue->sign = MP_NEG;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetNumberFromObj --
 *
 *      Extracts a number (of any possible numeric type) from an object.
 *	Extracts a number (of any possible numeric type) from an object.
 *
 * Results:
 *      Whether the extraction worked. The type is stored in the variable
 *      referred to by the typePtr argument, and a pointer to the
 *      A standard Tcl completion code.  On success, the type is stored at the
 *      address given by typePtr, and a pointer to the representation is stored
 *      representation is stored in the variable referred to by the
 *      clientDataPtr.
 *      at the address given by clientDataPtr.
 *
 * Side effects:
 *      Can allocate thread-specific data for handling the copy-out space for
 *      bignums; this space is shared within a thread.
 *      May allocate thread-specific data shared within a thread for handling
 *      the copy-out space for bignums.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetNumberFromObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    void **clientDataPtr,
    int *typePtr)
{
    Tcl_Size length;
    do {
	if (TclHasInternalRep(objPtr, &tclDoubleType)) {
	if (TclHasInternalRep(objPtr, tclDoubleTypePtr)) {
	    if (isnan(objPtr->internalRep.doubleValue)) {
		*typePtr = TCL_NUMBER_NAN;
	    } else {
		*typePtr = TCL_NUMBER_DOUBLE;
	    }
	    *clientDataPtr = &objPtr->internalRep.doubleValue;
	    return TCL_OK;
	}
	if (TclHasInternalRep(objPtr, &tclIntType)) {
	if (TclHasInternalRep(objPtr, tclIntTypePtr)) {
	    *typePtr = TCL_NUMBER_INT;
	    *clientDataPtr = &objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
	if (TclHasInternalRep(objPtr, &tclBignumType)) {
	if (TclHasInternalRep(objPtr, tclBignumTypePtr)) {
	    static Tcl_ThreadDataKey bignumKey;
	    mp_int *bigPtr = (mp_int *)Tcl_GetThreadData(&bignumKey,
		    sizeof(mp_int));

	    TclUnpackBignum(objPtr, *bigPtr);
	    *typePtr = TCL_NUMBER_BIG;
	    *clientDataPtr = bigPtr;
	    return TCL_OK;
	}
	/* Handle dict separately, because it doesn't have a lengthProc */
	if (TclHasInternalRep(objPtr, &tclDictType)) {
	if (TclHasInternalRep(objPtr, tclDictTypePtr)) {
	    Tcl_DictObjSize(NULL, objPtr, &length);
	    if (length > 1) {
	    listRep:
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj("expected number but got a list", -1));
		}
		return TCL_ERROR;
	    }
	}
	Tcl_ObjTypeLengthProc *lengthProc = TclObjTypeHasProc(objPtr, lengthProc);
	if (lengthProc && lengthProc(objPtr) != 1) {
	    goto listRep;
	if (TclObjectHasInterface(objPtr ,list ,length)) {
	    int status;
	    status = Tcl_ListObjLength(interp ,objPtr ,&length);
	    if (!status && length != 1) {
		goto listRep;
	    }
	}
    } while (TCL_OK ==
	    TclParseNumber(interp, objPtr, "number", NULL, -1, NULL, 0));
    /* Don't try to convert index or boolean's to a list */
    if (!TclHasInternalRep(objPtr, &tclIndexType)
	    && !TclHasInternalRep(objPtr, &tclBooleanType)
	    && !TclHasInternalRep(objPtr, tclBooleanTypePtr)
	    && (TCL_OK == Tcl_ListObjLength(NULL, objPtr, &length)) && (length > 1)) {
	goto listRep;
    }
    return TCL_ERROR;
}

int
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
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
3999







-
+
+




















-
+
+







 *
 *----------------------------------------------------------------------
 */

#undef Tcl_IncrRefCount
void
Tcl_IncrRefCount(
    Tcl_Obj *objPtr)	/* The object we are registering a reference to. */
    Tcl_Obj *objPtr)		/* The object we are registering a reference
				 * to. */
{
    ++(objPtr)->refCount;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DecrRefCount --
 *
 *	Decrements the reference count of the object.
 *
 * Results:
 *	The storage for objPtr may be freed.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_DecrRefCount
void
Tcl_DecrRefCount(
    Tcl_Obj *objPtr)	/* The object we are releasing a reference to. */
    Tcl_Obj *objPtr)		/* The object we are releasing a reference
				 * to. */
{
    if (objPtr->refCount-- <= 1) {
	TclFreeObj(objPtr);
    }
}

/*
3822
3823
3824
3825
3826
3827
3828
3829


3830
3831
3832
3833
3834
3835
3836
4007
4008
4009
4010
4011
4012
4013

4014
4015
4016
4017
4018
4019
4020
4021
4022







-
+
+







 *	possibly with a refCount of 0.  The caller must have previously
 *	incremented the refCount.
 *
 *----------------------------------------------------------------------
 */
void
TclUndoRefCount(
    Tcl_Obj *objPtr)	/* The object we are releasing a reference to. */
    Tcl_Obj *objPtr)		/* The object we are releasing a reference
				 * to. */
{
    if (objPtr->refCount > 0) {
	--objPtr->refCount;
    }
}

/*
3845
3846
3847
3848
3849
3850
3851
3852

3853
3854
3855
3856
3857
3858
3859
4031
4032
4033
4034
4035
4036
4037

4038
4039
4040
4041
4042
4043
4044
4045







-
+







 *
 *----------------------------------------------------------------------
 */

#undef Tcl_IsShared
int
Tcl_IsShared(
    Tcl_Obj *objPtr)	/* The object to test for being shared. */
    Tcl_Obj *objPtr)		/* The object to test for being shared. */
{
    return ((objPtr)->refCount > 1);
}

/*
 *----------------------------------------------------------------------
 *
3874
3875
3876
3877
3878
3879
3880
3881

3882
3883
3884
3885
3886
3887
3888
4060
4061
4062
4063
4064
4065
4066

4067
4068
4069
4070
4071
4072
4073
4074







-
+







 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG
void
Tcl_DbIncrRefCount(
    Tcl_Obj *objPtr,	/* The object we are registering a reference
    Tcl_Obj *objPtr,		/* The object we are registering a reference
				 * to. */
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    if (objPtr->refCount == FREEDREFCOUNTFILLER) {
3914
3915
3916
3917
3918
3919
3920
3921

3922
3923
3924
3925
3926
3927
3928
4100
4101
4102
4103
4104
4105
4106

4107
4108
4109
4110
4111
4112
4113
4114







-
+







    }
# endif /* TCL_THREADS */
    ++(objPtr)->refCount;
}
#else /* !TCL_MEM_DEBUG */
void
Tcl_DbIncrRefCount(
    Tcl_Obj *objPtr,	/* The object we are registering a reference
    Tcl_Obj *objPtr,		/* The object we are registering a reference
				 * to. */
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    ++(objPtr)->refCount;
}
#endif /* TCL_MEM_DEBUG */
3947
3948
3949
3950
3951
3952
3953
3954

3955
3956
3957
3958
3959
3960
3961
4133
4134
4135
4136
4137
4138
4139

4140
4141
4142
4143
4144
4145
4146
4147







-
+







 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG
void
Tcl_DbDecrRefCount(
    Tcl_Obj *objPtr,	/* The object we are releasing a reference
    Tcl_Obj *objPtr,		/* The object we are releasing a reference
				 * to. */
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    if (objPtr->refCount == FREEDREFCOUNTFILLER) {
3990
3991
3992
3993
3994
3995
3996
3997

3998
3999
4000
4001
4002
4003
4004
4176
4177
4178
4179
4180
4181
4182

4183
4184
4185
4186
4187
4188
4189
4190







-
+







    if (objPtr->refCount-- <= 1) {
	TclFreeObj(objPtr);
    }
}
#else /* !TCL_MEM_DEBUG */
void
Tcl_DbDecrRefCount(
    Tcl_Obj *objPtr,	/* The object we are releasing a reference
    Tcl_Obj *objPtr,		/* The object we are releasing a reference
				 * to. */
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    if (objPtr->refCount-- <= 1) {
	TclFreeObj(objPtr);
    }
4024
4025
4026
4027
4028
4029
4030
4031

4032
4033
4034
4035
4036
4037
4038
4210
4211
4212
4213
4214
4215
4216

4217
4218
4219
4220
4221
4222
4223
4224







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_DbIsShared(
    Tcl_Obj *objPtr,	/* The object to test for being shared. */
    Tcl_Obj *objPtr,		/* The object to test for being shared. */
#ifdef TCL_MEM_DEBUG
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
#else
    TCL_UNUSED(const char *) /*file*/,
4101
4102
4103
4104
4105
4106
4107
4108
4109

4110
4111
4112
4113
4114
4115
4116
4287
4288
4289
4290
4291
4292
4293


4294
4295
4296
4297
4298
4299
4300
4301







-
-
+







 *	Tcl_CreateHashEntry.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_InitObjHashTable(
    Tcl_HashTable *tablePtr)
				/* Pointer to table record, which is supplied
    Tcl_HashTable *tablePtr)	/* Pointer to table record, which is supplied
				 * by the caller. */
{
    Tcl_InitCustomHashTable(tablePtr, TCL_CUSTOM_PTR_KEYS,
	    &tclObjHashKeyType);
}

/*
4324
4325
4326
4327
4328
4329
4330
4331

4332
4333
4334
4335
4336
4337
4338
4509
4510
4511
4512
4513
4514
4515

4516
4517
4518
4519
4520
4521
4522
4523







-
+







 *----------------------------------------------------------------------
 */

Tcl_Command
Tcl_GetCommandFromObj(
    Tcl_Interp *interp,		/* The interpreter in which to resolve the
				 * command and to report errors. */
    Tcl_Obj *objPtr)	/* The object containing the command's name.
    Tcl_Obj *objPtr)		/* The object containing the command's name.
				 * If the name starts with "::", will be
				 * looked up in global namespace. Else, looked
				 * up first in the current namespace, then in
				 * global namespace. */
{
    ResolvedCmdName *resPtr;

4460
4461
4462
4463
4464
4465
4466
4467

4468
4469
4470
4471
4472
4473
4474
4645
4646
4647
4648
4649
4650
4651

4652
4653
4654
4655
4656
4657
4658
4659







-
+







    }
}

void
TclSetCmdNameObj(
    Tcl_Interp *interp,		/* Points to interpreter containing command
				 * that should be cached in objPtr. */
    Tcl_Obj *objPtr,	/* Points to Tcl object to be changed to a
    Tcl_Obj *objPtr,		/* Points to Tcl object to be changed to a
				 * CmdName object. */
    Command *cmdPtr)		/* Points to Command structure that the
				 * CmdName object should refer to. */
{
    ResolvedCmdName *resPtr;

    if (TclHasInternalRep(objPtr, &tclCmdNameType)) {
4500
4501
4502
4503
4504
4505
4506
4507

4508
4509
4510
4511
4512
4513
4514
4685
4686
4687
4688
4689
4690
4691

4692
4693
4694
4695
4696
4697
4698
4699







-
+







 *	ResolvedSymbol, which may free the Command structure.
 *
 *----------------------------------------------------------------------
 */

static void
FreeCmdNameInternalRep(
    Tcl_Obj *objPtr)	/* CmdName object with internal
    Tcl_Obj *objPtr)		/* CmdName object with internal
				 * representation to free. */
{
    ResolvedCmdName *resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1;

	/*
	 * Decrement the reference count of the ResolvedCmdName structure. If
	 * there are no more uses, free the ResolvedCmdName structure.
4548
4549
4550
4551
4552
4553
4554
4555

4556
4557
4558
4559
4560
4561
4562
4563

































4564
4565
4566
4567
4568
4569
4570
4733
4734
4735
4736
4737
4738
4739

4740
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788







-
+








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *
 *----------------------------------------------------------------------
 */

static void
DupCmdNameInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    ResolvedCmdName *resPtr = (ResolvedCmdName *)srcPtr->internalRep.twoPtrValue.ptr1;

    copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;
    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
	resPtr->refCount++;
    copyPtr->typePtr = &tclCmdNameType;
}


static int
ScalarObjIndex(
    TCL_UNUSED(Tcl_Interp *),/* Used to report errors if not NULL. */ \
    Tcl_Obj *listPtr,	/* List object to index into. */ \
    Tcl_Size index,	/* Index of element to return. */ \
    Tcl_Obj **resPtrPtr	/* The resulting Tcl_Obj* is stored here. */
) {
    if (index == 0) {
	*resPtrPtr = listPtr;
    } else {
	*resPtrPtr = NULL;
    }
    return TCL_OK;
}

static int ScalarObjRange(
    TCL_UNUSED(Tcl_Interp *),/* Used to report errors */ \
    Tcl_Obj *listPtr,	    /* List object to take a range from. */ \
    Tcl_Size rangeStart,    /* Index of first element to */ \
			    /* include. */ \
    Tcl_Size rangeEnd,	    /* Index of last element to include. */
    Tcl_Obj **resPtrPtr
)
{
    if (rangeEnd >= 0 && rangeEnd >= rangeStart) {
	*resPtrPtr = listPtr;
    } else {
	*resPtrPtr = NULL;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * SetCmdNameFromAny --
 *
 *	Generate an cmdName internal form for the Tcl object "objPtr".
4582
4583
4584
4585
4586
4587
4588
4589

4590
4591
4592
4593
4594
4595
4596
4800
4801
4802
4803
4804
4805
4806

4807
4808
4809
4810
4811
4812
4813
4814







-
+







 *
 *----------------------------------------------------------------------
 */

static int
SetCmdNameFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr)	/* The object to convert. */
    Tcl_Obj *objPtr)		/* The object to convert. */
{
    const char *name;
    Command *cmdPtr;
    ResolvedCmdName *resPtr;

    if (interp == NULL) {
	return TCL_ERROR;
4669
4670
4671
4672
4673
4674
4675



4676
4677
4678
4679




4680
4681
4682

4683
4684

4685
4686
4687
4688


4689
4690
4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701
4702
4703


























4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4887
4888
4889
4890
4891
4892
4893
4894
4895
4896




4897
4898
4899
4900
4901
4902

4903
4904

4905
4906
4907


4908
4909
4910
4911
4912
4913
4914
4915
4916
4917
4918
4919
4920
4921
4922
4923
4924
4925
4926
4927
4928
4929
4930
4931
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943
4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
4954
4955
4956
4957
4958
4959
4960







+
+
+
-
-
-
-
+
+
+
+


-
+

-
+


-
-
+
+















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+











    /*
     * Value is a bignum with a refcount of 14, object pointer at 0x12345678,
     * internal representation 0x45671234:0x98765432, string representation
     * "1872361827361287"
     */

    const char *name = objv[1]->typePtr
	?  TclObjTypeName(objv[1]->typePtr)
	: "pure string";
    descObj = Tcl_ObjPrintf("value is a %s with a refcount of %" TCL_SIZE_MODIFIER "d,"
	    " object pointer at %p",
	    objv[1]->typePtr ? objv[1]->typePtr->name : "pure string",
	    objv[1]->refCount, objv[1]);
    descObj = Tcl_ObjPrintf("value is a %s with a refcount of %"
	TCL_SIZE_MODIFIER "d," " object pointer at %p"
	,name
	,objv[1]->refCount, objv[1]);

    if (objv[1]->typePtr) {
	if (TclHasInternalRep(objv[1], &tclDoubleType)) {
	if (TclHasInternalRep(objv[1], tclDoubleTypePtr)) {
	    Tcl_AppendPrintfToObj(descObj, ", internal representation %g",
		    objv[1]->internalRep.doubleValue);
		objv[1]->internalRep.doubleValue);
	} else {
	    Tcl_AppendPrintfToObj(descObj, ", internal representation %p:%p",
		    (void *) objv[1]->internalRep.twoPtrValue.ptr1,
		    (void *) objv[1]->internalRep.twoPtrValue.ptr2);
		(void *) objv[1]->internalRep.twoPtrValue.ptr1,
		(void *) objv[1]->internalRep.twoPtrValue.ptr2);
	}
    }

    if (objv[1]->bytes) {
	Tcl_AppendToObj(descObj, ", string representation \"", -1);
	Tcl_AppendLimitedToObj(descObj, objv[1]->bytes, objv[1]->length,
		16, "...");
	Tcl_AppendToObj(descObj, "\"", -1);
    } else {
	Tcl_AppendToObj(descObj, ", no string representation", -1);
    }

    Tcl_SetObjResult(interp, descObj);
    return TCL_OK;
}


void Tcl_ObjTypeVersion(Tcl_Obj *objPtr, int *version) {
    if ((void *)objPtr->typePtr->name == (void *)&TclObjectTypeType0) {
	*version = ((ObjectType *)objPtr->typePtr)->version;
    } else {
	*version = 1;
    }
    return;
}


TclObjectTypeType * TclGetObjectTypeType () {
	return &TclObjectTypeType0;
}


int (*TclObjInterfaceGetListIndex (Tcl_Obj *objPtr))
(tclObjTypeInterfaceArgsListIndex)
{
	ObjInterface *ifPtr = TclObjInterface(objPtr);
	if (ifPtr->version >= 1) {
		return ifPtr->list.index;
	}
	return NULL;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */
Added generic/tclObjInterface.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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * Copyright © 2024 Nathan Coulter.  All rights reserved.
 *
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 *----------------------------------------------------------------------
 * Tcl_NewObjInterface
 *----------------------------------------------------------------------
 */

#include "tcl.h"
#include "tclInt.h"


Tcl_ObjInterface *
Tcl_NewObjInterface() {
	ObjInterface * ifacePtr;
	ifacePtr = (ObjInterface *)Tcl_Alloc(sizeof(ObjInterface));
	memset(ifacePtr ,0 ,sizeof(ObjInterface));
	return (Tcl_ObjInterface *)ifacePtr;
}

Tcl_ObjType *
Tcl_NewObjType(
) {
	ObjectType *objTypePtr;
	objTypePtr = (ObjectType *)Tcl_Alloc(sizeof(ObjectType));
	return (Tcl_ObjType *)objTypePtr;
}


int
Tcl_ObjInterfaceSetFnListAll(
	Tcl_ObjInterface *objInterfacePtr
	,Tcl_ObjInterfaceListAllProc fnPtr
) {
	ObjInterface *oiPtr = (ObjInterface *)objInterfacePtr;
	oiPtr->list.all = fnPtr;
	return TCL_OK;
}


int
Tcl_ObjInterfaceSetFnListAppend(
	Tcl_ObjInterface *objInterfacePtr
	,Tcl_ObjInterfaceListAppendProc fnPtr)
{
	ObjInterface *oiPtr = (ObjInterface *)objInterfacePtr;
	oiPtr->list.append = fnPtr;
	return TCL_OK;
}


int
Tcl_ObjInterfaceSetFnListAppendList(
	Tcl_ObjInterface *objInterfacePtr
	,Tcl_ObjInterfaceListAppendlistProc fnPtr
) {
	ObjInterface *oiPtr = (ObjInterface *)objInterfacePtr;
	oiPtr->list.appendlist = fnPtr;
	return TCL_OK;
}


int
Tcl_ObjInterfaceSetFnListContains(
	Tcl_ObjInterface *objInterfacePtr
	,Tcl_ObjInterfaceListContainsProc fnPtr
) {
	ObjInterface *oiPtr = (ObjInterface *)objInterfacePtr;
	oiPtr->list.contains = fnPtr;
	return TCL_OK;
}


int
Tcl_ObjInterfaceSetFnListIndex(
	Tcl_ObjInterface *objInterfacePtr
	,Tcl_ObjInterfaceListIndexProc fnPtr
) {
	ObjInterface *oiPtr = (ObjInterface *)objInterfacePtr;
	oiPtr->list.index = fnPtr;
	return TCL_OK;
}


int
Tcl_ObjInterfaceSetFnListIndexEnd(
	Tcl_ObjInterface *objInterfacePtr
	,Tcl_ObjInterfaceListIndexEndProc fnPtr
) {
	ObjInterface *oiPtr = (ObjInterface *)objInterfacePtr;
	oiPtr->list.indexEnd = fnPtr;
	return TCL_OK;
}


int
Tcl_ObjInterfaceSetFnListIsSorted(
	Tcl_ObjInterface *objInterfacePtr
	,Tcl_ObjInterfaceListIsSortedProc fnPtr
) {
	ObjInterface *oiPtr = (ObjInterface *)objInterfacePtr;
	oiPtr->list.isSorted = fnPtr;
	return TCL_OK;
}


int
Tcl_ObjInterfaceSetFnListLength(
	Tcl_ObjInterface *objInterfacePtr
	,Tcl_ObjInterfaceListLengthProc fnPtr)
{
	ObjInterface *oiPtr = (ObjInterface *)objInterfacePtr;
	oiPtr->list.length = fnPtr;
	return TCL_OK;
}


int
Tcl_ObjInterfaceSetFnListRange(
	Tcl_ObjInterface *objInterfacePtr
	,Tcl_ObjInterfaceListRangeProc fnPtr)
{
	ObjInterface *oiPtr = (ObjInterface *)objInterfacePtr;
	oiPtr->list.range = fnPtr;
	return TCL_OK;
}


int
Tcl_ObjInterfaceSetFnListRangeEnd(
	Tcl_ObjInterface *objInterfacePtr
	,Tcl_ObjInterfaceListRangeEndProc fnPtr
) {
	ObjInterface *oiPtr = (ObjInterface *)objInterfacePtr;
	oiPtr->list.rangeEnd = fnPtr;
	return TCL_OK;
}


int
Tcl_ObjInterfaceSetFnListReplace(
	Tcl_ObjInterface *objInterfacePtr
	,Tcl_ObjInterfaceListReplaceProc fnPtr)
{
	ObjInterface *oiPtr = (ObjInterface *)objInterfacePtr;
	oiPtr->list.replace = fnPtr;
	return TCL_OK;
}

int Tcl_ObjInterfaceSetFnListReplaceList(
	Tcl_ObjInterface *objInterfacePtr
	,Tcl_ObjInterfaceListReplaceListProc fnPtr)
{
	ObjInterface *oiPtr = (ObjInterface *)objInterfacePtr;
	oiPtr->list.replaceList = fnPtr;
	return TCL_OK;
}


int
Tcl_ObjInterfaceSetFnListReverse(
	Tcl_ObjInterface *objInterfacePtr
	,Tcl_ObjInterfaceListReverseProc fnPtr)
{
	ObjInterface *oiPtr = (ObjInterface *)objInterfacePtr;
	oiPtr->list.reverse = fnPtr;
	return TCL_OK;
}

int
Tcl_ObjInterfaceSetFnListSet(
	Tcl_ObjInterface *objInterfacePtr
	,Tcl_ObjInterfaceListSetProc fnPtr)
{
	ObjInterface *oiPtr = (ObjInterface *)objInterfacePtr;
	oiPtr->list.set = fnPtr;
	return TCL_OK;
}


int
Tcl_ObjInterfaceSetFnListSetDeep(
	Tcl_ObjInterface *objInterfacePtr
	,Tcl_ObjInterfaceListSetDeepProc fnPtr)
{
	ObjInterface *oiPtr = (ObjInterface *)objInterfacePtr;
	oiPtr->list.setDeep = fnPtr;
	return TCL_OK;
}


int
Tcl_ObjInterfaceSetFnStringIndex(
	Tcl_ObjInterface *objInterfacePtr
	,Tcl_ObjInterfaceStringIndexProc fnPtr)
{
	ObjInterface *oiPtr = (ObjInterface *)objInterfacePtr;
	oiPtr->string.index = fnPtr;
	return TCL_OK;
}


int
Tcl_ObjInterfaceSetFnStringIndexEnd(
	Tcl_ObjInterface *objInterfacePtr
	,Tcl_ObjInterfaceStringIndexEndProc fnPtr)
{
	ObjInterface *oiPtr = (ObjInterface *)objInterfacePtr;
	oiPtr->string.indexEnd = fnPtr;
	return TCL_OK;
}


int
Tcl_ObjInterfaceSetFnStringIsEmpty(
	Tcl_ObjInterface *objInterfacePtr
	,Tcl_ObjInterfaceStringIsEmptyProc fnPtr)
{
	ObjInterface *oiPtr = (ObjInterface *)objInterfacePtr;
	oiPtr->string.isEmpty = fnPtr;
	return TCL_OK;
}


int
Tcl_ObjInterfaceSetFnStringLength(
	Tcl_ObjInterface *objInterfacePtr
	,Tcl_ObjInterfaceStringLengthProc fnPtr)
{
	ObjInterface *oiPtr = (ObjInterface *)objInterfacePtr;
	oiPtr->string.length = fnPtr;
	return TCL_OK;
}


int
Tcl_ObjInterfaceSetFnStringRange(
	Tcl_ObjInterface *objInterfacePtr
	,Tcl_ObjInterfaceStringRangeProc fnPtr)
{
	ObjInterface *oiPtr = (ObjInterface *)objInterfacePtr;
	oiPtr->string.range = fnPtr;
	return TCL_OK;
}


int
Tcl_ObjInterfaceSetFnStringRangeEnd(
	Tcl_ObjInterface *objInterfacePtr
	,Tcl_ObjInterfaceStringRangeEndProc fnPtr)
{
	ObjInterface *oiPtr = (ObjInterface *)objInterfacePtr;
	oiPtr->string.rangeEnd = fnPtr;
	return TCL_OK;
}


int
Tcl_ObjInterfaceSetVersion(
	Tcl_ObjInterface *objInterfacePtr
	,int version
) {
	ObjInterface *oiPtr = (ObjInterface *)objInterfacePtr;
	oiPtr->version = version;
	return TCL_OK;
}


int
Tcl_ObjTypeSetFreeInternalRepProc(
	Tcl_ObjType *otPtr
	,Tcl_FreeInternalRepProc *freeIntRepProc
) {
	otPtr->freeIntRepProc = freeIntRepProc;
	return TCL_OK;
}


int
Tcl_ObjTypeSetDupInternalRepProc(
	Tcl_ObjType *otPtr
	,Tcl_DupInternalRepProc *dupIntRepProc)
{
	otPtr->dupIntRepProc = dupIntRepProc;
	return TCL_OK;
}


int
Tcl_ObjTypeSetInterface(
	Tcl_ObjType *objTypePtr
	,Tcl_ObjInterface * objInterfacePtr)
{
	ObjectType *otPtr = (ObjectType *)objTypePtr;
	otPtr->ifPtr = objInterfacePtr;
	return TCL_OK;
}


int
Tcl_ObjTypeSetUpdateStringProc(
	Tcl_ObjType *otPtr
	,Tcl_UpdateStringProc *updateStringProc)
{
	otPtr->updateStringProc = updateStringProc;
	return TCL_OK;
}


int
Tcl_ObjTypeSetSetFromAnyProc(
	Tcl_ObjType *otPtr
	,Tcl_SetFromAnyProc *setFromAnyProc)
{
	otPtr->setFromAnyProc = setFromAnyProc;
	return TCL_OK;
}


int
Tcl_ObjTypeSetName(
	Tcl_ObjType *otPtr
	,char *name)
{
	otPtr->name = name;
	return TCL_OK;
}


int
Tcl_ObjTypeSetVersion(
	Tcl_ObjType *otPtr
	,int version)
{
	otPtr->version = version;
	return TCL_OK;
}
Changes to generic/tclOptimize.c.
1
2
3
4
5
6
7
8
9
10
11















12
13
14
15
16
17
18
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

-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclOptimize.c --
 *
 *	This file contains the bytecode optimizer.
 *
 * Copyright © 2013 Donal Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclOptimize.c --
 *
 *	This file contains the bytecode optimizer.
 */

#include "tclInt.h"
#include "tclCompile.h"
#include <assert.h>

/*
 * Forward declarations.
 */
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
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







-
+














-
+







		blank = size + InstLength(nextInst);
	    } else if (nextInst == INST_STR_CONCAT1
		    && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) {
		Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
			TclGetUInt1AtPtr(currentInstPtr + 1));
		Tcl_Size numBytes;

		(void) TclGetStringFromObj(litPtr, &numBytes);
		(void) Tcl_GetStringFromObj(litPtr, &numBytes);
		if (numBytes == 0) {
		    blank = size + InstLength(nextInst);
		}
	    }
	    break;
	case INST_PUSH4:
	    if (nextInst == INST_POP) {
		blank = size + 1;
	    } else if (nextInst == INST_STR_CONCAT1
		    && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) {
		Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
			TclGetUInt4AtPtr(currentInstPtr + 1));
		Tcl_Size numBytes;

		(void) TclGetStringFromObj(litPtr, &numBytes);
		(void) Tcl_GetStringFromObj(litPtr, &numBytes);
		if (numBytes == 0) {
		    blank = size + InstLength(nextInst);
		}
	    }
	    break;

	case INST_LNOT:
Changes to generic/tclPanic.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

















16
17
18
19
20
21
22
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

-
-
-
-
-
-








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclPanic.c --
 *
 *	Source code for the "Tcl_Panic" library procedure for Tcl; individual
 *	applications will probably call Tcl_SetPanicProc() to set an
 *	application-specific panic procedure.
 *
 * Copyright © 1988-1993 The Regents of the University of California.
 * Copyright © 1994 Sun Microsystems, Inc.
 * Copyright © 1998-1999 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclPanic.c --
 *
 *	Source code for the "Tcl_Panic" library procedure for Tcl; individual
 *	applications will probably call Tcl_SetPanicProc() to set an
 *	application-specific panic procedure.
 */

#include "tclInt.h"
#if defined(_WIN32) || defined(__CYGWIN__)
    MODULE_SCOPE void tclWinDebugPanic(const char *format, ...);
#endif

/*
 * The panicProc variable contains a pointer to an application specific panic
Changes to generic/tclParse.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

















16
17
18
19
20
21
22
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

-
-
-
-
-
-








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclParse.c --
 *
 *	This file contains functions that parse Tcl scripts. They do so in a
 *	general-purpose fashion that can be used for many different purposes,
 *	including compilation, direct execution, code analysis, etc.
 *
 * Copyright © 1997 Sun Microsystems, Inc.
 * Copyright © 1998-2000 Ajuba Solutions.
 * Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclParse.c --
 *
 *	This file contains functions that parse Tcl scripts. They do so in a
 *	general-purpose fashion that can be used for many different purposes,
 *	including compilation, direct execution, code analysis, etc.
 */

#include "tclInt.h"
#include "tclParse.h"
#include <assert.h>

/*
 * The following table provides parsing information about each possible 8-bit
 * character. The table is designed to be referenced with unsigned characters.
201
202
203
204
205
206
207
208
209

210
211
212
213
214
215
216
212
213
214
215
216
217
218


219
220
221
222
223
224
225
226







-
-
+







    Tcl_Size numBytes,		/* Total number of bytes in string. If -1,
				 * the script consists of all bytes up to the
				 * first null character. */
    int nested,			/* Non-zero means this is a nested command:
				 * close bracket should be considered a
				 * command terminator. If zero, then close
				 * bracket has no special meaning. */
    Tcl_Parse *parsePtr)
				/* Structure to fill in with information about
    Tcl_Parse *parsePtr)	/* Structure to fill in with information about
				 * the parsed command; any previous
				 * information in the structure is ignored. */
{
    const char *src;		/* Points to current character in the
				 * command. */
    char type;			/* Result returned by CHAR_TYPE(*src). */
    Tcl_Token *tokenPtr;	/* Pointer to token being filled in. */
527
528
529
530
531
532
533
534

535
536
537
538
539
540
541
537
538
539
540
541
542
543

544
545
546
547
548
549
550
551







-
+







	} else if ((tokenPtr->numComponents == 1)
		&& (tokenPtr[1].type == TCL_TOKEN_TEXT)) {
	    tokenPtr->type = TCL_TOKEN_SIMPLE_WORD;
	}

	/* Parse the whitespace between words. */

	scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type);
	scanned = ParseWhiteSpace(src, numBytes, &parsePtr->incomplete, &type);
	src += scanned;
	numBytes -= scanned;
    }
}

/*
 *----------------------------------------------------------------------
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
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







-
+

-
-
+
+
+
+
+
+




+
-
+












-
+







	src++;
	numBytes--;
	tokenPtr->type = TCL_TOKEN_TEXT;
	tokenPtr->start = src;
	tokenPtr->numComponents = 0;

	ch = *src;
	while (numBytes && (braceCount>0 || ch != '}')) {
	while (numBytes && (braceCount > 0 || ch != '}')) {
	    switch (ch) {
	    case '{': braceCount++; break;
	    case '}': braceCount--; break;
	    case '{':
		braceCount++;
		break;
	    case '}':
		braceCount--;
		break;
	    case '\\':
		/* if 2 or more left, consume 2, else consume
		 * just the \ and let it run into the end */
		if (numBytes > 1) {
		   src++;
		   src++; numBytes--;
		   numBytes--;
		}
	    }
	    numBytes--;
	    src++;
	    ch= *src;
	}
	if (numBytes == 0) {
	    if (parsePtr->interp != NULL) {
		Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
			"missing close-brace for variable name", -1));
	    }
	    parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE;
	    parsePtr->term = tokenPtr->start-1;
	    parsePtr->term = tokenPtr->start - 1;
	    parsePtr->incomplete = 1;
	    goto error;
	}
	tokenPtr->size = src - tokenPtr->start;
	tokenPtr[-1].size = src - tokenPtr[-1].start;
	parsePtr->numTokens++;
	src++;
1615
1616
1617
1618
1619
1620
1621
1622
1623

1624
1625
1626
1627
1628
1629
1630
1630
1631
1632
1633
1634
1635
1636


1637
1638
1639
1640
1641
1642
1643
1644







-
-
+







    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
				 * NULL, then no error message is provided. */
    const char *start,		/* Start of string enclosed in braces. The
				 * first character must be {'. */
    Tcl_Size numBytes,		/* Total number of bytes in string. If -1,
				 * the string consists of all bytes up to the
				 * first null character. */
    Tcl_Parse *parsePtr,
				/* Structure to fill in with information about
    Tcl_Parse *parsePtr,	/* Structure to fill in with information about
				 * the string. */
    int append,			/* Non-zero means append tokens to existing
				 * information in parsePtr; zero means ignore
				 * existing tokens in parsePtr and
				 * reinitialize it. */
    const char **termPtr)	/* If non-NULL, points to word in which to
				 * store a pointer to the character just after
1816
1817
1818
1819
1820
1821
1822
1823
1824

1825
1826
1827
1828
1829
1830
1831
1830
1831
1832
1833
1834
1835
1836


1837
1838
1839
1840
1841
1842
1843
1844







-
-
+







    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
				 * NULL, then no error message is provided. */
    const char *start,		/* Start of the quoted string. The first
				 * character must be '"'. */
    Tcl_Size numBytes,		/* Total number of bytes in string. If -1,
				 * the string consists of all bytes up to the
				 * first null character. */
    Tcl_Parse *parsePtr,
				/* Structure to fill in with information about
    Tcl_Parse *parsePtr,	/* Structure to fill in with information about
				 * the string. */
    int append,			/* Non-zero means append tokens to existing
				 * information in parsePtr; zero means ignore
				 * existing tokens in parsePtr and
				 * reinitialize it. */
    const char **termPtr)	/* If non-NULL, points to word in which to
				 * store a pointer to the character just after
2202
2203
2204
2205
2206
2207
2208
2209

2210
2211
2212
2213
2214
2215
2216
2215
2216
2217
2218
2219
2220
2221

2222
2223
2224
2225
2226
2227
2228
2229







-
+







		    && (tokenPtr->start[1] == '\n')) {
		if (isLiteral) {
		    Tcl_Size clPos;

		    if (result == 0) {
			clPos = 0;
		    } else {
			(void)TclGetStringFromObj(result, &clPos);
			(void)Tcl_GetStringFromObj(result, &clPos);
		    }

		    if (numCL >= maxNumCL) {
			maxNumCL *= 2;
			clPosition = (Tcl_Size *)Tcl_Realloc(clPosition,
				maxNumCL * sizeof(Tcl_Size));
		    }
2478
2479
2480
2481
2482
2483
2484
2485

2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2491
2492
2493
2494
2495
2496
2497

2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509







-
+












int
TclObjCommandComplete(
    Tcl_Obj *objPtr)		/* Points to object holding script to
				 * check. */
{
    Tcl_Size length;
    const char *script = TclGetStringFromObj(objPtr, &length);
    const char *script = Tcl_GetStringFromObj(objPtr, &length);

    return CommandComplete(script, length);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclParse.h.









1
2
3
4
5
6
7
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
+
+
+
+
+
+
+
+
+







/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * Minimal set of shared flag definitions and declarations so that multiple
 * source files can make use of the parsing table in tclParse.c
 */

enum ParseTypeFlags {
    TYPE_NORMAL = 0,
Changes to generic/tclPathObj.c.
















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
-
-







/*
 * Copyright © 2003 Vince Darley.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclPathObj.c --
 *
 *	This file contains the implementation of Tcl's "path" object type used
 *	to represent and manipulate a general (virtual) filesystem entity in
 *	an efficient manner.
 *
 * Copyright © 2003 Vince Darley.
 *
 * 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 "tclFileSystem.h"
#include <assert.h>

/*
41
42
43
44
45
46
47
48

49
50
51
52
53
54
55
52
53
54
55
56
57
58

59
60
61
62
63
64
65
66







-
+








static const Tcl_ObjType fsPathType = {
    "path",			/* name */
    FreeFsPathInternalRep,	/* freeIntRepProc */
    DupFsPathInternalRep,	/* dupIntRepProc */
    UpdateStringOfFsPath,	/* updateStringProc */
    SetFsPathFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V0
	0
};

/*
 * struct FsPath --
 *
 * Internal representation of a Tcl_Obj of fsPathType
 */
86
87
88
89
90
91
92
93

94
95
96
97
98
99
100
97
98
99
100
101
102
103

104
105
106
107
108
109
110
111







-
+








/*
 * Define some macros to give us convenient access to path-object specific
 * fields.
 */

#define PATHOBJ(pathPtr) ((FsPath *) (TclFetchInternalRep((pathPtr), &fsPathType)->twoPtrValue.ptr1))
#define SETPATHOBJ(pathPtr,fsPathPtr) \
#define SETPATHOBJ(pathPtr, fsPathPtr) \
	do {							\
		Tcl_ObjInternalRep ir;				\
		ir.twoPtrValue.ptr1 = (void *) (fsPathPtr);	\
		ir.twoPtrValue.ptr2 = NULL;			\
		Tcl_StoreInternalRep((pathPtr), &fsPathType, &ir);	\
	} while (0)
#define PATHFLAGS(pathPtr) (PATHOBJ(pathPtr)->flags)
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
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







-
-
-
-
+
+
+
+



-
-
-
-
+
+
+
+







    if (zipVolumeLen) {
	/*
	 * NOTE: file normalization for zipfs is very specific to
	 * format of zipfs volume being of the form //xxx:/
	 */
	dirSep += zipVolumeLen-1; /* Start parse after : */
    } else if (tclPlatform == TCL_PLATFORM_WINDOWS) {
	if (   (dirSep[0] == '/' || dirSep[0] == '\\')
	    && (dirSep[1] == '/' || dirSep[1] == '\\')
	    && (dirSep[2] == '?')
	    && (dirSep[3] == '/' || dirSep[3] == '\\')) {
	if ((dirSep[0] == '/' || dirSep[0] == '\\')
		&& (dirSep[1] == '/' || dirSep[1] == '\\')
		&& (dirSep[2] == '?')
		&& (dirSep[3] == '/' || dirSep[3] == '\\')) {
	    /* NT extended path */
	    dirSep += 4;

	    if (   (dirSep[0] == 'U' || dirSep[0] == 'u')
		&& (dirSep[1] == 'N' || dirSep[1] == 'n')
		&& (dirSep[2] == 'C' || dirSep[2] == 'c')
		&& (dirSep[3] == '/' || dirSep[3] == '\\')) {
	    if ((dirSep[0] == 'U' || dirSep[0] == 'u')
		    && (dirSep[1] == 'N' || dirSep[1] == 'n')
		    && (dirSep[2] == 'C' || dirSep[2] == 'c')
		    && (dirSep[3] == '/' || dirSep[3] == '\\')) {
		/* NT extended UNC path */
		dirSep += 4;
	    }
	}
	if (dirSep[0] != 0 && dirSep[1] == ':' &&
		(dirSep[2] == '/' || dirSep[2] == '\\')) {
	    /* Do nothing */
220
221
222
223
224
225
226
227

228
229
230
231
232
233
234
231
232
233
234
235
236
237

238
239
240
241
242
243
244
245







-
+







		Tcl_Size curLen;

		if (retVal == NULL) {
		    const char *path = TclGetString(pathPtr);
		    retVal = Tcl_NewStringObj(path, dirSep - path);
		    Tcl_IncrRefCount(retVal);
		}
		(void)TclGetStringFromObj(retVal, &curLen);
		(void)Tcl_GetStringFromObj(retVal, &curLen);
		if (curLen == 0) {
		    Tcl_AppendToObj(retVal, dirSep, 1);
		}
		dirSep += 2;
		oldDirSep = dirSep;
		if (dirSep[0] != 0 && dirSep[1] == '.') {
		    goto again;
246
247
248
249
250
251
252
253

254
255
256
257
258
259
260
257
258
259
260
261
262
263

264
265
266
267
268
269
270
271







-
+








		if (retVal == NULL) {
		    const char *path = TclGetString(pathPtr);

		    retVal = Tcl_NewStringObj(path, dirSep - path);
		    Tcl_IncrRefCount(retVal);
		}
		(void)TclGetStringFromObj(retVal, &curLen);
		(void)Tcl_GetStringFromObj(retVal, &curLen);
		if (curLen == 0) {
		    Tcl_AppendToObj(retVal, dirSep, 1);
		}
		if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) {
		    if (zipVolumeLen) {
			linkObj = NULL;
		    } else {
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
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







-
+














-
+












-
+
















-
+







			    /*
			     * We need to follow this link which is relative
			     * to retVal's directory. This means concatenating
			     * the link onto the directory of the path so far.
			     */

			    const char *path =
				    TclGetStringFromObj(retVal, &curLen);
				    Tcl_GetStringFromObj(retVal, &curLen);

			    while (curLen-- > 0) {
				if (IsSeparatorOrNull(path[curLen])) {
				    break;
				}
			    }

			    /*
			     * We want the trailing slash.
			     */

			    Tcl_SetObjLength(retVal, curLen+1);
			    Tcl_AppendObjToObj(retVal, linkObj);
			    TclDecrRefCount(linkObj);
			    linkStr = TclGetStringFromObj(retVal, &curLen);
			    linkStr = Tcl_GetStringFromObj(retVal, &curLen);
			} else {
			    /*
			     * Absolute link.
			     */

			    TclDecrRefCount(retVal);
			    if (Tcl_IsShared(linkObj)) {
				retVal = Tcl_DuplicateObj(linkObj);
				TclDecrRefCount(linkObj);
			    } else {
				retVal = linkObj;
			    }
			    linkStr = TclGetStringFromObj(retVal, &curLen);
			    linkStr = Tcl_GetStringFromObj(retVal, &curLen);

			    /*
			     * Convert to forward-slashes on windows.
			     */

			    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
				Tcl_Size i;

				for (i = 0; i < curLen; i++) {
				    if (linkStr[i] == '\\') {
					linkStr[i] = '/';
				    }
				}
			    }
			}
		    } else {
			linkStr = TclGetStringFromObj(retVal, &curLen);
			linkStr = Tcl_GetStringFromObj(retVal, &curLen);
		    }

		    /*
		     * Either way, we now remove the last path element (but
		     * not the first character of the path). In the case of
		     * zipfs, make sure not to go beyond the zipfs volume.
		     */
399
400
401
402
403
404
405
406

407
408
409
410
411
412
413
410
411
412
413
414
415
416

417
418
419
420
421
422
423
424







-
+







    /*
     * Ensure a windows drive like C:/ has a trailing separator.
     * Likewise for zipfs volumes.
     */
    if (zipVolumeLen || (tclPlatform == TCL_PLATFORM_WINDOWS)) {
	int needTrailingSlash = 0;
	Tcl_Size len;
	const char *path = TclGetStringFromObj(retVal, &len);
	const char *path = Tcl_GetStringFromObj(retVal, &len);
	if (zipVolumeLen) {
	    if (len == (zipVolumeLen - 1)) {
		needTrailingSlash = 1;
	    }
	} else {
	    if (len == 2 && path[0] != 0 && path[1] == ':') {
		needTrailingSlash = 1;
581
582
583
584
585
586
587
588

589
590
591
592
593
594
595
592
593
594
595
596
597
598

599
600
601
602
603
604
605
606







-
+







		 * it. If so, the 'dirname' would be a joining of the main
		 * part with the dirname of the joined-on bit. We could handle
		 * that special case here, but we don't, and instead just use
		 * the standardPath code.
		 */

		Tcl_Size numBytes;
		const char *rest = TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes);
		const char *rest = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes);

		if (strchr(rest, '/') != NULL) {
		    goto standardPath;
		}
		/*
		 * If the joined-on bit is empty, then [file dirname] is
		 * documented to return all but the last non-empty element
618
619
620
621
622
623
624
625

626
627
628
629
630
631
632
629
630
631
632
633
634
635

636
637
638
639
640
641
642
643







-
+







		 * Check if the joined-on bit has any directory delimiters in
		 * it. If so, the 'tail' would be only the part following the
		 * last delimiter. We could handle that special case here, but
		 * we don't, and instead just use the standardPath code.
		 */

		Tcl_Size numBytes;
		const char *rest = TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes);
		const char *rest = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes);

		if (strchr(rest, '/') != NULL) {
		    goto standardPath;
		}
		/*
		 * If the joined-on bit is empty, then [file tail] is
		 * documented to return the last non-empty element
647
648
649
650
651
652
653
654

655
656
657
658
659
660
661
658
659
660
661
662
663
664

665
666
667
668
669
670
671
672







-
+







	    }
	    case TCL_PATH_EXTENSION:
		return GetExtension(fsPathPtr->normPathPtr);
	    case TCL_PATH_ROOT: {
		const char *fileName, *extension;
		Tcl_Size length;

		fileName = TclGetStringFromObj(fsPathPtr->normPathPtr,
		fileName = Tcl_GetStringFromObj(fsPathPtr->normPathPtr,
			&length);
		extension = TclGetExtension(fileName);
		if (extension == NULL) {
		    /*
		     * There is no extension so the root is the same as the
		     * path we were given.
		     */
699
700
701
702
703
704
705
706

707
708
709
710
711
712
713
710
711
712
713
714
715
716

717
718
719
720
721
722
723
724







-
+







	resultPtr = NULL;
	if (portion == TCL_PATH_EXTENSION) {
	    return GetExtension(pathPtr);
	} else if (portion == TCL_PATH_ROOT) {
	    Tcl_Size length;
	    const char *fileName, *extension;

	    fileName = TclGetStringFromObj(pathPtr, &length);
	    fileName = Tcl_GetStringFromObj(pathPtr, &length);
	    extension = TclGetExtension(fileName);
	    if (extension == NULL) {
		Tcl_IncrRefCount(pathPtr);
		return pathPtr;
	    } else {
		Tcl_Obj *root = Tcl_NewStringObj(fileName,
			length - strlen(extension));
722
723
724
725
726
727
728
729

730
731
732
733
734
735
736
733
734
735
736
737
738
739

740
741
742
743
744
745
746
747







-
+







	 * Tcl_FSSplitPath preserves the "~",  but this code computes the
	 * actual full path name, if we had just a single component.
	 */

	splitPtr = Tcl_FSSplitPath(pathPtr, &splitElements);
	Tcl_IncrRefCount(splitPtr);

        if (portion == TCL_PATH_TAIL) {
	if (portion == TCL_PATH_TAIL) {
	    /*
	     * Return the last component, unless it is the only component, and
	     * it is the root of an absolute path.
	     */

	    if ((splitElements > 0) && ((splitElements > 1) ||
		    (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE))) {
879
880
881
882
883
884
885
886

887
888
889
890
891
892
893
890
891
892
893
894
895
896

897
898
899
900
901
902
903
904







-
+







	    /* if forceRelative - second path is relative */
	    type = forceRelative ? TCL_PATH_RELATIVE :
		    TclGetPathType(tailObj, NULL, NULL, NULL);
	    if (type == TCL_PATH_RELATIVE) {
		const char *str;
		Tcl_Size len;

		str = TclGetStringFromObj(tailObj, &len);
		str = Tcl_GetStringFromObj(tailObj, &len);
		if (len == 0) {
		    /*
		     * This happens if we try to handle the root volume '/'.
		     * There's no need to return a special path object, when
		     * the base itself is just fine!
		     */

951
952
953
954
955
956
957
958

959
960
961
962
963
964
965
962
963
964
965
966
967
968

969
970
971
972
973
974
975
976







-
+







	Tcl_Size driveNameLength;
	Tcl_Size strEltLen, length;
	Tcl_PathType type;
	char *strElt, *ptr;
	Tcl_Obj *driveName = NULL;
	Tcl_Obj *elt = objv[i];

	strElt = TclGetStringFromObj(elt, &strEltLen);
	strElt = Tcl_GetStringFromObj(elt, &strEltLen);
	driveNameLength = 0;
	/* if forceRelative - all paths excepting first one are relative */
	type = (forceRelative && (i > 0)) ? TCL_PATH_RELATIVE :
		TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName);
	if (type != TCL_PATH_RELATIVE) {
	    /*
	     * Zero out the current result.
1048
1049
1050
1051
1052
1053
1054
1055

1056
1057
1058


1059
1060
1061
1062
1063
1064
1065
1059
1060
1061
1062
1063
1064
1065

1066
1067


1068
1069
1070
1071
1072
1073
1074
1075
1076







-
+

-
-
+
+







	 * We need to perform a more complex operation here.
	 */

    noQuickReturn:
	if (res == NULL) {
	    TclNewObj(res);
	}
	ptr = TclGetStringFromObj(res, &length);
	ptr = Tcl_GetStringFromObj(res, &length);

        /*
         * A NULL value for fsPtr at this stage basically means we're trying
	/*
	 * A NULL value for fsPtr at this stage basically means we're trying
	 * to join a relative path onto something which is also relative (or
	 * empty). There's nothing particularly wrong with that.
	 */

	if (*strElt == '\0') {
	    continue;
	}
1083
1084
1085
1086
1087
1088
1089
1090

1091
1092
1093
1094
1095
1096
1097
1094
1095
1096
1097
1098
1099
1100

1101
1102
1103
1104
1105
1106
1107
1108







-
+







		    res = Tcl_DuplicateObj(res);
		    Tcl_IncrRefCount(res);
		}
	    }

	    if (length > 0 && ptr[length -1] != '/') {
		Tcl_AppendToObj(res, &separator, 1);
		(void)TclGetStringFromObj(res, &length);
		(void)Tcl_GetStringFromObj(res, &length);
	    }
	    Tcl_SetObjLength(res, length + strlen(strElt));

	    ptr = TclGetString(res) + length;
	    for (; *strElt != '\0'; strElt++) {
		if (*strElt == separator) {
		    while (strElt[1] == separator) {
1348
1349
1350
1351
1352
1353
1354
1355

1356
1357
1358
1359
1360
1361
1362
1359
1360
1361
1362
1363
1364
1365

1366
1367
1368
1369
1370
1371
1372
1373







-
+







     * This is likely buggy when dealing with virtual filesystem drivers
     * that use some character other than "/" as a path separator.  I know
     * of no evidence that such a foolish thing exists.  This solution was
     * chosen so that "JoinPath" operations that pass through either path
     * internalrep produce the same results; that is, bugward compatibility.  If
     * we need to fix that bug here, it needs fixing in TclJoinPath() too.
     */
    bytes = TclGetStringFromObj(tail, &length);
    bytes = Tcl_GetStringFromObj(tail, &length);
    if (length == 0) {
	Tcl_AppendToObj(copy, "/", 1);
    } else {
	TclpNativeJoinPath(copy, bytes);
    }
    return copy;
}
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
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







-
+



















-
+







     * better test than the '!= sep' might be to simply check if 'cwd' is a
     * root volume.
     *
     * Note that if we get this wrong, we will strip off either too much or
     * too little below, leading to wrong answers returned by glob.
     */

    tempStr = TclGetStringFromObj(cwdPtr, &cwdLen);
    tempStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);

    /*
     * Should we perhaps use 'Tcl_FSPathSeparator'? But then what about the
     * Windows special case? Perhaps we should just check if cwd is a root
     * volume.
     */

    switch (tclPlatform) {
    case TCL_PLATFORM_UNIX:
	if (tempStr[cwdLen-1] != '/') {
	    cwdLen++;
	}
	break;
    case TCL_PLATFORM_WINDOWS:
	if (tempStr[cwdLen-1] != '/' && tempStr[cwdLen-1] != '\\') {
	    cwdLen++;
	}
	break;
    }
    tempStr = TclGetStringFromObj(pathPtr, &len);
    tempStr = Tcl_GetStringFromObj(pathPtr, &len);

    return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen);
}

/*
 *---------------------------------------------------------------------------
 *
1653
1654
1655
1656
1657
1658
1659
1660

1661
1662
1663
1664
1665
1666
1667
1664
1665
1666
1667
1668
1669
1670

1671
1672
1673
1674
1675
1676
1677
1678







-
+







    Tcl_Interp *interp,
    Tcl_Obj *pathPtr)
{
    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);

    if (transPtr != NULL) {
	Tcl_Size len;
	const char *orig = TclGetStringFromObj(transPtr, &len);
	const char *orig = Tcl_GetStringFromObj(transPtr, &len);
	char *result = (char *)Tcl_Alloc(len+1);

	memcpy(result, orig, len+1);
	TclDecrRefCount(transPtr);
	return result;
    }

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
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







-
+












-
+







	dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr);
	if (dir == NULL) {
	    return NULL;
	}
	/* TODO: Figure out why this is needed. */
	TclGetString(pathPtr);

	(void)TclGetStringFromObj(fsPathPtr->normPathPtr, &tailLen);
	(void)Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &tailLen);
	if (tailLen) {
	    copy = AppendPath(dir, fsPathPtr->normPathPtr);
	} else {
	    copy = Tcl_DuplicateObj(dir);
	}
	Tcl_IncrRefCount(dir);
	Tcl_IncrRefCount(copy);

	/*
	 * We now own a reference on both 'dir' and 'copy'
	 */

	(void) TclGetStringFromObj(dir, &cwdLen);
	(void) Tcl_GetStringFromObj(dir, &cwdLen);

	/* Normalize the combined string. */

	if (PATHFLAGS(pathPtr) & TCLPATH_NEEDNORM) {
	    /*
	     * If the "tail" part has components (like /../) that cause the
	     * combined path to need more complete normalizing, call on the
1809
1810
1811
1812
1813
1814
1815
1816

1817
1818
1819
1820
1821
1822
1823
1820
1821
1822
1823
1824
1825
1826

1827
1828
1829
1830
1831
1832
1833
1834







-
+







	    fsPathPtr = PATHOBJ(pathPtr);
	} else if (fsPathPtr->normPathPtr == NULL) {
	    Tcl_Size cwdLen;
	    Tcl_Obj *copy;

	    copy = AppendPath(fsPathPtr->cwdPtr, pathPtr);

	    (void) TclGetStringFromObj(fsPathPtr->cwdPtr, &cwdLen);
	    (void) Tcl_GetStringFromObj(fsPathPtr->cwdPtr, &cwdLen);
	    cwdLen += (TclGetString(copy)[cwdLen] == '/');

	    /*
	     * Normalize the combined string, but only starting after the end
	     * of the previously normalized 'dir'. This should be much faster!
	     */

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
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







-
-
+
+


















-
-
+
+







    if (firstPtr == secondPtr) {
	return 1;
    }

    if (firstPtr == NULL || secondPtr == NULL) {
	return 0;
    }
    firstStr = TclGetStringFromObj(firstPtr, &firstLen);
    secondStr = TclGetStringFromObj(secondPtr, &secondLen);
    firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen);
    secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
    if ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen)) {
	return 1;
    }

    /*
     * Try the most thorough, correct method of comparing fully normalized
     * paths.
     */

    tempErrno = Tcl_GetErrno();
    firstPtr = Tcl_FSGetNormalizedPath(NULL, firstPtr);
    secondPtr = Tcl_FSGetNormalizedPath(NULL, secondPtr);
    Tcl_SetErrno(tempErrno);

    if (firstPtr == NULL || secondPtr == NULL) {
	return 0;
    }

    firstStr = TclGetStringFromObj(firstPtr, &firstLen);
    secondStr = TclGetStringFromObj(secondPtr, &secondLen);
    firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen);
    secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
    return ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen));
}

/*
 *---------------------------------------------------------------------------
 *
 * SetFsPathFromAny --
2216
2217
2218
2219
2220
2221
2222
2223

2224
2225
2226
2227
2228
2229
2230
2227
2228
2229
2230
2231
2232
2233

2234
2235
2236
2237
2238
2239
2240
2241







-
+







     * We remove any trailing directory separator.
     *
     * However, the split/join routines are quite complex, and one has to make
     * sure not to break anything on Unix or Win (fCmd.test, fileName.test and
     * cmdAH.test exercise most of the code).
     */

    TclGetStringFromObj(pathPtr, &len); /* TODO: Is this needed? */
    Tcl_GetStringFromObj(pathPtr, &len); /* TODO: Is this needed? */
    transPtr = TclJoinPath(1, &pathPtr, 1);

    /*
     * Now we have a translated filename in 'transPtr'. This will have forward
     * slashes on Windows, and will not contain any ~user sequences.
     */

2365
2366
2367
2368
2369
2370
2371
2372

2373
2374
2375
2376
2377
2378
2379
2376
2377
2378
2379
2380
2381
2382

2383
2384
2385
2386
2387
2388
2389
2390







-
+








    if (Tcl_IsShared(copy)) {
	copy = Tcl_DuplicateObj(copy);
    }

    Tcl_IncrRefCount(copy);
    /* Steal copy's string rep */
    pathPtr->bytes = TclGetStringFromObj(copy, &cwdLen);
    pathPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen);
    pathPtr->length = cwdLen;
    TclInitEmptyStringRep(copy);
    TclDecrRefCount(copy);
}

/*
 *---------------------------------------------------------------------------
2425
2426
2427
2428
2429
2430
2431
2432

2433
2434
2435
2436
2437
2438
2439
2436
2437
2438
2439
2440
2441
2442

2443
2444
2445
2446
2447
2448
2449
2450







-
+







	 * It is somewhat unusual to reach this code path without the object
	 * being of fsPathType. However, we do our best to deal with the
	 * situation.
	 */

	Tcl_Size len;

	(void) TclGetStringFromObj(pathPtr, &len);
	(void) Tcl_GetStringFromObj(pathPtr, &len);
	if (len == 0) {
	    /*
	     * We reject the empty path "".
	     */

	    return -1;
	}
2447
2448
2449
2450
2451
2452
2453
2454
2455


2456
2457
2458
2459
2460
2461
2462
2458
2459
2460
2461
2462
2463
2464


2465
2466
2467
2468
2469
2470
2471
2472
2473







-
-
+
+







}

/*
 *----------------------------------------------------------------------
 *
 * MakeTildeRelativePath --
 *
 *      Returns a path relative to the home directory of a user.
 *      Note there is a difference between not specifying a user and
 *	Returns a path relative to the home directory of a user.
 *	Note there is a difference between not specifying a user and
 *	explicitly specifying the current user. This mimics Tcl8's tilde
 *	expansion.
 *
 *	The subPath argument is joined to the expanded home directory
 *	as in Tcl_JoinPath. This means if it is not relative, it will
 *	returned as the result with the home directory only checked
 *	for user name validity.
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
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







-
+



-
-
-
+
+
+

-
-
-
-
-
+
+
+
+
+

-
+



-
-
-
-
-
-
+
+
+
+
+
+







    const char *dir;
    Tcl_DString dirString;

    Tcl_DStringInit(dsPtr);
    Tcl_DStringInit(&dirString);

    if (user == NULL || user[0] == 0) {
        /* No user name specified -> current user */
	/* No user name specified -> current user */

	dir = TclGetEnv("HOME", &dirString);
	if (dir == NULL) {
            if (interp) {
                Tcl_SetObjResult(interp, Tcl_NewStringObj(
                        "couldn't find HOME environment variable to expand path",
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"couldn't find HOME environment variable to expand path",
			-1));
                Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH",
                        "HOMELESS", (void *)NULL);
            }
            return TCL_ERROR;
        }
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH",
			"HOMELESS", (void *)NULL);
	    }
	    return TCL_ERROR;
	}
    } else {
        /* User name specified - ~user */
	/* User name specified - ~user */
	dir = TclpGetUserHome(user, &dirString);
	if (dir == NULL) {
	    if (interp != NULL) {
                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                        "user \"%s\" doesn't exist", user));
                Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER",
                        (void *)NULL);
            }
            return TCL_ERROR;
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"user \"%s\" doesn't exist", user));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER",
			(void *)NULL);
	    }
	    return TCL_ERROR;
	}
    }
    if (subPath) {
	const char *parts[2];
	parts[0] = dir;
	parts[1] = subPath;
	Tcl_JoinPath(2, parts, dsPtr);
2526
2527
2528
2529
2530
2531
2532
2533

2534
2535
2536
2537
2538
2539
2540
2537
2538
2539
2540
2541
2542
2543

2544
2545
2546
2547
2548
2549
2550
2551







-
+







 *----------------------------------------------------------------------
 *
 * TclGetHomeDirObj --
 *
 *	Wrapper around MakeTildeRelativePath. See that function.
 *
 * Results:
 *      Returns a Tcl_Obj containing the home directory of a user
 *	Returns a Tcl_Obj containing the home directory of a user
 *	or NULL on failure with error message in interp if non-NULL.
 *
 *----------------------------------------------------------------------
 */
Tcl_Obj *
TclGetHomeDirObj(
    Tcl_Interp *interp,		/* May be NULL. Only used for error messages */
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
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







-
+


-
+














-
+













-
+





-
-
-
+
+
+

-
-
-
+
+
+







 *
 *	If the passed path is begins with a tilde, does tilde resolution
 *	and returns a Tcl_Obj containing the resolved path. If the tilde
 *	component cannot be resolved, returns NULL. If the path does not
 *	begin with a tilde, returns as is.
 *
 * Results:
 *      Returns a Tcl_Obj with resolved path. This may be a new Tcl_Obj
 *	Returns a Tcl_Obj with resolved path. This may be a new Tcl_Obj
 *	with ref count 0 or that pathObj that was passed in without its
 *	ref count modified.
 *      Returns NULL if the path begins with a ~ that cannot be resolved
 *	Returns NULL if the path begins with a ~ that cannot be resolved
 *	and stores an error message in interp if non-NULL.
 *
 *----------------------------------------------------------------------
 */
Tcl_Obj *
TclResolveTildePath(
    Tcl_Interp *interp,		/* May be NULL. Only used for error messages */
    Tcl_Obj *pathObj)
{
    const char *path;
    Tcl_Size len;
    Tcl_Size split;
    Tcl_DString resolvedPath;

    path = TclGetStringFromObj(pathObj, &len);
    path = Tcl_GetStringFromObj(pathObj, &len);
    if (path[0] != '~') {
	return pathObj;
    }

    /*
     * We have multiple cases '~/foo/bar...', '~user/foo/bar...', etc.
     * split becomes value 1 for '~/...' as well as for '~'. Note on
     * Windows FindSplitPos will implicitly check for '\' as separator
     * in addition to what is passed.
     */
    split = FindSplitPos(path, '/');

    if (split == 1) {
        /* No user name specified -> current user */
	/* No user name specified -> current user */
	if (MakeTildeRelativePath(interp, NULL, path[1] ? 2 + path : NULL,
		&resolvedPath) != TCL_OK) {
	    return NULL;
	}
    } else {
        /* User name specified - ~user */
        const char *expandedUser;
        Tcl_DString userName;
	/* User name specified - ~user */
	const char *expandedUser;
	Tcl_DString userName;

        Tcl_DStringInit(&userName);
        Tcl_DStringAppend(&userName, path+1, split-1);
        expandedUser = Tcl_DStringValue(&userName);
	Tcl_DStringInit(&userName);
	Tcl_DStringAppend(&userName, path+1, split-1);
	expandedUser = Tcl_DStringValue(&userName);

	/* path[split] is / or \0 */
	if (MakeTildeRelativePath(interp, expandedUser,
		path[split] ? &path[split+1] : NULL,
		&resolvedPath) != TCL_OK) {
	    Tcl_DStringFree(&userName);
	    return NULL;
2622
2623
2624
2625
2626
2627
2628
2629

2630
2631

2632
2633
2634
2635
2636
2637
2638
2633
2634
2635
2636
2637
2638
2639

2640
2641

2642
2643
2644
2645
2646
2647
2648
2649







-
+

-
+







 *
 * TclResolveTildePathList --
 *
 *	Given a Tcl_Obj that is a list of paths, returns a Tcl_Obj containing
 *	the paths with any ~-prefixed paths resolved.
 *
 *	Empty strings and ~-prefixed paths that cannot be resolved are
 *      removed from the returned list.
 *	removed from the returned list.
 *
 *      The trailing components of the path are returned verbatim. No
 *	The trailing components of the path are returned verbatim. No
 *	processing is done on them. Moreover, no assumptions should be
 *	made about the separators in the returned path. They may be /
 *	or native. Appropriate path manipulations functions should be
 *	used by caller if desired.
 *
 * Results:
 *	Returns a Tcl_Obj with resolved paths. This may be a new Tcl_Obj with
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
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







-
+


-
+






-
-
-
-
+
+
+
+


-
+





-
+

-
+







    Tcl_Obj **objv;
    Tcl_Size objc;
    Tcl_Size i;
    Tcl_Obj *resolvedPaths;
    const char *path;

    if (pathsObj == NULL) {
        return NULL;
	return NULL;
    }
    if (Tcl_ListObjGetElements(NULL, pathsObj, &objc, &objv) != TCL_OK) {
        return NULL; /* Not a list */
	return NULL; /* Not a list */
    }

    /*
     * Figure out if any paths need resolving to avoid unnecessary allocations.
     */
    for (i = 0; i < objc; ++i) {
        path = Tcl_GetString(objv[i]);
        if (path[0] == '~') {
            break; /* At least one path needs resolution */
        }
	path = Tcl_GetString(objv[i]);
	if (path[0] == '~') {
	    break;		/* At least one path needs resolution */
	}
    }
    if (i == objc) {
        return pathsObj; /* No paths needed to be resolved */
	return pathsObj;	/* No paths needed to be resolved */
    }

    resolvedPaths = Tcl_NewListObj(objc, NULL);
    for (i = 0; i < objc; ++i) {
	Tcl_Obj *resolvedPath;
        path = Tcl_GetString(objv[i]);
	path = Tcl_GetString(objv[i]);
	if (path[0] == 0) {
	    continue; /* Skip empty strings */
	    continue;		/* Skip empty strings */
	}
	resolvedPath = TclResolveTildePath(NULL, objv[i]);
	if (resolvedPath) {
	    /* Paths that cannot be resolved are skipped */
	    Tcl_ListObjAppendElement(NULL, resolvedPaths, resolvedPath);
	}
    }
Changes to generic/tclPipe.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclPipe.c --
 *
 *	This file contains the generic portion of the command channel driver
 *	as well as various utility routines used in managing subprocesses.
 *
 * Copyright © 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclPipe.c --
 *
 *	This file contains the generic portion of the command channel driver
 *	as well as various utility routines used in managing subprocesses.
 */

#include "tclInt.h"

/*
 * A linked list of the following structures is used to keep track of child
 * processes that have been detached but haven't exited yet, so we can make
 * sure that they're properly "reaped" (officially waited for) and don't lie
 * around as zombies cluttering the system.
Changes to generic/tclPkg.c.
1
2
3
4
5
6
7
8
9
10
11





















12
13
14
15
16
17
18
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

-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclPkg.c --
 *
 *	This file implements package and version control for Tcl via the
 *	"package" command and a few C APIs.
 *
 * Copyright © 1996 Sun Microsystems, Inc.
 * Copyright © 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * Copyright © 2017 Nathan Coulter
 *
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclPkg.c --
 *
 *	This file implements package and version control for Tcl via the
 *	"package" command and a few C APIs.
 */

/*
 *
 * TIP #268.
 * Heavily rewritten to handle the extend version numbers, and extended
 * package requirements.
 */

#include "tclInt.h"
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
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







-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-
-
+
+
+
+
+
+







static int		SomeRequirementSatisfied(char *havei, int reqc,
			    Tcl_Obj *const reqv[]);
static void		AddRequirementsToResult(Tcl_Interp *interp, int reqc,
			    Tcl_Obj *const reqv[]);
static void		AddRequirementsToDString(Tcl_DString *dstring,
			    int reqc, Tcl_Obj *const reqv[]);
static Package *	FindPackage(Tcl_Interp *interp, const char *name);
static int		PkgRequireCore(void *data[], Tcl_Interp *interp, int result);
static int		PkgRequireCoreFinal(void *data[], Tcl_Interp *interp, int result);
static int		PkgRequireCoreCleanup(void *data[], Tcl_Interp *interp, int result);
static int		PkgRequireCoreStep1(void *data[], Tcl_Interp *interp, int result);
static int		PkgRequireCoreStep2(void *data[], Tcl_Interp *interp, int result);
static int		TclNRPkgRequireProc(void *clientData, Tcl_Interp *interp, int reqc, Tcl_Obj *const reqv[]);
static int		SelectPackage(void *data[], Tcl_Interp *interp, int result);
static int		SelectPackageFinal(void *data[], Tcl_Interp *interp, int result);
static int		TclNRPackageObjCmdCleanup(void *data[], Tcl_Interp *interp, int result);
static int		PkgRequireCore(void *data[], Tcl_Interp *interp,
			    int result);
static int		PkgRequireCoreFinal(void *data[], Tcl_Interp *interp,
			    int result);
static int		PkgRequireCoreCleanup(void *data[], Tcl_Interp *interp,
			    int result);
static int		PkgRequireCoreStep1(void *data[], Tcl_Interp *interp,
			    int result);
static int		PkgRequireCoreStep2(void *data[], Tcl_Interp *interp,
			    int result);
static int		TclNRPkgRequireProc(void *clientData,
			    Tcl_Interp *interp, int reqc,
			    Tcl_Obj *const reqv[]);
static int		SelectPackage(void *data[], Tcl_Interp *interp,
			    int result);
static int		SelectPackageFinal(void *data[], Tcl_Interp *interp,
			    int result);
static int		TclNRPackageObjCmdCleanup(void *data[],
			    Tcl_Interp *interp, int result);

/*
 * Helper macros.
 */

#define DupBlock(v,s,len) \
    ((v) = (char *)Tcl_Alloc(len), memcpy((v),(s),(len)))
#define DupString(v,s) \
    do { \
	size_t local__len = strlen(s) + 1; \
	DupBlock((v),(s),local__len); \
#define DupBlock(var, str, len) \
    ((var) = (char *) Tcl_Alloc(len), memcpy((var), (str), (len)))
#define DupString(var, str) \
    do {								\
	size_t local__len = strlen(str) + 1;				\
	DupBlock((var), (str), local__len);				\
    } while (0)

/*
 *----------------------------------------------------------------------
 *
 * Tcl_PkgProvide / Tcl_PkgProvideEx --
 *
1175
1176
1177
1178
1179
1180
1181
1182

1183
1184
1185
1186
1187
1188
1189
1201
1202
1203
1204
1205
1206
1207

1208
1209
1210
1211
1212
1213
1214
1215







-
+







		Tcl_Free(argv3i);
		return TCL_OK;
	    }
	    pkgPtr = (Package *)Tcl_GetHashValue(hPtr);
	} else {
	    pkgPtr = FindPackage(interp, argv2);
	}
	argv3 = TclGetStringFromObj(objv[3], &length);
	argv3 = Tcl_GetStringFromObj(objv[3], &length);

	for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL;
		prevPtr = availPtr, availPtr = availPtr->nextPtr) {
	    if (CheckVersionAndConvert(interp, availPtr->version, &avi,
		    NULL) != TCL_OK) {
		Tcl_Free(argv3i);
		return TCL_ERROR;
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
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







-
+


-
+
















-
+







		pkgPtr->availPtr = availPtr;
	    } else {
		availPtr->nextPtr = prevPtr->nextPtr;
		prevPtr->nextPtr = availPtr;
	    }
	}
	if (iPtr->scriptFile) {
	    argv4 = TclGetStringFromObj(iPtr->scriptFile, &length);
	    argv4 = Tcl_GetStringFromObj(iPtr->scriptFile, &length);
	    DupBlock(availPtr->pkgIndex, argv4, length + 1);
	}
	argv4 = TclGetStringFromObj(objv[4], &length);
	argv4 = Tcl_GetStringFromObj(objv[4], &length);
	DupBlock(availPtr->script, argv4, length + 1);
	break;
    }
    case PKG_NAMES:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	} else {
	    Tcl_Obj *resultObj;

	    TclNewObj(resultObj);
	    tablePtr = &iPtr->packageTable;
	    for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
		    hPtr = Tcl_NextHashEntry(&search)) {
		pkgPtr = (Package *)Tcl_GetHashValue(hPtr);
		if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) {
		    Tcl_ListObjAppendElement(NULL,resultObj, Tcl_NewStringObj(
		    Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
			    (char *)Tcl_GetHashKey(tablePtr, hPtr), -1));
		}
	    }
	    Tcl_SetObjResult(interp, resultObj);
	}
	break;
    case PKG_PRESENT: {
1357
1358
1359
1360
1361
1362
1363
1364

1365
1366
1367
1368
1369
1370
1371
1383
1384
1385
1386
1387
1388
1389

1390
1391
1392
1393
1394
1395
1396
1397







-
+








	    objvListPtr = Tcl_NewListObj(0, NULL);
	    Tcl_IncrRefCount(objvListPtr);
	    Tcl_ListObjAppendElement(interp, objvListPtr, ov);
	    TclListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr);

	    Tcl_NRAddCallback(interp,
		    TclNRPackageObjCmdCleanup, objv[3], objvListPtr, NULL,NULL);
		    TclNRPackageObjCmdCleanup, objv[3], objvListPtr, NULL, NULL);
	    Tcl_NRAddCallback(interp,
		    PkgRequireCore, (void *) argv3, INT2PTR(newobjc),
		    newObjvPtr, NULL);
	    return TCL_OK;
	} else {
	    Tcl_Obj *const *newobjv = objv + 3;

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
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







-
+


















-
+







		 */

		Tcl_ListObjAppendElement(interp, objvListPtr,
			Tcl_DuplicateObj(newobjv[i]));
	    }
	    TclListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr);
	    Tcl_NRAddCallback(interp,
		    TclNRPackageObjCmdCleanup, objv[2], objvListPtr, NULL,NULL);
		    TclNRPackageObjCmdCleanup, objv[2], objvListPtr, NULL, NULL);
	    Tcl_NRAddCallback(interp,
		    PkgRequireCore, (void *) argv2, INT2PTR(newobjc),
		    newObjvPtr, NULL);
	    return TCL_OK;
	}
	break;
    case PKG_UNKNOWN: {
	Tcl_Size length;

	if (objc == 2) {
	    if (iPtr->packageUnknown != NULL) {
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj(iPtr->packageUnknown, -1));
	    }
	} else if (objc == 3) {
	    if (iPtr->packageUnknown != NULL) {
		Tcl_Free(iPtr->packageUnknown);
	    }
	    argv2 = TclGetStringFromObj(objv[2], &length);
	    argv2 = Tcl_GetStringFromObj(objv[2], &length);
	    if (argv2[0] == 0) {
		iPtr->packageUnknown = NULL;
	    } else {
		DupBlock(iPtr->packageUnknown, argv2, length+1);
	    }
	} else {
	    Tcl_WrongNumArgs(interp, 2, objv, "?command?");
2067
2068
2069
2070
2071
2072
2073
2074

2075
2076
2077
2078
2079
2080
2081
2093
2094
2095
2096
2097
2098
2099

2100
2101
2102
2103
2104
2105
2106
2107







-
+







				 * available. */
{
    Tcl_Obj *result = Tcl_GetObjResult(interp);
    int i;
    Tcl_Size length;

    for (i = 0; i < reqc; i++) {
	const char *v = TclGetStringFromObj(reqv[i], &length);
	const char *v = Tcl_GetStringFromObj(reqv[i], &length);

	if ((length & 0x1) && (v[length/2] == '-')
		&& (strncmp(v, v+((length+1)/2), length/2) == 0)) {
	    Tcl_AppendPrintfToObj(result, " exactly %s", v+((length+1)/2));
	} else {
	    Tcl_AppendPrintfToObj(result, " %s", v);
	}
Changes to generic/tclPkgConfig.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclPkgConfig.c --
 *
 *	This file contains the configuration information to embed into the tcl
 *	library.
 *
 * Copyright © 2002 Andreas Kupries <andreas_kupries@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclPkgConfig.c --
 *
 *	This file contains the configuration information to embed into the tcl
 *	library.
 */

/* Note, the definitions in this module are influenced by the following C
 * preprocessor macros:
 *
 * OSCMa  = shortcut for "old style configuration macro activates"
 * NSCMdt = shortcut for "new style configuration macro declares that"
 *
 * - TCL_THREADS		OSCMa compilation as threaded core.
Changes to generic/tclPlatDecls.h.














1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-
-
-







/*
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * All rights reserved.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclPlatDecls.h --
 *
 *	Declarations of platform specific Tcl APIs.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * All rights reserved.
 */

#ifndef _TCLPLATDECLS
#define _TCLPLATDECLS

#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
















-
-
+
+











-
+







#   ifdef __cplusplus
#	define MODULE_SCOPE extern "C"
#   else
#	define MODULE_SCOPE extern
#   endif
#endif

#if TCL_MAJOR_VERSION < 9

#ifdef __cplusplus
extern "C" {
#endif

/*
 * Exported function declarations:
 */

#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
EXTERN TCHAR *		Tcl_WinUtfToTChar(const char *str, int len,
				Tcl_DString *dsPtr);
/* 1 */
EXTERN char *		Tcl_WinTCharToUtf(const TCHAR *str, int len,
				Tcl_DString *dsPtr);
/* Slot 2 is reserved */
/* 3 */
EXTERN void		Tcl_WinConvertError(unsigned errCode);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 0 */
EXTERN int		Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
				const char *bundleName, int hasResourceFile,
				Tcl_Size maxPathLen, char *libraryPath);
/* 1 */
EXTERN int		Tcl_MacOSXOpenVersionedBundleResources(
				Tcl_Interp *interp, const char *bundleName,
				const char *bundleVersion,
				int hasResourceFile, Tcl_Size maxPathLen,
				char *libraryPath);
/* 2 */
EXTERN void		Tcl_MacOSXNotifierAddRunLoopMode(
				const void *runLoopMode);
#endif /* MACOSX */

typedef struct TclPlatStubs {
    int magic;
    void *hooks;

#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
    TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */
    char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */
    void (*reserved2)(void);
    void (*tcl_WinConvertError) (unsigned errCode); /* 3 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, Tcl_Size maxPathLen, char *libraryPath); /* 0 */
    int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, Tcl_Size maxPathLen, char *libraryPath); /* 1 */
    void (*tcl_MacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 2 */
#endif /* MACOSX */
} TclPlatStubs;

extern const TclPlatStubs *tclPlatStubsPtr;

#ifdef __cplusplus
}
#endif

#if defined(USE_TCL_STUBS)

/*
 * Inline function declarations:
 */

#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
#define Tcl_WinUtfToTChar \
	(tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */
#define Tcl_WinTCharToUtf \
	(tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */
/* Slot 2 is reserved */
#define Tcl_WinConvertError \
	(tclPlatStubsPtr->tcl_WinConvertError) /* 3 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
#define Tcl_MacOSXOpenBundleResources \
	(tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */
#define Tcl_MacOSXOpenVersionedBundleResources \
	(tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */
#define Tcl_MacOSXNotifierAddRunLoopMode \
	(tclPlatStubsPtr->tcl_MacOSXNotifierAddRunLoopMode) /* 2 */
#endif /* MACOSX */

#endif /* defined(USE_TCL_STUBS) */

#else /* TCL_MAJOR_VERSION > 8 */

/* !BEGIN!: Do not edit below this line. */

#ifdef __cplusplus
extern "C" {
#endif

/*
 * Exported function declarations:
 */

/* Slot 0 is reserved */
/* 1 */
EXTERN int		Tcl_MacOSXOpenVersionedBundleResources(
				Tcl_Interp *interp, const char *bundleName,
				const char *bundleVersion,
				int hasResourceFile, Tcl_Size maxPathLen,
				char *libraryPath);
				Tcl_Size hasResourceFile,
				Tcl_Size maxPathLen, char *libraryPath);
/* 2 */
EXTERN void		Tcl_MacOSXNotifierAddRunLoopMode(
				const void *runLoopMode);
/* 3 */
EXTERN void		Tcl_WinConvertError(unsigned errCode);

typedef struct TclPlatStubs {
    int magic;
    void *hooks;

    void (*reserved0)(void);
    int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, Tcl_Size maxPathLen, char *libraryPath); /* 1 */
    int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, Tcl_Size hasResourceFile, Tcl_Size maxPathLen, char *libraryPath); /* 1 */
    void (*tcl_MacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 2 */
    void (*tcl_WinConvertError) (unsigned errCode); /* 3 */
} TclPlatStubs;

extern const TclPlatStubs *tclPlatStubsPtr;

#ifdef __cplusplus
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
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







-
-
-


















+
+
+
+
+
+
+
+
+
+
-
+
-











	(tclPlatStubsPtr->tcl_MacOSXNotifierAddRunLoopMode) /* 2 */
#define Tcl_WinConvertError \
	(tclPlatStubsPtr->tcl_WinConvertError) /* 3 */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#endif /* TCL_MAJOR_VERSION */

#ifdef MAC_OSX_TCL /* MACOSX */
#undef Tcl_MacOSXOpenBundleResources
#define Tcl_MacOSXOpenBundleResources(a,b,c,d,e) Tcl_MacOSXOpenVersionedBundleResources(a,b,NULL,c,d,e)
#endif

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#ifdef _WIN32
#   undef Tcl_CreateFileHandler
#   undef Tcl_DeleteFileHandler
#   undef Tcl_GetOpenFile
#endif
#ifndef MAC_OSX_TCL
#   undef Tcl_MacOSXOpenVersionedBundleResources
#   undef Tcl_MacOSXNotifierAddRunLoopMode
#endif

#ifdef _WIN32
#   undef Tcl_CreateFileHandler
#   undef Tcl_DeleteFileHandler
#   undef Tcl_GetOpenFile
#endif
#ifndef MAC_OSX_TCL
#   undef Tcl_MacOSXOpenVersionedBundleResources
#   undef Tcl_MacOSXNotifierAddRunLoopMode
#endif

#if defined(USE_TCL_STUBS) && (defined(_WIN32) || defined(__CYGWIN__))\
#if defined(USE_TCL_STUBS) && (defined(_WIN32) || defined(__CYGWIN__))
	&& (defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8)
#undef Tcl_WinUtfToTChar
#undef Tcl_WinTCharToUtf
#ifdef _WIN32
#define Tcl_WinUtfToTChar(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \
		(TCHAR *)Tcl_UtfToChar16DString((string), (len), (dsPtr)))
#define Tcl_WinTCharToUtf(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \
		(char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr)))
#endif
#endif

#endif /* _TCLPLATDECLS */
Changes to generic/tclPort.h.
















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
-
-







/*
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclPort.h --
 *
 *	This header file handles porting issues that occur because
 *	of differences between systems.  It reads in platform specific
 *	portability files.
 *
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef _TCLPORT
#define _TCLPORT

#ifdef HAVE_TCL_CONFIG_H
#include "tclConfig.h"
Changes to generic/tclPosixStr.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
















14
15
16
17
18
19
20
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

-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclPosixStr.c --
 *
 *	This file contains procedures that generate strings corresponding to
 *	various POSIX-related codes, such as errno and signals.
 *
 * Copyright © 1991-1994 The Regents of the University of California.
 * Copyright © 1994-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclPosixStr.c --
 *
 *	This file contains procedures that generate strings corresponding to
 *	various POSIX-related codes, such as errno and signals.
 */

#include "tclInt.h"

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ErrnoId --
 *
520
521
522
523
524
525
526
527

528
529
530
531
532
533
534
531
532
533
534
535
536
537

538
539
540
541
542
543
544
545







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

const char *
Tcl_ErrnoMsg(
     int err)			/* Error number (such as in errno variable). */
    int err)			/* Error number (such as in errno variable). */
{
    switch (err) {
#if defined(E2BIG) && (!defined(EOVERFLOW) || (E2BIG != EOVERFLOW))
    case E2BIG: return "argument list too long";
#endif
#ifdef EACCES
    case EACCES: return "permission denied";
1018
1019
1020
1021
1022
1023
1024
1025

1026
1027
1028
1029
1030
1031
1032
1029
1030
1031
1032
1033
1034
1035

1036
1037
1038
1039
1040
1041
1042
1043







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

const char *
Tcl_SignalId(
     int sig)			/* Number of signal. */
    int sig)			/* Number of signal. */
{
    switch (sig) {
#ifdef SIGABRT
    case SIGABRT: return "SIGABRT";
#endif
#ifdef SIGALRM
    case SIGALRM: return "SIGALRM";
1152
1153
1154
1155
1156
1157
1158
1159

1160
1161
1162
1163
1164
1165
1166
1163
1164
1165
1166
1167
1168
1169

1170
1171
1172
1173
1174
1175
1176
1177







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

const char *
Tcl_SignalMsg(
     int sig)			/* Number of signal. */
    int sig)			/* Number of signal. */
{
    switch (sig) {
#ifdef SIGABRT
    case SIGABRT: return "SIGABRT";
#endif
#ifdef SIGALRM
    case SIGALRM: return "alarm clock";
Changes to generic/tclPreserve.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14

















15
16
17
18
19
20
21
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

-
-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclPreserve.c --
 *
 *	This file contains a collection of functions that are used to make
 *	sure that widget records and other data structures aren't reallocated
 *	when there are nested functions that depend on their existence.
 *
 * Copyright © 1991-1994 The Regents of the University of California.
 * Copyright © 1994-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclPreserve.c --
 *
 *	This file contains a collection of functions that are used to make
 *	sure that widget records and other data structures aren't reallocated
 *	when there are nested functions that depend on their existence.
 */

#include "tclInt.h"

/*
 * The following data structure is used to keep track of all the Tcl_Preserve
 * calls that are still in effect. It grows as needed to accommodate any
 * number of calls in effect.
 */
Changes to generic/tclProc.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15


















16
17
18
19
20
21
22
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

-
-
-
-
-









+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclProc.c --
 *
 *	This file contains routines that implement Tcl procedures, including
 *	the "proc" and "uplevel" commands.
 *
 * Copyright © 1987-1993 The Regents of the University of California.
 * Copyright © 1994-1998 Sun Microsystems, Inc.
 * Copyright © 2004-2006 Miguel Sofer
 * Copyright © 2007 Daniel A. Steffen <das@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * Copyright © 2024 Nathan Coulter 
 *
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclProc.c --
 *
 *	This file contains routines that implement Tcl procedures, including
 *	the "proc" and "uplevel" commands.
 */

#include "tclInt.h"
#include "tclCompile.h"
#include <assert.h>

/*
 * Variables that are part of the [apply] command implementation and which
 * have to be passed to the other side of the NRE call.
62
63
64
65
66
67
68
69

70
71
72
73
74
75
76
75
76
77
78
79
80
81

82
83
84
85
86
87
88
89







-
+







    ProcBodyFree,		/* FreeInternalRep function */
    ProcBodyDup,		/* DupInternalRep function */
    NULL,			/* UpdateString function; Tcl_GetString and
				 * Tcl_GetStringFromObj should panic
				 * instead. */
    NULL,			/* SetFromAny function; Tcl_ConvertToType
				 * should panic instead. */
    TCL_OBJTYPE_V0
    0
};

#define ProcSetInternalRep(objPtr, procPtr) \
    do {								\
	Tcl_ObjInternalRep ir;						\
	(procPtr)->refCount++;						\
	ir.twoPtrValue.ptr1 = (procPtr);				\
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
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







-
+





-
+
+

+
+
















-
+







 * The [upvar]/[uplevel] level reference type. Uses the wideValue field
 * to remember the integer value of a parsed #<integer> format.
 *
 * Uses the default behaviour throughout, and never disposes of the string
 * rep; it's just a cache type.
 */

static const Tcl_ObjType levelReferenceType = {
static ObjectType levelReferenceType = {
    "levelReference",
    NULL,
    NULL,
    NULL,
    NULL,
    TCL_OBJTYPE_V1(TclLengthOne)
	2,
	NULL
};

Tcl_ObjType *levelReferenceTypePtr = (Tcl_ObjType *)&levelReferenceType;

/*
 * The type of lambdas. Note that every lambda will *always* have a string
 * representation.
 *
 * Internally, ptr1 is a pointer to a Proc instance that is not bound to a
 * command name, and ptr2 is a pointer to the namespace that the Proc instance
 * will execute within. IF YOU CHANGE THIS, CHECK IN tclDisassemble.c TOO.
 */

static const Tcl_ObjType lambdaType = {
    "lambdaExpr",		/* name */
    FreeLambdaInternalRep,	/* freeIntRepProc */
    DupLambdaInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    SetLambdaFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V0
	0
};

#define LambdaSetInternalRep(objPtr, procPtr, nsObjPtr) \
    do {								\
	Tcl_ObjInternalRep ir;						\
	ir.twoPtrValue.ptr1 = (procPtr);				\
	ir.twoPtrValue.ptr2 = (nsObjPtr);				\
149
150
151
152
153
154
155








156
157
158
159
160
161
162
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186







+
+
+
+
+
+
+
+







 *	A standard Tcl object result value.
 *
 * Side effects:
 *	A new procedure gets created.
 *
 *----------------------------------------------------------------------
 */

void TclProcInit(void) {
    Tcl_ObjInterface *oiPtr;
    oiPtr = Tcl_NewObjInterface();
    Tcl_ObjInterfaceSetFnListLength(oiPtr ,TclLengthOne);
    Tcl_ObjTypeSetInterface(levelReferenceTypePtr ,oiPtr);
	return;
}

#undef TclObjInterpProc
int
Tcl_ProcObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Size objc,		/* Number of arguments. */
355
356
357
358
359
360
361
362

363
364
365
366
367
368
369
379
380
381
382
383
384
385

386
387
388
389
390
391
392
393







-
+







	    procArgs++;
	}

	/*
	 * The argument list is just "args"; check the body
	 */

	procBody = TclGetStringFromObj(objv[3], &numBytes);
	procBody = Tcl_GetStringFromObj(objv[3], &numBytes);
	if (TclParseAllWhiteSpace(procBody, numBytes) < numBytes) {
	    goto done;
	}

	/*
	 * The body is just spaces: link the compileProc
	 */
450
451
452
453
454
455
456
457

458
459
460
461
462
463
464
474
475
476
477
478
479
480

481
482
483
484
485
486
487
488







-
+







	 */

	if (Tcl_IsShared(bodyPtr)) {
	    const char *bytes;
	    Tcl_Size length;
	    Tcl_Obj *sharedBodyPtr = bodyPtr;

	    bytes = TclGetStringFromObj(bodyPtr, &length);
	    bytes = Tcl_GetStringFromObj(bodyPtr, &length);
	    bodyPtr = Tcl_NewStringObj(bytes, length);

	    /*
	     * TIP #280.
	     * Ensure that the continuation line data for the original body is
	     * not lost and applies to the new body as well.
	     */
540
541
542
543
544
545
546
547

548
549
550
551
552
553
554
564
565
566
567
568
569
570

571
572
573
574
575
576
577
578







-
+







	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "argument with no name", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "FORMALARGUMENTFORMAT", (void *)NULL);
	    goto procError;
	}

	argname = TclGetStringFromObj(fieldValues[0], &nameLength);
	argname = Tcl_GetStringFromObj(fieldValues[0], &nameLength);

	/*
	 * Check that the formal parameter name is a scalar.
	 */

	argnamei = argname;
	argnamelast = (nameLength > 0) ? (argname + nameLength - 1) : argname;
603
604
605
606
607
608
609
610
611


612
613
614
615
616
617
618
627
628
629
630
631
632
633


634
635
636
637
638
639
640
641
642







-
-
+
+








	    /*
	     * Compare the default value if any.
	     */

	    if (localPtr->defValuePtr != NULL) {
		Tcl_Size tmpLength, valueLength;
		const char *tmpPtr = TclGetStringFromObj(localPtr->defValuePtr, &tmpLength);
		const char *value = TclGetStringFromObj(fieldValues[1], &valueLength);
		const char *tmpPtr = Tcl_GetStringFromObj(localPtr->defValuePtr, &tmpLength);
		const char *value = Tcl_GetStringFromObj(fieldValues[1], &valueLength);

		if ((valueLength != tmpLength)
			|| memcmp(value, tmpPtr, tmpLength) != 0) {
		    Tcl_Obj *errorObj = Tcl_ObjPrintf(
			    "procedure \"%s\": formal parameter \"", procName);
		    Tcl_AppendObjToObj(errorObj, fieldValues[0]);
		    Tcl_AppendToObj(errorObj, "\" has "
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
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







-
+












-
+







	TclGetWideIntFromObj(NULL, objPtr, &w);
	if (w < 0 || w > INT_MAX || curLevel > w + INT_MAX) {
	    result = -1;
	} else {
	    level = curLevel - level;
	    result = 1;
	}
    } else if ((irPtr = TclFetchInternalRep(objPtr, &levelReferenceType))) {
    } else if ((irPtr = TclFetchInternalRep(objPtr, levelReferenceTypePtr))) {
	level = irPtr->wideValue;
	result = 1;
    } else {
	name = TclGetString(objPtr);
	if (name[0] == '#') {
	    if (TCL_OK == Tcl_GetInt(NULL, name+1, &level)) {
		if (level < 0 || (level > 0 && name[1] == '-')) {
		    result = -1;
		} else {
		    Tcl_ObjInternalRep ir;

		    ir.wideValue = level;
		    Tcl_StoreInternalRep(objPtr, &levelReferenceType, &ir);
		    Tcl_StoreInternalRep(objPtr, levelReferenceTypePtr, &ir);
		    result = 1;
		}
	    } else {
		result = -1;
	    }
	} else if (TclGetWideBitsFromObj(NULL, objPtr, &w) == TCL_OK) {
	    /*
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
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







-








-
-
-
-
-
+
+
+
+
+







int
TclNRUplevelObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{

    Interp *iPtr = (Interp *) interp;
    CmdFrame *invoker = NULL;
    int word = 0;
    int result;
    CallFrame *savedVarFramePtr, *framePtr;
    Tcl_Obj *objPtr;

    if (objc < 2) {
    /* to do
    *    simplify things by interpreting the argument as a command when there
    *    is only one argument.  This requires a TIP since currently a single
    *    argument is interpreted as a level indicator if possible.
    */
	/* to do:
	 * simplify things by interpreting the argument as a command when there
	 * is only one argument.  This requires a TIP since currently a single
	 * argument is interpreted as a level indicator if possible.
	 */
    uplevelSyntax:
	Tcl_WrongNumArgs(interp, 1, objv, "?level? command ?arg ...?");
	return TCL_ERROR;
    } else if (!TclHasStringRep(objv[1]) && objc == 2) {
	int status;
	Tcl_Size llength;
	status = TclListObjLength(interp, objv[1], &llength);
1746
1747
1748
1749
1750
1751
1752
1753


1754
1755
1756
1757
1758
1759
1760
1769
1770
1771
1772
1773
1774
1775

1776
1777
1778
1779
1780
1781
1782
1783
1784







-
+
+







	    l++;
	}
	TCL_DTRACE_PROC_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
		a[8], a[9]);
    }
    if (TCL_DTRACE_PROC_INFO_ENABLED() && iPtr->cmdFramePtr) {
	Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr);
	const char *a[6]; Tcl_Size i[2];
	const char *a[6];
	Tcl_Size i[2];

	TclDTraceInfo(info, a, i);
	TCL_DTRACE_PROC_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]);
	TclDecrRefCount(info);
    }
    if (TCL_DTRACE_PROC_ENTRY_ENABLED()) {
	Tcl_Size l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
2077
2078
2079
2080
2081
2082
2083
2084

2085
2086
2087
2088
2089
2090
2091
2101
2102
2103
2104
2105
2106
2107

2108
2109
2110
2111
2112
2113
2114
2115







-
+







    Tcl_Interp *interp,		/* The interpreter in which the procedure was
				 * called. */
    Tcl_Obj *procNameObj)	/* Name of the procedure. Used for error
				 * messages and trace information. */
{
    int overflow, limit = 60;
    Tcl_Size nameLen;
    const char *procName = TclGetStringFromObj(procNameObj, &nameLen);
    const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen);

    overflow = (nameLen > (Tcl_Size)limit);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (procedure \"%.*s%s\" line %d)",
	    (overflow ? limit : (int)nameLen), procName,
	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
2771
2772
2773
2774
2775
2776
2777
2778

2779
2780
2781
2782
2783
2784
2785
2795
2796
2797
2798
2799
2800
2801

2802
2803
2804
2805
2806
2807
2808
2809







-
+







    Tcl_Interp *interp,		/* The interpreter in which the procedure was
				 * called. */
    Tcl_Obj *procNameObj)	/* Name of the procedure. Used for error
				 * messages and trace information. */
{
    int overflow, limit = 60;
    Tcl_Size nameLen;
    const char *procName = TclGetStringFromObj(procNameObj, &nameLen);
    const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen);

    overflow = (nameLen > (Tcl_Size)limit);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (lambda term \"%.*s%s\" line %d)",
	    (overflow ? limit : (int)nameLen), procName,
	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
Changes to generic/tclProcess.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclProcess.c --
 *
 *	This file implements the "tcl::process" ensemble for subprocess
 *	management as defined by TIP #462.
 *
 * Copyright © 2017 Frederic Bonnet.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclProcess.c --
 *
 *	This file implements the "tcl::process" ensemble for subprocess
 *	management as defined by TIP #462.
 */

#include "tclInt.h"

/*
 * Autopurge flag. Process-global because of the way Tcl manages child
 * processes (see tclPipe.c).
 */

36
37
38
39
40
41
42
43

44
45
46
47
48
49
50
47
48
49
50
51
52
53

54
55
56
57
58
59
60
61







-
+







} ProcessInfo;

static Tcl_HashTable infoTablePerPid;
static Tcl_HashTable infoTablePerResolvedPid;
static int infoTablesInitialized = 0;	/* 0 means not yet initialized. */
TCL_DECLARE_MUTEX(infoTablesMutex)

 /*
/*
 * Prototypes for functions defined later in this file:
 */

static void		InitProcessInfo(ProcessInfo *info, Tcl_Pid pid,
			    Tcl_Size resolvedPid);
static void		FreeProcessInfo(ProcessInfo *info);
static int		RefreshProcessInfo(ProcessInfo *info, int options);
Changes to generic/tclRegexp.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
















14
15
16
17
18
19
20
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

-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclRegexp.c --
 *
 *	This file contains the public interfaces to the Tcl regular expression
 *	mechanism.
 *
 * Copyright © 1998 Sun Microsystems, Inc.
 * Copyright © 1998-1999 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclRegexp.c --
 *
 *	This file contains the public interfaces to the Tcl regular expression
 *	mechanism.
 */

#include "tclInt.h"
#include "tclRegexp.h"
#include "tclTomMath.h"
#include <assert.h>

/*
 *----------------------------------------------------------------------
104
105
106
107
108
109
110
111

112
113
114
115
116
117
118
115
116
117
118
119
120
121

122
123
124
125
126
127
128
129







-
+








const Tcl_ObjType tclRegexpType = {
    "regexp",			/* name */
    FreeRegexpInternalRep,	/* freeIntRepProc */
    DupRegexpInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    SetRegexpFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V0
	0
};

#define RegexpSetInternalRep(objPtr, rePtr) \
    do {								\
	Tcl_ObjInternalRep ir;						\
	(rePtr)->refCount++;						\
	ir.twoPtrValue.ptr1 = (rePtr);					\
597
598
599
600
601
602
603
604

605
606
607
608
609
610
611
608
609
610
611
612
613
614

615
616
617
618
619
620
621
622







-
+







    Tcl_Size length;
    TclRegexp *regexpPtr;
    const char *pattern;

    RegexpGetInternalRep(objPtr, regexpPtr);

    if ((regexpPtr == NULL) || (regexpPtr->flags != flags)) {
	pattern = TclGetStringFromObj(objPtr, &length);
	pattern = Tcl_GetStringFromObj(objPtr, &length);

	regexpPtr = CompileRegexp(interp, pattern, length, flags);
	if (regexpPtr == NULL) {
	    return NULL;
	}

	RegexpSetInternalRep(objPtr, regexpPtr);
Changes to generic/tclRegexp.h.
1
2
3
4
5
6
7
8
9
10
11
12
13
















14
15
16
17
18
19
20
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

-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclRegexp.h --
 *
 *	This file contains definitions used internally by Henry Spencer's
 *	regular expression code.
 *
 * Copyright (c) 1998 by Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclRegexp.h --
 *
 *	This file contains definitions used internally by Henry Spencer's
 *	regular expression code.
 */

#ifndef _TCLREGEXP
#define _TCLREGEXP

#include "regex.h"

/*
 * The TclRegexp structure encapsulates a compiled regex_t, the flags that
Changes to generic/tclResolve.c.
















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-







/*
 * Copyright © 1998 Lucent Technologies, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclResolve.c --
 *
 *	Contains hooks for customized command/variable name resolution
 *	schemes. These hooks allow extensions like [incr Tcl] to add their own
 *	name resolution rules to the Tcl language. Rules can be applied to a
 *	particular namespace, to the interpreter as a whole, or both.
 *
 * Copyright © 1998 Lucent Technologies, 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"

/*
 * Declarations for functions local to this file:
 */
Changes to generic/tclResult.c.
1
2
3
4
5
6
7
8
9
10
11















12
13
14
15
16
17
18
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

-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclResult.c --
 *
 *	This file contains code to manage the interpreter result.
 *
 * Copyright © 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclResult.c --
 *
 *	This file contains code to manage the interpreter result.
 */

#include "tclInt.h"
#include <assert.h>

/*
 * Indices of the standard return options dictionary keys.
 */

355
356
357
358
359
360
361
362

363
364
365
366
367
368
369
366
367
368
369
370
371
372

373
374
375
376
377
378
379
380







-
+







    Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr);
    const char *bytes;
    Tcl_Size length;

    if (Tcl_IsShared(iPtr->objResultPtr)) {
	Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr));
    }
    bytes = TclGetStringFromObj(iPtr->objResultPtr, &length);
    bytes = Tcl_GetStringFromObj(iPtr->objResultPtr, &length);
    if (TclNeedSpace(bytes, bytes + length)) {
	Tcl_AppendToObj(iPtr->objResultPtr, " ", 1);
    }
    Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr);
    Tcl_DecrRefCount(listPtr);
}

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
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







-
+
















-
+







}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetErrorLine --
 *
 *      Returns the line number associated with the current error.
 *	Returns the line number associated with the current error.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetErrorLine(
    Tcl_Interp *interp)
{
    return ((Interp *) interp)->errorLine;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetErrorLine --
 *
 *      Sets the line number associated with the current error.
 *	Sets the line number associated with the current error.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetErrorLine(
    Tcl_Interp *interp,
716
717
718
719
720
721
722
723

724
725
726
727
728
729
730
727
728
729
730
731
732
733

734
735
736
737
738
739
740
741







-
+







	    iPtr->errorInfo = NULL;
	}
	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO],
		&valuePtr);
	if (valuePtr != NULL) {
	    Tcl_Size length;

	    (void)TclGetStringFromObj(valuePtr, &length);
	    (void)Tcl_GetStringFromObj(valuePtr, &length);
	    if (length) {
		iPtr->errorInfo = valuePtr;
		Tcl_IncrRefCount(iPtr->errorInfo);
		iPtr->flags |= ERR_ALREADY_LOGGED;
	    }
	}
	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORSTACK],
Changes to generic/tclScan.c.
1
2
3
4
5
6
7
8
9
10
11















12
13
14
15
16
17
18
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

-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclScan.c --
 *
 *	This file contains the implementation of the "scan" command.
 *
 * Copyright © 1998 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclScan.c --
 *
 *	This file contains the implementation of the "scan" command.
 */

#include "tclInt.h"
#include "tclTomMath.h"
#include <assert.h>

/*
 * Flag values used by Tcl_ScanObjCmd.
 */
1052
1053
1054
1055
1056
1057
1058
1059

1060
1061
1062
1063
1064
1065
1066
1063
1064
1065
1066
1067
1068
1069

1070
1071
1072
1073
1074
1075
1076
1077







-
+







		Tcl_DecrRefCount(objPtr);
		string = end;
	    } else {
		double dvalue;
		if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) {
#ifdef ACCEPT_NAN
		    const Tcl_ObjInternalRep *irPtr
			    = TclFetchInternalRep(objPtr, &tclDoubleType);
			    = TclFetchInternalRep(objPtr, tclDoubleTypePtr);
		    if (irPtr) {
			dvalue = irPtr->doubleValue;
		    } else
#endif
		    {
			Tcl_DecrRefCount(objPtr);
			goto done;
Changes to generic/tclStrIdxTree.c.
1
2
3
4
5
6
7
8
9
10
11














12
13
14
15
16
17
18
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











+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * 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.
 *
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" 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
62
63
64
65
66
67
68
69

70
71
72
73
74
75
76
76
77
78
79
80
81
82

83
84
85
86
87
88
89
90







-
+








static const Tcl_ObjType StrIdxTreeObjType = {
    "str-idx-tree",			/* name */
    StrIdxTreeObj_FreeIntRepProc,	/* freeIntRepProc */
    StrIdxTreeObj_DupIntRepProc,	/* dupIntRepProc */
    StrIdxTreeObj_UpdateStringProc,	/* updateStringProc */
    NULL,				/* setFromAnyProc */
    TCL_OBJTYPE_V0
    0
};

/*
 *----------------------------------------------------------------------
 *
 * TclStrIdxTreeSearch --
 *
Changes to generic/tclStrToD.c.
















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








-
-
-
-
-







/*
 * Copyright © 2005 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclStrToD.c --
 *
 *	This file contains a collection of procedures for managing conversions
 *	to/from floating-point in Tcl. They include TclParseNumber, which
 *	parses numbers from strings; TclDoubleDigits, which formats numbers
 *	into strings of digits, and procedures for interconversion among
 *	'double' and 'mp_int' types.
 *
 * Copyright © 2005 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"
#include "tclTomMath.h"
#include <float.h>
#include <math.h>

67
68
69
70
71
72
73
74

75
76

77
78
79
80
81
82
83
78
79
80
81
82
83
84

85
86

87
88
89
90
91
92
93
94







-
+

-
+







/*
 * Sun ProC needs sunmath for rounding control on x86 like gcc above.
 */
# elif defined(__sun)
#  include <sunmath.h>
#  define TCL_IEEE_DOUBLE_ROUNDING_DECL
#  define TCL_IEEE_DOUBLE_ROUNDING \
    ieee_flags("set","precision","double",NULL)
    ieee_flags("set", "precision", "double", NULL)
#  define TCL_DEFAULT_DOUBLE_ROUNDING \
    ieee_flags("clear","precision",NULL,NULL)
    ieee_flags("clear", "precision", NULL, NULL)

# endif
#endif
/*
 * Other platforms are assumed to always operate in full IEEE mode, so we make
 * the macros to go in and out of that mode do nothing.
 */
544
545
546
547
548
549
550
551

552
553
554
555

556
557
558
559
560
561
562
555
556
557
558
559
560
561

562
563
564
565

566
567
568
569
570
571
572
573







-
+



-
+







    /*
     * Initialize bytes to start of the object's string rep if the caller
     * didn't pass anything else.
     */

    if (bytes == NULL) {
	if (interp == NULL && endPtrPtr == NULL) {
	    if (TclHasInternalRep(objPtr, &tclDictType)) {
	    if (TclHasInternalRep(objPtr, tclDictTypePtr)) {
		/* A dict can never be a (single) number */
		return TCL_ERROR;
	    }
	    if (TclHasInternalRep(objPtr, &tclListType)) {
	    if (TclHasInternalRep(objPtr, tclListTypePtr)) {
		Tcl_Size length;
		/* A list can only be a (single) number if its length == 1 */
		TclListObjLength(NULL, objPtr, &length);
		if (length != 1) {
		    return TCL_ERROR;
		}
	    }
1380
1381
1382
1383
1384
1385
1386
1387

1388
1389
1390
1391
1392
1393
1394
1391
1392
1393
1394
1395
1396
1397

1398
1399
1400
1401
1402
1403
1404
1405







-
+







	    }
	    if (!octalSignificandOverflow) {
		if ((err == MP_OKAY) && (octalSignificandWide > (MOST_BITS + signum))) {
		    err = mp_init_u64(&octalSignificandBig,
			    octalSignificandWide);
		    octalSignificandOverflow = 1;
		} else {
		    objPtr->typePtr = &tclIntType;
		    objPtr->typePtr = tclIntTypePtr;
		    if (signum) {
			objPtr->internalRep.wideValue =
				(Tcl_WideInt)(-octalSignificandWide);
		    } else {
			objPtr->internalRep.wideValue =
				(Tcl_WideInt)octalSignificandWide;
		    }
1416
1417
1418
1419
1420
1421
1422
1423

1424
1425
1426
1427
1428
1429
1430
1427
1428
1429
1430
1431
1432
1433

1434
1435
1436
1437
1438
1439
1440
1441







-
+







	returnInteger:
	    if (!significandOverflow) {
		if ((err == MP_OKAY) && (significandWide > MOST_BITS+signum)) {
		    err = mp_init_u64(&significandBig,
			    significandWide);
		    significandOverflow = 1;
		} else {
		    objPtr->typePtr = &tclIntType;
		    objPtr->typePtr = tclIntTypePtr;
		    if (signum) {
			objPtr->internalRep.wideValue =
				(Tcl_WideInt)(-significandWide);
		    } else {
			objPtr->internalRep.wideValue =
				(Tcl_WideInt)significandWide;
		    }
1448
1449
1450
1451
1452
1453
1454
1455

1456
1457
1458
1459
1460
1461
1462
1459
1460
1461
1462
1463
1464
1465

1466
1467
1468
1469
1470
1471
1472
1473







-
+







	     * Here, we're parsing a floating-point number. 'significandWide'
	     * or 'significandBig' contains the exact significand, according
	     * to whether 'significandOverflow' is set. The desired floating
	     * point value is significand * 10**k, where
	     * k = numTrailZeros+exponent-numDigitsAfterDp.
	     */

	    objPtr->typePtr = &tclDoubleType;
	    objPtr->typePtr = tclDoubleTypePtr;
	    if (exponentSignum) {
		/*
		 * At this point exponent>=0, so the following calculation
		 * cannot underflow.
		 */
		exponent = -exponent;
	    }
1499
1500
1501
1502
1503
1504
1505
1506

1507
1508
1509
1510
1511
1512
1513

1514
1515
1516
1517
1518
1519
1520
1510
1511
1512
1513
1514
1515
1516

1517
1518
1519
1520
1521
1522
1523

1524
1525
1526
1527
1528
1529
1530
1531







-
+






-
+







	case sINF:
	case sINFINITY:
	    if (signum) {
		objPtr->internalRep.doubleValue = -HUGE_VAL;
	    } else {
		objPtr->internalRep.doubleValue = HUGE_VAL;
	    }
	    objPtr->typePtr = &tclDoubleType;
	    objPtr->typePtr = tclDoubleTypePtr;
	    break;

#ifdef IEEE_FLOATING_POINT
	case sNAN:
	case sNANFINISH:
	    objPtr->internalRep.doubleValue = MakeNaN(signum, significandWide);
	    objPtr->typePtr = &tclDoubleType;
	    objPtr->typePtr = tclDoubleTypePtr;
	    break;
#endif
	case INITIAL:
	    /* This case only to silence compiler warning. */
	    Tcl_Panic("TclParseNumber: state INITIAL can't happen here");
	}
    }
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
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







-
+
+


-
+
+


-
+
+


-
+
+


-
+
+


-
+
+







NormalizeRightward(
    Tcl_WideUInt *wPtr)		/* INOUT: Number to shift. */
{
    int rv = 0;
    Tcl_WideUInt w = *wPtr;

    if (!(w & (Tcl_WideUInt) 0xFFFFFFFF)) {
	w >>= 32; rv += 32;
	w >>= 32;
	rv += 32;
    }
    if (!(w & (Tcl_WideUInt) 0xFFFF)) {
	w >>= 16; rv += 16;
	w >>= 16;
	rv += 16;
    }
    if (!(w & (Tcl_WideUInt) 0xFF)) {
	w >>= 8; rv += 8;
	w >>= 8;
	rv += 8;
    }
    if (!(w & (Tcl_WideUInt) 0xF)) {
	w >>= 4; rv += 4;
	w >>= 4;
	rv += 4;
    }
    if (!(w & 0x3)) {
	w >>= 2; rv += 2;
	w >>= 2;
	rv += 2;
    }
    if (!(w & 0x1)) {
	w >>= 1; ++rv;
	w >>= 1;
	++rv;
    }
    *wPtr = w;
    return rv;
}

/*
 *----------------------------------------------------------------------
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
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







-
+
+

-
+
+


-
+
+


-
+
+


-
+
+


-
+
+


-
+
+







RequiredPrecision(
    Tcl_WideUInt w)		/* Number to interrogate. */
{
    int rv;
    unsigned long wi;

    if (w & ((Tcl_WideUInt) 0xFFFFFFFF << 32)) {
	wi = (unsigned long) (w >> 32); rv = 32;
	wi = (unsigned long) (w >> 32);
	rv = 32;
    } else {
	wi = (unsigned long) w; rv = 0;
	wi = (unsigned long) w;
	rv = 0;
    }
    if (wi & 0xFFFF0000) {
	wi >>= 16; rv += 16;
	wi >>= 16;
	rv += 16;
    }
    if (wi & 0xFF00) {
	wi >>= 8; rv += 8;
	wi >>= 8;
	rv += 8;
    }
    if (wi & 0xF0) {
	wi >>= 4; rv += 4;
	wi >>= 4;
	rv += 4;
    }
    if (wi & 0xC) {
	wi >>= 2; rv += 2;
	wi >>= 2;
	rv += 2;
    }
    if (wi & 0x2) {
	wi >>= 1; ++rv;
	wi >>= 1;
	++rv;
    }
    if (wi & 0x1) {
	++rv;
    }
    return rv;
}

3144
3145
3146
3147
3148
3149
3150
3151



3152
3153
3154
3155
3156
3157
3158
3168
3169
3170
3171
3172
3173
3174

3175
3176
3177
3178
3179
3180
3181
3182
3183
3184







-
+
+
+








    /*
     * Adjust if the logarithm was guessed wrong.
     */

    if (b < S) {
	b = 10 * b;
	++m2plus; ++m2minus; ++m5;
	++m2plus;
	++m2minus;
	++m5;
	ilim = ilim1;
	--k;
    }

    /*
     * Compute roundoff ranges.
     */
3523
3524
3525
3526
3527
3528
3529
3530



3531
3532
3533
3534
3535
3536
3537
3549
3550
3551
3552
3553
3554
3555

3556
3557
3558
3559
3560
3561
3562
3563
3564
3565







-
+
+
+








    /*
     * Adjust if the logarithm was guessed wrong.
     */

    if ((err == MP_OKAY) && (b.used <= sd)) {
	err = mp_mul_d(&b, 10, &b);
	++m2plus; ++m2minus; ++m5;
	++m2plus;
	++m2minus;
	++m5;
	ilim = ilim1;
	--k;
    }

    /*
     * mminus = 5**m5 * 2**m2minus
     * mplus = 5**m5 * 2**m2plus
3563
3564
3565
3566
3567
3568
3569
3570


3571
3572
3573
3574
3575
3576
3577
3591
3592
3593
3594
3595
3596
3597

3598
3599
3600
3601
3602
3603
3604
3605
3606







-
+
+







	if (b.used <= sd) {
	    digit = 0;
	} else {
	    digit = b.dp[sd];
	    if (b.used > sd+1 || digit >= 10) {
		Tcl_Panic("wrong digit!");
	    }
	    --b.used; mp_clamp(&b);
	    --b.used;
	    mp_clamp(&b);
	}

	/*
	 * Does the current digit put us on the low side of the exact value
	 * but within within roundoff of being exact?
	 */

4539
4540
4541
4542
4543
4544
4545
4546


4547
4548


4549
4550
4551
4552
4553
4554
4555
4568
4569
4570
4571
4572
4573
4574

4575
4576
4577

4578
4579
4580
4581
4582
4583
4584
4585
4586







-
+
+

-
+
+







	int len = i;

	/*
	 * Reduce numerator and denominator to lowest terms.
	 */

	if (b2 >= s2 && s2 > 0) {
	    b2 -= s2; s2 = 0;
	    b2 -= s2;
	    s2 = 0;
	} else if (s2 >= b2 && b2 > 0) {
	    s2 -= b2; b2 = 0;
	    s2 -= b2;
	    b2 = 0;
	}

	if (s5+1 < N_LOG2POW5 && s2+1 + log2pow5[s5+1] < 64) {
	    /*
	     * If 10*2**s2*5**s5 == 2**(s2+1)+5**(s5+1) fits in a 64-bit word,
	     * then all our intermediate calculations can be done using exact
	     * 64-bit arithmetic with no need for expensive multiprecision
Changes to generic/tclStringObj.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
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
+

-
-
-
+
+
+















-
-
-
-
-
-







/*
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 * Copyright © 1999 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclStringObj.c --
 *
 *	This file contains functions that implement string operations on Tcl
 *	objects. Some string operations work with UTF-8 encoding forms.
 *	Functions that require knowledge of the width of each character,
 *	such as indexing, operate on fixed width encoding forms such as UTF-32.
 * 	such as indexing, operate on fixed width encoding forms such as UTF-32.
 *
 *	Conceptually, a string is a sequence of Unicode code points. Internally
 *	it may be stored in an encoding form such as a modified version of
 *	UTF-8 or UTF-32.
 * 	Conceptually, a string is a sequence of Unicode code points. Internally
 * 	it may be stored in an encoding form such as a modified version of
 * 	UTF-8 or UTF-32.
 *
 *	The String object is optimized for the case where each UTF char
 *	in a string is only one byte. In this case, we store the value of
 *	numChars, but we don't store the fixed form encoding (unless
 *	Tcl_GetUnicode is explicitly called).
 *
 *	The String object type stores one or both formats. The default
 *	behavior is to store UTF-8. Once UTF-16/UTF32 is calculated, it is
 *	stored in the internal rep for future access (without an additional
 *	O(n) cost).
 *
 *	To allow many appends to be done to an object without constantly
 *	reallocating space, we allocate double the space and use the
 *	internal representation to keep track of how much space is used vs.
 *	allocated.
 *
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 * Copyright © 1999 Scriptics Corporation.
 *
 * 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 "tclTomMath.h"
#include "tclStringRep.h"
#include <assert.h>
/*
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
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







+
+








-
-
-











-
+







static Tcl_Size		ExtendStringRepWithUnicode(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, Tcl_Size numChars);
static void		ExtendUnicodeRepWithString(Tcl_Obj *objPtr,
			    const char *bytes, Tcl_Size numBytes,
			    Tcl_Size numAppendChars);
static void		FillUnicodeRep(Tcl_Obj *objPtr);
static void		FreeStringInternalRep(Tcl_Obj *objPtr);
static int		GetCharLength(Tcl_Obj *objPtr, Tcl_Size *length);
static int		GetRange(tclObjTypeInterfaceArgsStringRange);
static void		GrowStringBuffer(Tcl_Obj *objPtr, Tcl_Size needed, int flag);
static void		GrowUnicodeBuffer(Tcl_Obj *objPtr, Tcl_Size needed);
static int		SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		SetUnicodeObj(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, Tcl_Size numChars);
static Tcl_Size		UnicodeLength(const Tcl_UniChar *unicode);
static void		UpdateStringOfString(Tcl_Obj *objPtr);

#define ISCONTINUATION(bytes) (\
	((bytes)[0] & 0xC0) == 0x80)

/*
 * The structure below defines the string Tcl object type by means of
 * functions that can be invoked by generic object code.
 */

const Tcl_ObjType tclStringType = {
    "string",			/* name */
    FreeStringInternalRep,	/* freeIntRepPro */
    DupStringInternalRep,	/* dupIntRepProc */
    UpdateStringOfString,	/* updateStringProc */
    SetStringFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V0
	0
};

/*
 * TCL STRING GROWTH ALGORITHM
 *
 * When growing strings (during an append, for example), the following growth
 * algorithm is used:
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
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







-




+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+










-
+
+















-
+
+


















-
+
+







 *
 * Side effects:
 *	Frees old internal rep. Allocates memory for new "String" internal
 *	rep.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_GetCharLength(
    Tcl_Obj *objPtr)		/* The String object to get the num chars
				 * of. */
{
    int status;
    Tcl_Size length;
    status = TclObjectDispatch(objPtr, GetCharLength,
	string, length, objPtr ,&length);
    if (status) {
	/* to do 
	 *  have Tcl_GetCharLength return a standard result
	 */
	Tcl_Panic("%s failed", "Tcl_GetCharLength");
    }
    return length;
}

int
GetCharLength(
    Tcl_Obj *objPtr
    ,Tcl_Size *length
)
{
    String *stringPtr;
    Tcl_Size numChars = 0;

    /*
     * Quick, no-shimmer return for short string reps.
     */

    if ((objPtr->bytes) && (objPtr->length < 2)) {
	/* 0 bytes -> 0 chars; 1 byte -> 1 char */
	return objPtr->length;
	*length = objPtr->length;
	return TCL_OK;
    }

    /*
     * Optimize the case where we're really dealing with a bytearray object;
     * we don't need to convert to a string to perform the get-length operation.
     *
     * Starting in Tcl 8.7, we check for a "pure" bytearray, because the
     * machinery behind that test is using a proper bytearray ObjType.  We
     * could also compute length of an improper bytearray without shimmering
     * but there's no value in that. We *want* to shimmer an improper bytearray
     * because improper bytearrays have worthless internal reps.
     */

    if (TclIsPureByteArray(objPtr)) {
	(void) Tcl_GetBytesFromObj(NULL, objPtr, &numChars);
	return numChars;
	*length = numChars;
	return TCL_OK;
    }

    /*
     * OK, need to work with the object as a string.
     */

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);
    numChars = stringPtr->numChars;

    /*
     * If numChars is unknown, compute it.
     */

    if (numChars < 0) {
	TclNumUtfCharsM(numChars, objPtr->bytes, objPtr->length);
	stringPtr->numChars = numChars;
    }
    return numChars;
    *length = numChars;
    return TCL_OK;
}

Tcl_Size
TclGetCharLength(
    Tcl_Obj *objPtr)		/* The String object to get the num chars
				 * of. */
{
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
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







+
-
+
+
+

+
-
+


+
-
+




+
-
+



-
-
+
+
+
+
+
+
+



-
-
+
+
+
+
+
+
+



+
+
+
+
+
-
-
-
+
+
+
+
+
+







 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
int
TclCheckEmptyString(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
    Tcl_Obj *objPtr,
    int *res
)
{
    int status;
    Tcl_Size length = TCL_INDEX_NONE;
    Tcl_Size length = 0;

    if (objPtr->bytes == &tclEmptyString) {
	*res = TCL_EMPTYSTRING_YES;
	return TCL_EMPTYSTRING_YES;
	return TCL_OK;
    }

    if (TclIsPureByteArray(objPtr)
	    && Tcl_GetCharLength(objPtr) == 0) {
	*res = TCL_EMPTYSTRING_YES;
	return TCL_EMPTYSTRING_YES;
	return TCL_OK;
    }

    if (TclListObjIsCanonical(objPtr)) {
	TclListObjLength(NULL, objPtr, &length);
	return length == 0;
	status = TclListObjLength(interp, objPtr, &length);
	if (status) {
	    return status;
	} else {
	    *res = length == 0;
	    return TCL_OK;
	}
    }

    if (TclIsPureDict(objPtr)) {
	Tcl_DictObjSize(NULL, objPtr, &length);
	return length == 0;
	status = Tcl_DictObjSize(interp, objPtr, &length);
	if (status) {
	    return status;
	} else {
	    *res = length == 0;
	    return TCL_OK;
	}
    }

    if (objPtr->bytes == NULL) {
	if (TclObjectHasInterface(objPtr, string, isEmpty)) {
	    TclObjectDispatchNoDefault(interp ,status ,objPtr ,string
		,isEmpty ,interp ,objPtr ,res);
	    return status;
	} else {
	return TCL_EMPTYSTRING_UNKNOWN;
    }
    return objPtr->length == 0;
	    *res = TCL_EMPTYSTRING_UNKNOWN;
	    return TCL_OK;
	}
    }
    *res = objPtr->length == 0;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetUniChar --
 *
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
692
693
694
695
696
697
698






























699
700
701
702
703
704
705







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 * Side effects:
 *	Converts the object to have the String internal rep.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_GetUnicodeFromObj
#if !defined(TCL_NO_DEPRECATED)
Tcl_UniChar *
TclGetUnicodeFromObj(
    Tcl_Obj *objPtr,		/* The object to find the Unicode string
				 * for. */
    void *lengthPtr)		/* If non-NULL, the location where the string
				 * rep's Tcl_UniChar length should be stored. If
				 * NULL, no length is stored. */
{
    String *stringPtr;

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode == 0) {
	FillUnicodeRep(objPtr);
	stringPtr = GET_STRING(objPtr);
    }

    if (lengthPtr != NULL) {
	if (stringPtr->numChars > INT_MAX) {
	    Tcl_Panic("Tcl_GetUnicodeFromObj with 'int' lengthPtr"
		    " cannot handle such long strings. Please use 'Tcl_Size'");
	}
	*(int *)lengthPtr = (int)stringPtr->numChars;
    }
    return stringPtr->unicode;
}
#endif /* !defined(TCL_NO_DEPRECATED) */

Tcl_UniChar *
Tcl_GetUnicodeFromObj(
    Tcl_Obj *objPtr,		/* The object to find the unicode string
				 * for. */
    Tcl_Size *lengthPtr)	/* If non-NULL, the location where the string
				 * rep's unichar length should be stored. If
				 * NULL, no length is stored. */
717
718
719
720
721
722
723









724
725
726
727
728
729
730
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764







+
+
+
+
+
+
+
+
+








Tcl_Obj *
Tcl_GetRange(
    Tcl_Obj *objPtr,		/* The Tcl object to find the range of. */
    Tcl_Size first,		/* First index of the range. */
    Tcl_Size last)		/* Last index of the range. */
{
    Tcl_Obj *resPtr;
    TclObjectDispatch(objPtr, GetRange,
    string, range, objPtr, first, last, &resPtr);
    return resPtr;
}


int
GetRange(tclObjTypeInterfaceArgsStringRange) {
    Tcl_Obj *newObjPtr;		/* The Tcl object to find the range of. */
    String *stringPtr;
    Tcl_Size length = 0;

    if (first < 0) {
	first = 0;
    }
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
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







-
+
+

-
+
+















+
-
+







-
+
+

-
+
+








-
+
+









-
+
+

+
-
+
+


+







	unsigned char *bytes = Tcl_GetBytesFromObj(NULL, objPtr, &length);

	if (last < 0 || last >= length) {
	    last = length - 1;
	}
	if (last < first) {
	    TclNewObj(newObjPtr);
	    return newObjPtr;
		*resPtrPtr = newObjPtr;
	    return TCL_OK;
	}
	return Tcl_NewByteArrayObj(bytes + first, last - first + 1);
	*resPtrPtr = Tcl_NewByteArrayObj(bytes + first, last - first + 1);
	return TCL_OK;
    }

    /*
     * OK, need to work with the object as a string.
     */

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode == 0) {
	/*
	 * If numChars is unknown, compute it.
	 */

	if (stringPtr->numChars == TCL_INDEX_NONE) {
	    TclNumUtfCharsM(
	    TclNumUtfCharsM(stringPtr->numChars, objPtr->bytes, objPtr->length);
		stringPtr->numChars, objPtr->bytes, objPtr->length);
	}
	if (stringPtr->numChars == objPtr->length) {
	    if (last < 0 || last >= stringPtr->numChars) {
		last = stringPtr->numChars - 1;
	    }
	    if (last < first) {
		TclNewObj(newObjPtr);
		return newObjPtr;
		*resPtrPtr = newObjPtr;
		return TCL_OK;
	    }
	    newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last - first + 1);
	    newObjPtr = Tcl_NewStringObj(
		objPtr->bytes + first, last - first + 1);

	    /*
	     * Since we know the char length of the result, store it.
	     */

	    SetStringFromAny(NULL, newObjPtr);
	    stringPtr = GET_STRING(newObjPtr);
	    stringPtr->numChars = newObjPtr->length;
	    return newObjPtr;
	    *resPtrPtr = newObjPtr;
	    return TCL_OK;
	}
	FillUnicodeRep(objPtr);
	stringPtr = GET_STRING(objPtr);
    }
    if (last < 0 || last >= stringPtr->numChars) {
	last = stringPtr->numChars - 1;
    }
    if (last < first) {
	TclNewObj(newObjPtr);
	return newObjPtr;
	*resPtrPtr = newObjPtr;
	return TCL_OK;
    }
    *resPtrPtr = Tcl_NewUnicodeObj(
    return Tcl_NewUnicodeObj(stringPtr->unicode + first, last - first + 1);
		stringPtr->unicode + first, last - first + 1);
    return TCL_OK;
}


Tcl_Obj *
TclGetRange(
    Tcl_Obj *objPtr,		/* The Tcl object to find the range of. */
    Tcl_Size first,		/* First index of the range. */
    Tcl_Size last)		/* Last index of the range. */
{
    Tcl_Obj *newObjPtr;		/* The Tcl object to find the range of. */
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1286
1287
1288
1289
1290
1291
1292






1293
1294
1295
1296
1297
1298
1299







-
-
-
-
-
-







    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_AppendLimitedToObj");
    }

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    /* If appended string starts with a continuation byte or a lower surrogate,
     * force objPtr to unicode representation. See [7f1162a867] */
    if (bytes && ISCONTINUATION(bytes)) {
	Tcl_GetUnicode(objPtr);
	stringPtr = GET_STRING(objPtr);
    }
    if (stringPtr->hasUnicode && (stringPtr->numChars > 0)) {
	AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
    } else {
	AppendUtfToUtfRep(objPtr, bytes, toCopy);
    }

    if (length <= limit) {
1375
1376
1377
1378
1379
1380
1381

1382






1383

1384
1385
1386




1387

1388
1389
1390
1391
1392
1393
1394
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







+

+
+
+
+
+
+
-
+



+
+
+
+
-
+







    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    Tcl_Obj *appendObjPtr)	/* Object to append. */
{
    String *stringPtr;
    Tcl_Size length = 0, numChars;
    Tcl_Size appendNumChars = TCL_INDEX_NONE;
    const char *bytes;
    int isEmpty, status;

    status = TclCheckEmptyString(NULL, appendObjPtr, &isEmpty); 
    /* No way to return an error.  Panic. */
    if (status) {
	Tcl_Panic("%s: TclCheckEmptyString failed, %s", "Tcl_AppendObjToObj", "appendObjPtr");
    }

    if (TclCheckEmptyString(appendObjPtr) == TCL_EMPTYSTRING_YES) {
    if (isEmpty == TCL_EMPTYSTRING_YES) {
	return;
    }

    status = TclCheckEmptyString(NULL, objPtr, &isEmpty);
    if (status) {
	Tcl_Panic("%s: TclCheckEmptyString failed, %s", "Tcl_AppendObjToObj", "objPtr");
    }
    if (TclCheckEmptyString(objPtr) == TCL_EMPTYSTRING_YES) {
    if (isEmpty == TCL_EMPTYSTRING_YES) {
	TclSetDuplicateObj(objPtr, appendObjPtr);
	return;
    }

    if (TclIsPureByteArray(appendObjPtr)
	    && (TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString)) {
	/*
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
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







-
-
-
-
-
-
-
















-
+











-
+







    /*
     * Must append as strings.
     */

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    /* If appended string starts with a continuation byte or a lower surrogate,
     * force objPtr to unicode representation. See [7f1162a867]
     * This fixes append-3.4, append-3.7 and utf-1.18 testcases. */
    if (ISCONTINUATION(TclGetString(appendObjPtr))) {
	Tcl_GetUnicode(objPtr);
	stringPtr = GET_STRING(objPtr);
    }
    /*
     * If objPtr has a valid Unicode rep, then get a Unicode string from
     * appendObjPtr and append it.
     */

    if (stringPtr->hasUnicode) {
	/*
	 * If appendObjPtr is not of the "String" type, don't convert it.
	 */

	if (TclHasInternalRep(appendObjPtr, &tclStringType)) {
	    Tcl_UniChar *unicode =
		    Tcl_GetUnicodeFromObj(appendObjPtr, &numChars);

	    AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
	} else {
	    bytes = TclGetStringFromObj(appendObjPtr, &length);
	    bytes = Tcl_GetStringFromObj(appendObjPtr, &length);
	    AppendUtfToUnicodeRep(objPtr, bytes, length);
	}
	return;
    }

    /*
     * Append to objPtr's UTF string rep. If we know the number of characters
     * in both objects before appending, then set the combined number of
     * characters in the final (appended-to) object.
     */

    bytes = TclGetStringFromObj(appendObjPtr, &length);
    bytes = Tcl_GetStringFromObj(appendObjPtr, &length);

    numChars = stringPtr->numChars;
    if ((numChars >= 0) && TclHasInternalRep(appendObjPtr, &tclStringType)) {
	String *appendStringPtr = GET_STRING(appendObjPtr);

	appendNumChars = appendStringPtr->numChars;
    }
1859
1860
1861
1862
1863
1864
1865
1866

1867
1868
1869
1870
1871
1872
1873
1901
1902
1903
1904
1905
1906
1907

1908
1909
1910
1911
1912
1913
1914
1915







-
+







	"\"%n$\" argument index out of range"
    };
    static const char *overflow = "max size for a Tcl value exceeded";

    if (Tcl_IsShared(appendObj)) {
	Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj");
    }
    (void)TclGetStringFromObj(appendObj, &originalLength);
    (void)Tcl_GetStringFromObj(appendObj, &originalLength);
    limit = TCL_SIZE_MAX - originalLength;

    /*
     * Format string is NUL-terminated.
     */

    while (*format != '\0') {
2284
2285
2286
2287
2288
2289
2290
2291

2292
2293
2294
2295
2296
2297
2298
2326
2327
2328
2329
2330
2331
2332

2333
2334
2335
2336
2337
2338
2339
2340







-
+







		    TclNewIntObj(pure, w);
		} else if (useBig) {
		    pure = Tcl_NewBignumObj(&big);
		} else {
		    TclNewIntObj(pure, l);
		}
		Tcl_IncrRefCount(pure);
		bytes = TclGetStringFromObj(pure, &length);
		bytes = Tcl_GetStringFromObj(pure, &length);

		/*
		 * Already did the sign above.
		 */

		if (*bytes == '-') {
		    length--;
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
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







-
-
+
-






-
-
+
-
















-
-
+
+


















-
+








	    *p++ = (char) ch;
	    *p = '\0';

	    TclNewObj(segment);
	    allocSegment = 1;
	    if (!Tcl_AttemptSetObjLength(segment, length)) {
		if (allocSegment) {
		    Tcl_DecrRefCount(segment);
		Tcl_DecrRefCount(segment);
		}
		msg = overflow;
		errCode = "OVERFLOW";
		goto errorMsg;
	    }
	    bytes = TclGetString(segment);
	    if (!Tcl_AttemptSetObjLength(segment, snprintf(bytes, segment->length, spec, d))) {
		if (allocSegment) {
		    Tcl_DecrRefCount(segment);
		Tcl_DecrRefCount(segment);
		}
		msg = overflow;
		errCode = "OVERFLOW";
		goto errorMsg;
	    }
	    if (ch == 'A') {
		char *q = TclGetString(segment) + 1;
		*q = 'x';
		q = strchr(q, 'P');
		if (q) {
		    *q = 'p';
		}
	    }
	    break;
	}
	default:
	    if (interp != NULL) {
		Tcl_SetObjResult(interp,
			Tcl_ObjPrintf("bad field specifier \"%c\"", ch));
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"bad field specifier \"%c\"", ch));
		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", (char *)NULL);
	    }
	    goto error;
	}

	if (width>0 && numChars<0) {
	    numChars = Tcl_GetCharLength(segment);
	}
	if (!gotMinus && width>0) {
	    if (numChars < width) {
		limit -= width - numChars;
	    }
	    while (numChars < width) {
		Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1);
		numChars++;
	    }
	}

	(void)TclGetStringFromObj(segment, &segmentNumBytes);
	(void)Tcl_GetStringFromObj(segment, &segmentNumBytes);
	if (segmentNumBytes > limit) {
	    if (allocSegment) {
		Tcl_DecrRefCount(segment);
	    }
	    msg = overflow;
	    errCode = "OVERFLOW";
	    goto errorMsg;
2757
2758
2759
2760
2761
2762
2763
2764

2765
2766
2767
2768
2769
2770
2771
2795
2796
2797
2798
2799
2800
2801

2802
2803
2804
2805
2806
2807
2808
2809







-
+







		q = bytes + 4;
		while ((bytes < end) && (bytes < q)
			&& ((*bytes & 0xC0) == 0x80)) {
		    bytes++;
		}

		Tcl_ListObjAppendElement(NULL, list,
			Tcl_NewStringObj(bytes , (end - bytes)));
			Tcl_NewStringObj(bytes, (end - bytes)));

		break;
	    }
	    case 'p':
		if (sizeof(size_t) == sizeof(Tcl_WideInt)) {
		    size = 2;
		}
2802
2803
2804
2805
2806
2807
2808
2809
2810


2811
2812
2813


2814
2815
2816
2817
2818
2819
2820
2840
2841
2842
2843
2844
2845
2846


2847
2848
2849


2850
2851
2852
2853
2854
2855
2856
2857
2858







-
-
+
+

-
-
+
+







	    case 'A':
	    case 'e':
	    case 'E':
	    case 'f':
	    case 'g':
	    case 'G':
		if (size > 0) {
		Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj(
			(double)va_arg(argList, long double)));
		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj(
			    (double) va_arg(argList, long double)));
		} else {
			Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj(
				va_arg(argList, double)));
		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj(
			    va_arg(argList, double)));
		}
		seekingConversion = 0;
		break;
	    case '*':
		lastNum = va_arg(argList, int);
		Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(lastNum));
		p++;
2957
2958
2959
2960
2961
2962
2963
2964

2965
2966
2967
2968
2969
2970
2971
2995
2996
2997
2998
2999
3000
3001

3002
3003
3004
3005
3006
3007
3008
3009







-
+







TclGetStringStorage(
    Tcl_Obj *objPtr,
    Tcl_Size *sizePtr)
{
    String *stringPtr;

    if (!TclHasInternalRep(objPtr, &tclStringType) || objPtr->bytes == NULL) {
	return TclGetStringFromObj(objPtr, sizePtr);
	return Tcl_GetStringFromObj(objPtr, sizePtr);
    }

    stringPtr = GET_STRING(objPtr);
    *sizePtr = stringPtr->allocated;
    return objPtr->bytes;
}

3023
3024
3025
3026
3027
3028
3029
3030

3031
3032
3033
3034
3035
3036
3037
3061
3062
3063
3064
3065
3066
3067

3068
3069
3070
3071
3072
3073
3074
3075







-
+







	maxCount = TCL_SIZE_MAX;
    } else if (unichar) {
	/* Result will be pure Tcl_UniChar array. Pre-size it. */
	(void)Tcl_GetUnicodeFromObj(objPtr, &length);
	maxCount = TCL_SIZE_MAX/sizeof(Tcl_UniChar);
    } else {
	/* Result will be concat of string reps. Pre-size it. */
	(void)TclGetStringFromObj(objPtr, &length);
	(void)Tcl_GetStringFromObj(objPtr, &length);
	maxCount = TCL_SIZE_MAX;
    }

    if (length == 0) {
	/* Any repeats of empty is empty. */
	return objPtr;
    }
3147
3148
3149
3150
3151
3152
3153
3154

3155
3156
3157
3158
3159
3160
3161
3185
3186
3187
3188
3189
3190
3191

3192
3193
3194
3195
3196
3197
3198
3199







-
+







    Tcl_Size objc,
    Tcl_Obj * const objv[],
    int flags)
{
    Tcl_Obj *objResultPtr, * const *ov;
    int binary = 1;
    Tcl_Size oc, length = 0;
    int allowUniChar = 1, requestUniChar = 0, forceUniChar = 0;
    int allowUniChar = 1, requestUniChar = 0;
    Tcl_Size first = objc - 1;	/* Index of first value possibly not empty */
    Tcl_Size last = 0;		/* Index of last value possibly not empty */
    int inPlace = (flags & TCL_STRING_IN_PLACE) && !Tcl_IsShared(*objv);

    if (objc <= 1) {
	if (objc != 1) {
	    /* Negative (shouldn't be) no objects; return empty */
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
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







-
-
-
-
+
+
+
+

-
-
+
+
-
-
-
-
-
+
+
+
+







	Tcl_Obj *objPtr = *ov++;

	if (TclIsPureByteArray(objPtr)) {
	    allowUniChar = 0;
	} else if (objPtr->bytes) {
	    /* Value has a string rep. */
	    if (objPtr->length) {
		/*
		 * Non-empty string rep. Not a pure bytearray, so we won't
		 * create a pure bytearray.
		 */
			/*
			 * Non-empty string rep. Not a pure bytearray, so we won't
			 * create a pure bytearray.
			 */

		binary = 0;
		if (ov > objv+1 && ISCONTINUATION(TclGetString(objPtr))) {
			binary = 0;
			if ((objPtr->typePtr)
		    forceUniChar = 1;
		} else if ((objPtr->typePtr) && !TclHasInternalRep(objPtr, &tclStringType)) {
		    /* Prevent shimmer of non-string types. */
		    allowUniChar = 0;
		}
				&& !TclHasInternalRep(objPtr, &tclStringType)) {
				/* Prevent shimmer of non-string types. */
				allowUniChar = 0;
			}
	    }
	} else {
	    binary = 0;
	    if (TclHasInternalRep(objPtr, &tclStringType)) {
		/* Have a pure Unicode value; ask to preserve it */
		requestUniChar = 1;
	    } else {
3236
3237
3238
3239
3240
3241
3242
3243

3244
3245
3246
3247
3248
3249
3250
3273
3274
3275
3276
3277
3278
3279

3280
3281
3282
3283
3284
3285
3286
3287







-
+







		    if (length > (TCL_SIZE_MAX-numBytes)) {
			goto overflow;
		    }
		    length += numBytes;
		}
	    }
	} while (--oc);
    } else if ((allowUniChar && requestUniChar) || forceUniChar) {
    } else if ((allowUniChar && requestUniChar)) {
	/*
	 * Result will be pure Tcl_UniChar array. Pre-size it.
	 */

	ov = objv;
	oc = objc;
	do {
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
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







-
+
+









+


+
+
+
+
-
+
-



-
+







		    }
		    length += numChars;
		}
	    }
	} while (--oc);
    } else {
	/* Result will be concat of string reps. Pre-size it. */
	ov = objv; oc = objc;
	ov = objv;
	oc = objc;
	do {
	    Tcl_Obj *pendingPtr = NULL;

	    /*
	     * Loop until a possibly non-empty value is reached.
	     * Keep string rep generation pending when possible.
	     */

	    do {
		int isEmpty, status;
		Tcl_Obj *objPtr = *ov++;

		status = TclCheckEmptyString(NULL, objPtr, &isEmpty);
		if (status) {
		    return NULL;
		}
		if (objPtr->bytes == NULL
		if (objPtr->bytes == NULL && isEmpty != TCL_EMPTYSTRING_YES) {
			&& TclCheckEmptyString(objPtr) != TCL_EMPTYSTRING_YES) {
		    /* No string rep; Take the chance we can avoid making it */
		    pendingPtr = objPtr;
		} else {
		    (void) TclGetStringFromObj(objPtr, &length); /* PANIC? */
		    (void) Tcl_GetStringFromObj(objPtr, &length); /* PANIC? */
		}
	    } while (--oc && (length == 0) && (pendingPtr == NULL));

	    /*
	     * Either we found a possibly non-empty value, and we remember
	     * this index as the first and last such value so far seen,
	     * or (oc == 0) and all values are known empty,
3305
3306
3307
3308
3309
3310
3311
3312

3313
3314
3315
3316
3317
3318
3319

3320
3321
3322
3323
3324
3325
3326
3347
3348
3349
3350
3351
3352
3353

3354
3355
3356
3357
3358
3359
3360

3361
3362
3363
3364
3365
3366
3367
3368







-
+






-
+







		 * There's a pending value followed by more values.  Loop over
		 * remaining values generating strings until a non-empty value
		 * is found, or the pending value gets its string generated.
		 */

		do {
		    Tcl_Obj *objPtr = *ov++;
		    (void)TclGetStringFromObj(objPtr, &numBytes); /* PANIC? */
		    (void)Tcl_GetStringFromObj(objPtr, &numBytes); /* PANIC? */
		} while (--oc && numBytes == 0 && pendingPtr->bytes == NULL);

		if (numBytes) {
		    last = objc -oc -1;
		}
		if (oc || numBytes) {
		    (void)TclGetStringFromObj(pendingPtr, &length);
		    (void)Tcl_GetStringFromObj(pendingPtr, &length);
		}
		if (length == 0) {
		    if (numBytes) {
			first = last;
		    }
		} else if (numBytes > (TCL_SIZE_MAX - length)) {
		    goto overflow;
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
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







+
-
+














-
+
+








    if (last <= first /*|| length == 0 */) {
	/* Only one non-empty value or zero length; return first */
	/* NOTE: (length == 0) implies (last <= first) */
	return objv[first];
    }

    objv += first;
    objv += first; objc = (last - first + 1);
    objc = (last - first + 1);
    inPlace = (flags & TCL_STRING_IN_PLACE) && !Tcl_IsShared(*objv);

    if (binary) {
	/* Efficiently produce a pure byte array result */
	unsigned char *dst;

	/*
	 * Broken interface! Byte array value routines offer no way to handle
	 * failure to allocate enough space. Following stanza may panic.
	 */

	if (inPlace) {
	    Tcl_Size start = 0;

	    objResultPtr = *objv++; objc--;
	    objResultPtr = *objv++;
	    objc--;
	    (void)Tcl_GetBytesFromObj(NULL, objResultPtr, &start);
	    dst = Tcl_SetByteArrayLength(objResultPtr, length) + start;
	} else {
	    objResultPtr = Tcl_NewByteArrayObj(NULL, length);
	    dst = Tcl_SetByteArrayLength(objResultPtr, length);
	}
	while (objc--) {
3386
3387
3388
3389
3390
3391
3392
3393

3394
3395
3396
3397
3398
3399
3400


3401
3402
3403
3404
3405
3406
3407
3430
3431
3432
3433
3434
3435
3436

3437
3438
3439
3440
3441
3442
3443

3444
3445
3446
3447
3448
3449
3450
3451
3452







-
+






-
+
+







	    if (TclIsPureByteArray(objPtr)) {
		Tcl_Size more = 0;
		unsigned char *src = Tcl_GetBytesFromObj(NULL, objPtr, &more);
		memcpy(dst, src, more);
		dst += more;
	    }
	}
    } else if ((allowUniChar && requestUniChar) || forceUniChar) {
    } else if ((allowUniChar && requestUniChar)) {
	/* Efficiently produce a pure Tcl_UniChar array result */
	Tcl_UniChar *dst;

	if (inPlace) {
	    Tcl_Size start;

	    objResultPtr = *objv++; objc--;
	    objResultPtr = *objv++;
	    objc--;

	    /* Ugly interface! Force resize of the unicode array. */
	    (void)Tcl_GetUnicodeFromObj(objResultPtr, &start);
	    Tcl_InvalidateStringRep(objResultPtr);
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
3444
3445
3446
3447
3448
3449
3450
3451


3452
3453

3454
3455
3456
3457
3458
3459
3460
3489
3490
3491
3492
3493
3494
3495

3496
3497
3498

3499
3500
3501
3502
3503
3504
3505
3506







-
+
+

-
+







    } else {
	/* Efficiently concatenate string reps */
	char *dst;

	if (inPlace) {
	    Tcl_Size start;

	    objResultPtr = *objv++; objc--;
	    objResultPtr = *objv++;
	    objc--;

	    (void)TclGetStringFromObj(objResultPtr, &start);
	    (void)Tcl_GetStringFromObj(objResultPtr, &start);
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"concatenation failed: unable to alloc %" TCL_SIZE_MODIFIER "d bytes",
			length));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL);
		}
3478
3479
3480
3481
3482
3483
3484
3485

3486
3487
3488
3489
3490
3491
3492
3524
3525
3526
3527
3528
3529
3530

3531
3532
3533
3534
3535
3536
3537
3538







-
+







	    dst = TclGetString(objResultPtr);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		Tcl_Size more;
		char *src = TclGetStringFromObj(objPtr, &more);
		char *src = Tcl_GetStringFromObj(objPtr, &more);

		memcpy(dst, src, more);
		dst += more;
	    }
	}
	/* Must NUL-terminate! */
	*dst = '\0';
3636
3637
3638
3639
3640
3641
3642
3643

3644
3645
3646
3647
3648
3649
3650
3682
3683
3684
3685
3686
3687
3688

3689
3690
3691
3692
3693
3694
3695
3696







-
+







    Tcl_Obj *value2Ptr,
    int checkEq,		/* comparison is only for equality */
    int nocase,			/* comparison is not case sensitive */
    Tcl_Size reqlength)		/* requested length in characters;
				 * TCL_INDEX_NONE to compare whole strings */
{
    const char *s1, *s2;
    int empty, match;
    int empty, empty2, match, status;
    Tcl_Size length, s1len = 0, s2len = 0;
    memCmpFn_t memCmpFn;

    if ((reqlength == 0) || (value1Ptr == value2Ptr)) {
	/*
	 * Always match at 0 chars of if it is the same obj.
	 * Note: as documented reqlength negative means it is ignored
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
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







-
+
+
+
+
+
+
+
+
+
+

-
+



-
+









-
+




-
+










-
-
+
+







			}
		    } else {
			memCmpFn = UniCharNmemcmp;
		    }
		}
	    }
	} else {
	    empty = TclCheckEmptyString(value1Ptr);
	    status = TclCheckEmptyString(NULL, value1Ptr, &empty);
	    if (status) {
		/* No way to report an error */
		Tcl_Panic("TclStringCmp  TclCheckEmptyString value1Ptr");
	    }
	    status = TclCheckEmptyString(NULL, value2Ptr, &empty2);
	    if (status) {
		/* No way to report an error */
		Tcl_Panic("TclStringCmp  TclCheckEmptyString value2Ptr");
	    }
	    if (empty > 0) {
		switch (TclCheckEmptyString(value2Ptr)) {
		switch (empty2) {
		case -1:
		    s1 = "";
		    s1len = 0;
		    s2 = TclGetStringFromObj(value2Ptr, &s2len);
		    s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
		    break;
		case 0:
		    match = -1;
		    goto matchdone;
		case 1:
		default: /* avoid warn: `s2` may be used uninitialized */
		    match = 0;
		    goto matchdone;
		}
	    } else if (TclCheckEmptyString(value2Ptr) > 0) {
	    } else if (empty2 > 0) {
		switch (empty) {
		case -1:
		    s2 = "";
		    s2len = 0;
		    s1 = TclGetStringFromObj(value1Ptr, &s1len);
		    s1 = Tcl_GetStringFromObj(value1Ptr, &s1len);
		    break;
		case 0:
		    match = 1;
		    goto matchdone;
		case 1:
		default: /* avoid warn: `s1` may be used uninitialized */
		    match = 0;
		    goto matchdone;
		}
	    } else {
		s1 = TclGetStringFromObj(value1Ptr, &s1len);
		s2 = TclGetStringFromObj(value2Ptr, &s2len);
		s1 = Tcl_GetStringFromObj(value1Ptr, &s1len);
		s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
	    }
	    if (!nocase && checkEq && reqlength < 0) {
		/*
		 * When we have equal-length we can check only for
		 * (in)equality. We can use memcmp in all (n)eq cases because
		 * we don't need to worry about lexical LE/BE variance.
		 */
3909
3910
3911
3912
3913
3914
3915


























3916
3917
3918
3919
3920
3921
3922
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
3999
4000
4001
4002
4003







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	    goto firstEnd;
	}
    }
  firstEnd:
    TclNewIndexObj(obj, value);
    return obj;
}

int
TclStringIndexInterface(
    Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *indexPtr, Tcl_Obj **charPtrPtr)
{
    Tcl_Size index, status;

    status = TclGetIntForIndexM(interp, indexPtr, /*endValue*/ TCL_SIZE_MAX - 1,
	&index);
    if (status != TCL_OK) {
	return status;
    }

    if (TclIndexIsFromEnd(index)) {
	if (TclObjectInterfaceCall(objPtr, string, indexEnd,
	    interp, objPtr, index, charPtrPtr) != TCL_OK) {
	    return TCL_ERROR;
	}
    } else {
	if (TclObjectInterfaceCall(objPtr, string, index, interp, objPtr,
	    index, charPtrPtr) != TCL_OK) {
	    return TCL_ERROR;
	}
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclStringLast --
 *
 *	Implements the [string last] operation.
Changes to generic/tclStringRep.h.

















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









-
-
-
-
-
-







/*
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclStringRep.h --
 *
 *  This file contains the definition of internal representations of a string
 *  and macros to access it.
 *
 *  Conceptually, a string is a sequence of Unicode code points. Internally
 *  it may be stored in an encoding form such as a modified version of UTF-8
 *  or UTF-32.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef _TCLSTRINGREP
#define _TCLSTRINGREP

/*
 * The following structure is the internal rep for a String object. It keeps
Changes to generic/tclStringTrim.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
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

-
-
-
-
-
-










+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclStringTrim.h --
 *
 *	This file contains the definition of what characters are to be trimmed
 *	from a string by [string trim] by default. It's only needed by Tcl's
 *	implementation; it does not form a public or private API at all.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 Scriptics Corporation.
 * Copyright (c) 2002 ActiveState Corporation.
 * Copyright (c) 2003-2013 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclStringTrim.h --
 *
 *	This file contains the definition of what characters are to be trimmed
 *	from a string by [string trim] by default. It's only needed by Tcl's
 *	implementation; it does not form a public or private API at all.
 */

#ifndef TCL_STRING_TRIM_H
#define TCL_STRING_TRIM_H

/*
 * Default set of characters to trim in [string trim] and friends. This is a
 * UTF-8 literal string containing all Unicode space characters. [TIP #413]
 */
Changes to generic/tclStubCall.c.
1
2
3
4
5
6
7













8
9
10
11
12
13


14
15
16
17
18
19
20
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

-
-




+
+
+
+
+
+
+
+
+
+
+
+
+




-
-
+
+







/*
 * tclStubCall.c --
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclStubCall.c --
 */

#include "tclInt.h"
#ifndef _WIN32
#   include <dlfcn.h>
#else
#   define dlopen(a,b) (void *)LoadLibraryW(JOIN(L,a))
#   define dlsym(a,b) (void *)GetProcAddress((HMODULE)(a),b)
#   define dlopen(a, b)	(void *)LoadLibraryW(JOIN(L, a))
#   define dlsym(a, b)	(void *)GetProcAddress((HMODULE)(a), b)
#   define dlerror() ""
#endif

MODULE_SCOPE void *tclStubsHandle;

/*
 *----------------------------------------------------------------------
48
49
50
51
52
53
54
55

56
57
58
59
60
61
62


63
64
65
66
67
68
69
59
60
61
62
63
64
65

66
67
68
69
70
71
72

73
74
75
76
77
78
79
80
81







-
+






-
+
+







    "_Tcl_StaticLibrary", /* "arg" == (void *)6 */
    "_Tcl_SetExitProc", /* "arg" == (void *)7 */
    "_Tcl_GetMemoryInfo", /* "arg" == (void *)8 */
    "_Tcl_SetPreInitScript" /* "arg" == (void *)9 */
};

MODULE_SCOPE const void *nullVersionProc(void) {
	return NULL;
    return NULL;
}

static const char CANNOTCALL[] = "Cannot call %s from stubbed extension\n";
static const char CANNOTFIND[] = "Cannot find %s: %s\n";

MODULE_SCOPE void *
TclStubCall(void *arg)
TclStubCall(
    void *arg)
{
    static void *stubFn[] = {NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL};
    size_t index = PTR2UINT(arg);

    if (index >= sizeof(PROCNAME)/sizeof(PROCNAME[0])) {
	/* Any other value means Tcl_SetPanicProc() with non-null panicProc */
	index = 0;
Changes to generic/tclStubInit.c.
1
2
3
4
5
6
7
8
9
10
11















12
13
14
15
16
17
18
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

-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclStubInit.c --
 *
 *	This file contains the initializers for the Tcl stub vectors.
 *
 * Copyright © 1998-1999 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclStubInit.c --
 *
 *	This file contains the initializers for the Tcl stub vectors.
 */

#include "tclInt.h"
#include "tommath_private.h"
#include "tclTomMath.h"

#ifdef __CYGWIN__
#   include <wchar.h>
#endif
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
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







+
+
+
+
+

+






-
+
-
-
+


-











-








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







#undef Tcl_ListObjGetElements
#undef Tcl_ListObjLength
#undef Tcl_DictObjSize
#undef Tcl_SplitList
#undef Tcl_SplitPath
#undef Tcl_FSSplitPath
#undef Tcl_ParseArgsObjv
#undef TclpInetNtoa
#undef TclWinGetServByName
#undef TclWinGetSockOpt
#undef TclWinSetSockOpt
#undef TclWinNToHS
#undef TclStaticLibrary
#undef Tcl_BackgroundError
#define TclStaticLibrary Tcl_StaticLibrary
#undef TclObjInterpProc
#if !defined(_WIN32) && !defined(__CYGWIN__)
# undef Tcl_WinConvertError
# define Tcl_WinConvertError 0
#endif
#undef TclGetStringFromObj
# undef TclGetBytesFromObj
#if defined(TCL_NO_DEPRECATED)
# define TclGetStringFromObj 0
# undef TclGetUnicodeFromObj
# define TclGetBytesFromObj 0
# define TclGetUnicodeFromObj 0
#endif
#undef Tcl_Close
#define Tcl_Close 0
#undef Tcl_GetByteArrayFromObj
#define Tcl_GetByteArrayFromObj 0
#define TclUnusedStubEntry 0
#define TclUtfCharComplete Tcl_UtfCharComplete
#define TclUtfNext Tcl_UtfNext
#define TclUtfPrev Tcl_UtfPrev
#undef TclListObjGetElements
#undef TclListObjLength

#if defined(TCL_NO_DEPRECATED)
# define TclListObjGetElements 0
# define TclListObjLength 0
# define TclDictObjSize 0
# define TclSplitList 0
# define TclSplitPath 0
# define TclFSSplitPath 0
# define TclParseArgsObjv 0
# define TclGetAliasObj 0
#else /* !defined(TCL_NO_DEPRECATED) */
int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr,
    void *objcPtr, Tcl_Obj ***objvPtr) {
    Tcl_Size n = TCL_INDEX_NONE;
    int result = Tcl_ListObjGetElements(interp, listPtr, &n, objvPtr);
    if (objcPtr) {
	if ((sizeof(int) != sizeof(Tcl_Size)) && (result == TCL_OK) && (n > INT_MAX)) {
	    if (interp) {
		Tcl_AppendResult(interp, "List too large to be processed", (void *)NULL);
	    }
	    return TCL_ERROR;
	}
	*(int *)objcPtr = (int)n;
    }
    return result;
}
int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr,
    void *lengthPtr) {
    Tcl_Size n = TCL_INDEX_NONE;
    int result = Tcl_ListObjLength(interp, listPtr, &n);
    if (lengthPtr) {
	if ((sizeof(int) != sizeof(Tcl_Size)) && (result == TCL_OK) && (n > INT_MAX)) {
	    if (interp) {
		Tcl_AppendResult(interp, "List too large to be processed", (void *)NULL);
	    }
	    return TCL_ERROR;
	}
	*(int *)lengthPtr = (int)n;
    }
    return result;
}
int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr,
    void *sizePtr) {
    Tcl_Size n = TCL_INDEX_NONE;
    int result = Tcl_DictObjSize(interp, dictPtr, &n);
    if (sizePtr) {
	if ((sizeof(int) != sizeof(Tcl_Size)) && (result == TCL_OK) && (n > INT_MAX)) {
	    if (interp) {
		Tcl_AppendResult(interp, "Dict too large to be processed", (void *)NULL);
	    }
	    return TCL_ERROR;
	}
	*(int *)sizePtr = (int)n;
    }
    return result;
}
int TclSplitList(Tcl_Interp *interp, const char *listStr, void *argcPtr,
	const char ***argvPtr) {
    Tcl_Size n = TCL_INDEX_NONE;
    int result = Tcl_SplitList(interp, listStr, &n, argvPtr);
    if (argcPtr) {
	if ((sizeof(int) != sizeof(Tcl_Size)) && (result == TCL_OK) && (n > INT_MAX)) {
	    if (interp) {
		Tcl_AppendResult(interp, "List too large to be processed", (void *)NULL);
	    }
	    Tcl_Free((void *)*argvPtr);
	    return TCL_ERROR;
	}
	*(int *)argcPtr = (int)n;
    }
    return result;
}
void TclSplitPath(const char *path, void *argcPtr, const char ***argvPtr) {
    Tcl_Size n = TCL_INDEX_NONE;
    Tcl_SplitPath(path, &n, argvPtr);
    if (argcPtr) {
	if ((sizeof(int) != sizeof(Tcl_Size)) && (n > INT_MAX)) {
	    n = TCL_INDEX_NONE; /* No other way to return an error-situation */
	    Tcl_Free((void *)*argvPtr);
	    *argvPtr = NULL;
	}
	*(int *)argcPtr = (int)n;
    }
}
Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, void *lenPtr) {
    Tcl_Size n = TCL_INDEX_NONE;
    Tcl_Obj *result = Tcl_FSSplitPath(pathPtr, &n);
    if (lenPtr) {
	if ((sizeof(int) != sizeof(Tcl_Size)) && result && (n > INT_MAX)) {
	    Tcl_DecrRefCount(result);
	    return NULL;
	}
	*(int *)lenPtr = (int)n;
    }
    return result;
}
int TclParseArgsObjv(Tcl_Interp *interp,
	const Tcl_ArgvInfo *argTable, void *objcPtr, Tcl_Obj *const *objv,
	Tcl_Obj ***remObjv) {
    Tcl_Size n = (*(int *)objcPtr < 0) ? TCL_INDEX_NONE: (Tcl_Size)*(int *)objcPtr ;
    int result = Tcl_ParseArgsObjv(interp, argTable, &n, objv, remObjv);
    *(int *)objcPtr = (int)n;
    return result;
}
int TclGetAliasObj(Tcl_Interp *interp, const char *childCmd,
	Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
	int *objcPtr, Tcl_Obj ***objv) {
    Tcl_Size n = TCL_INDEX_NONE;
    int result = Tcl_GetAliasObj(interp, childCmd, targetInterpPtr, targetCmdPtr, &n, objv);
    if (objcPtr) {
	if ((sizeof(int) != sizeof(Tcl_Size)) && (result == TCL_OK) && (n > INT_MAX)) {
	    if (interp) {
		Tcl_AppendResult(interp, "List too large to be processed", NULL);
	    }
	    return TCL_ERROR;
	}
	*objcPtr = (int)n;
    }
    return result;
}
#endif /* !defined(TCL_NO_DEPRECATED) */

#define TclBN_mp_add mp_add
#define TclBN_mp_add_d mp_add_d
#define TclBN_mp_and mp_and
#define TclBN_mp_clamp mp_clamp
#define TclBN_mp_clear mp_clear
#define TclBN_mp_clear_multi mp_clear_multi
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
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







-
+
+











+
-
+








-
+
+










+
-
-
+
+
+
+
+
+
+














+
-
-
+
+
+
+
+
+
+







    /* dummy implementation, no need to do anything */
}
#   define TclWinAddProcess (void (*) (void *, Tcl_Size)) doNothing
#   define TclWinFlushDirtyChannels doNothing

#define TclWinNoBackslash winNoBackslash
static char *
TclWinNoBackslash(char *path)
TclWinNoBackslash(
    char *path)
{
    char *p;

    for (p = path; *p != '\0'; p++) {
	if (*p == '\\') {
	    *p = '/';
	}
    }
    return path;
}

void *
void *TclWinGetTclInstance(void)
TclWinGetTclInstance(void)
{
    void *hInstance = NULL;
    GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS,
	    (const wchar_t *)&TclWinNoBackslash, &hInstance);
    return hInstance;
}

Tcl_Size
TclpGetPid(Tcl_Pid pid)
TclpGetPid(
    Tcl_Pid pid)
{
    return (Tcl_Size)PTR2INT(pid);
}

#if defined(TCL_WIDE_INT_IS_LONG)
/* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore
 * we have to make sure that all stub entries on Cygwin64 follow the Win64
 * signature. Tcl 9 must find a better solution, but that cannot be done
 * without introducing a binary incompatibility.
 */
#define Tcl_GetLongFromObj \
#define Tcl_GetLongFromObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))(void *)Tcl_GetIntFromObj
static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){
	(int(*)(Tcl_Interp*,Tcl_Obj*,long*))(void *)Tcl_GetIntFromObj
static int
exprInt(
    Tcl_Interp *interp,
    const char *expr,
    int *ptr)
{
    long longValue;
    int result = Tcl_ExprLong(interp, expr, &longValue);
    if (result == TCL_OK) {
	if ((longValue >= (long)(INT_MIN))
		&& (longValue <= (long)(UINT_MAX))) {
	    *ptr = (int)longValue;
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "integer value too large to represent", -1));
	    result = TCL_ERROR;
	}
    }
    return result;
}
#define Tcl_ExprLong \
#define Tcl_ExprLong (int(*)(Tcl_Interp*,const char*,long*))(void *)exprInt
static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){
	(int(*)(Tcl_Interp*,const char*,long*))(void *)exprInt
static int
exprIntObj(
    Tcl_Interp *interp,
    Tcl_Obj*expr,
    int *ptr)
{
    long longValue;
    int result = Tcl_ExprLongObj(interp, expr, &longValue);
    if (result == TCL_OK) {
	if ((longValue >= (long)(INT_MIN))
		&& (longValue <= (long)(UINT_MAX))) {
	    *ptr = (int)longValue;
	} else {
398
399
400
401
402
403
404
405
406
407
408









409
410
411
412
413
414
415
316
317
318
319
320
321
322




323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338







-
-
-
-
+
+
+
+
+
+
+
+
+







 */
#pragma GCC diagnostic ignored "-Wdeprecated-declarations"
#endif

#ifdef TCL_WITH_EXTERNAL_TOMMATH
/* If Tcl is linked with an external libtommath 1.2.x, then mp_expt_n doesn't
 * exist (since that was introduced in libtommath 1.3.0. Provide it here.) */
mp_err MP_WUR TclBN_mp_expt_n(const mp_int *a, int b, mp_int *c) {
   if ((unsigned)b > MP_MIN(MP_DIGIT_MAX, INT_MAX)) {
      return MP_VAL;
   }
mp_err MP_WUR
TclBN_mp_expt_n(
    const mp_int *a,
    int b,
    mp_int *c)
{
    if ((unsigned)b > MP_MIN(MP_DIGIT_MAX, INT_MAX)) {
	return MP_VAL;
    }
    return mp_expt_u32(a, (uint32_t)b, c);;
}
#endif /* TCL_WITH_EXTERNAL_TOMMATH */

/* !BEGIN!: Do not edit below this line. */

static const TclIntStubs tclIntStubs = {
856
857
858
859
860
861
862
863

864
865
866
867

868
869

870
871
872
873
874
875
876
779
780
781
782
783
784
785

786
787
788
789

790
791

792
793
794
795
796
797
798
799







-
+



-
+

-
+







    Tcl_GetDouble, /* 34 */
    Tcl_GetDoubleFromObj, /* 35 */
    0, /* 36 */
    Tcl_GetInt, /* 37 */
    Tcl_GetIntFromObj, /* 38 */
    Tcl_GetLongFromObj, /* 39 */
    Tcl_GetObjType, /* 40 */
    TclGetStringFromObj, /* 41 */
    0, /* 41 */
    Tcl_InvalidateStringRep, /* 42 */
    Tcl_ListObjAppendList, /* 43 */
    Tcl_ListObjAppendElement, /* 44 */
    TclListObjGetElements, /* 45 */
    0, /* 45 */
    Tcl_ListObjIndex, /* 46 */
    TclListObjLength, /* 47 */
    0, /* 47 */
    Tcl_ListObjReplace, /* 48 */
    0, /* 49 */
    Tcl_NewByteArrayObj, /* 50 */
    Tcl_NewDoubleObj, /* 51 */
    0, /* 52 */
    Tcl_NewListObj, /* 53 */
    0, /* 54 */
1506
1507
1508
1509
1510
1511
1512































1513
1514
1515
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



    Tcl_GetWideUIntFromObj, /* 684 */
    Tcl_DStringToObj, /* 685 */
    Tcl_UtfNcmp, /* 686 */
    Tcl_UtfNcasecmp, /* 687 */
    Tcl_NewWideUIntObj, /* 688 */
    Tcl_SetWideUIntObj, /* 689 */
    TclUnusedStubEntry, /* 690 */
    Tcl_NewObjInterface, /* 691 */
    Tcl_NewObjType, /* 692 */
    Tcl_ObjInterfaceSetVersion, /* 693 */
    Tcl_ObjTypeSetFreeInternalRepProc, /* 694 */
    Tcl_ObjTypeSetDupInternalRepProc, /* 695 */
    Tcl_ObjTypeSetUpdateStringProc, /* 696 */
    Tcl_ObjTypeSetSetFromAnyProc, /* 697 */
    Tcl_ObjTypeSetVersion, /* 698 */
    Tcl_ObjInterfaceSetFnListAll, /* 699 */
    Tcl_ObjInterfaceSetFnListAppend, /* 700 */
    Tcl_ObjInterfaceSetFnListAppendList, /* 701 */
    Tcl_ObjInterfaceSetFnListIndex, /* 702 */
    Tcl_ObjInterfaceSetFnListIndexEnd, /* 703 */
    Tcl_ObjInterfaceSetFnListIsSorted, /* 704 */
    Tcl_ObjInterfaceSetFnListLength, /* 705 */
    Tcl_ObjInterfaceSetFnListRange, /* 706 */
    Tcl_ObjInterfaceSetFnListRangeEnd, /* 707 */
    Tcl_ObjInterfaceSetFnListReplace, /* 708 */
    Tcl_ObjInterfaceSetFnListReplaceList, /* 709 */
    Tcl_ObjInterfaceSetFnListReverse, /* 710 */
    Tcl_ObjInterfaceSetFnListSet, /* 711 */
    Tcl_ObjInterfaceSetFnListSetDeep, /* 712 */
    Tcl_ObjInterfaceSetFnStringIndex, /* 713 */
    Tcl_ObjInterfaceSetFnStringIndexEnd, /* 714 */
    Tcl_ObjInterfaceSetFnStringLength, /* 715 */
    Tcl_ObjInterfaceSetFnStringRange, /* 716 */
    Tcl_ObjInterfaceSetFnStringRangeEnd, /* 717 */
    Tcl_ObjTypeSetInterface, /* 718 */
    Tcl_ObjTypeSetName, /* 719 */
    Tcl_ObjInterfaceSetFnStringIsEmpty, /* 720 */
    Tcl_ObjInterfaceSetFnListContains, /* 721 */
};

/* !END!: Do not edit above this line. */
Changes to generic/tclStubLib.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
















14
15
16
17
18
19
20
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

-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclStubLib.c --
 *
 *	Stub object that will be statically linked into extensions that want
 *	to access Tcl.
 *
 * Copyright © 1998-1999 Scriptics Corporation.
 * Copyright © 1998 Paul Duffin.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclStubLib.c --
 *
 *	Stub object that will be statically linked into extensions that want
 *	to access Tcl.
 */

#include "tclInt.h"

MODULE_SCOPE const TclStubs *tclStubsPtr;
MODULE_SCOPE const TclPlatStubs *tclPlatStubsPtr;
MODULE_SCOPE const TclIntStubs *tclIntStubsPtr;
MODULE_SCOPE const TclIntPlatStubs *tclIntPlatStubsPtr;
MODULE_SCOPE void *tclStubsHandle;
88
89
90
91
92
93
94
95


96
97
98
99
100
101
102
99
100
101
102
103
104
105

106
107
108
109
110
111
112
113
114







-
+
+







	    count += !ISDIGIT(*p++);
	}
	if (count == 1) {
	    const char *q = actualVersion;

	    p = version;
	    while (*p && (*p == *q)) {
		p++; q++;
		p++;
		q++;
	    }
	    if (*p || ISDIGIT(*q)) {
		/* Construct error message */
		stubsPtr->tcl_PkgRequireEx(interp, tclName, version, 1, NULL);
		return NULL;
	    }
	} else {
Changes to generic/tclStubLibTbl.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
















14
15
16
17
18
19
20
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

-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclStubLibTbl.c --
 *
 *	Stub object that will be statically linked into extensions that want
 *	to access Tcl.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 1998 Paul Duffin.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclStubLibTbl.c --
 *
 *	Stub object that will be statically linked into extensions that want
 *	to access Tcl.
 */

#include "tclInt.h"

MODULE_SCOPE void *tclStubsHandle;

/*
 *----------------------------------------------------------------------
 *
Changes to generic/tclTest.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
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

-
-
-
-
-
-
-









+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
+


-

+
+







/*
 * tclTest.c --
 *
 *	This file contains C command functions for a bunch of additional Tcl
 *	commands that are used for testing out Tcl's C interfaces. These
 *	commands are not normally included in Tcl applications; they're only
 *	used for testing.
 *
 * Copyright © 1993-1994 The Regents of the University of California.
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 * Copyright © 1998-2000 Ajuba Solutions.
 * Copyright © 2003 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.
#define TCL_8_API
#undef BUILD_tcl

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclTest.c --
 *
 *	This file contains C command functions for a bunch of additional Tcl
 *	commands that are used for testing out Tcl's C interfaces. These
 *	commands are not normally included in Tcl applications; they're only
 *	used for testing.
 */

#undef STATIC_BUILD
#	undef BUILD_tcl
#ifndef USE_TCL_STUBS
#	ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#define TCLBOOLWARNING(boolPtr) /* needed here because we compile with -Wc++-compat */
#include "tclInt.h"
#undef TCLBOOLWARNING
#define TCLBOOLWARNING(boolPtr) /* needed here because we compile with -Wc++-compat */
#include "tclOO.h"
#include <math.h>

/*
 * Required for Testregexp*Cmd
 */
#include "tclRegexp.h"
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
517
518
519
520
521
522
523



524
525
526
527
528
529
530







-
-
-







#endif
#ifdef PURIFY
	    ".purify"
#endif
#ifdef STATIC_BUILD
	    ".static"
#endif
#if TCL_UTF_MAX < 4
	    ".utf-16"
#endif
;

int
Tcltest_Init(
    Tcl_Interp *interp)		/* Interpreter for application. */
{
    Tcl_CmdInfo info;
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
540
541
542
543
544
545
546

547
548
549
550

551
552
553
554
555
556
557







-




-







	return TCL_ERROR;
    }
    if (Tcl_OOInitStubs(interp) == NULL) {
	return TCL_ERROR;
    }

    if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
#if TCL_MAJOR_VERSION > 8
	if (info.isNativeObjectProc == 2) {
	    Tcl_CreateObjCommand2(interp, "::tcl::test::build-info",
		    info.objProc2, (void *)version, NULL);
    } else
#endif
	Tcl_CreateObjCommand(interp, "::tcl::test::build-info",
		info.objProc, (void *)version, NULL);
    }
    if (Tcl_PkgProvideEx(interp, "tcl::test", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
	return TCL_ERROR;
    }

716
717
718
719
720
721
722






723
724
725
726
727
728
729
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741







+
+
+
+
+
+







    Tcl_CreateObjCommand(interp, "testapplylambda", TestApplyLambdaObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testlutil", TestLutilCmd,
	    NULL, NULL);

    if (TclObjTest_Init(interp) != TCL_OK) {
	return TCL_ERROR;
    }
    if (TcltestObjectInterfaceInit(interp) != TCL_OK) {
	return TCL_ERROR;
    }
    if (TcltestObjectInterfaceListIntegerInit(interp) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Procbodytest_Init(interp) != TCL_OK) {
	return TCL_ERROR;
    }
#if TCL_THREADS
    if (TclThread_Init(interp) != TCL_OK) {
	return TCL_ERROR;
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
811
812
813
814
815
816
817

818
819
820
821

822
823
824
825
826
827
828







-




-







{
    Tcl_CmdInfo info;

    if (Tcl_InitStubs(interp, "8.7-", 0) == NULL) {
	return TCL_ERROR;
    }
    if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
#if TCL_MAJOR_VERSION > 8
	if (info.isNativeObjectProc == 2) {
	    Tcl_CreateObjCommand2(interp, "::tcl::test::build-info",
		    info.objProc2, (void *)version, NULL);
    } else
#endif
	Tcl_CreateObjCommand(interp, "::tcl::test::build-info",
		info.objProc, (void *)version, NULL);
    }
    if (Tcl_PkgProvideEx(interp, "tcl::test", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
	return TCL_ERROR;
    }
    return Procbodytest_SafeInit(interp);
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2057
2058
2059
2060
2061
2062
2063

2064



2065
2066
2067
2068
2069
2070
2071







-

-
-
-








/*
 * The procedure below is used as a special freeProc to test how well
 * Tcl_DStringGetResult handles freeProc's other than free.
 */

static void SpecialFree(
#if TCL_MAJOR_VERSION > 8
    void *blockPtr			/* Block to free. */
#else
    char *blockPtr			/* Block to free. */
#endif
) {
    Tcl_Free(((char *)blockPtr) - 16);
}

/*
 *------------------------------------------------------------------------
 *
3807
3808
3809
3810
3811
3812
3813
3814

3815
3816
3817
3818
3819
3820
3821
3813
3814
3815
3816
3817
3818
3819

3820
3821
3822
3823
3824
3825
3826
3827







-
+







TestlistrepCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,         /* Current interpreter. */
    int objc,                   /* Number of arguments. */
    Tcl_Obj *const objv[])      /* Argument objects. */
{
    /* Subcommands supported by this command */
    static const char *const subcommands[] = {
    const char* subcommands[] = {
	"new",
	"describe",
	"config",
	"validate",
	NULL
    };
    enum {
5741
5742
5743
5744
5745
5746
5747
5748
5749
5750
5751
5752
5753
5754
5755
5756
5757
5758
5759
5760
5761


5762
5763
5764
5765



5766
5767
5768
5769
5770
5771
5772
5747
5748
5749
5750
5751
5752
5753



5754

5755
5756
5757
5758
5759
5760
5761
5762
5763
5764
5765
5766
5767
5768
5769
5770
5771
5772
5773
5774
5775
5776
5777
5778
5779







-
-
-

-









+
+




+
+
+







TestbytestringObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    struct {
#if !defined(TCL_NO_DEPRECATED)
	int n; /* On purpose, not Tcl_Size, in order to demonstrate what happens */
#else
	Tcl_Size n;
#endif
	int m; /* This variable should not be overwritten */
    } x = {0, 1};
    const char *p;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "bytearray");
	return TCL_ERROR;
    }

    /* Next line produces a "warning: passing argument 3 of ... from incompatible pointer type",
     * but that's on purpose: It's exactly what we are testing here */
    p = (const char *)Tcl_GetBytesFromObj(interp, objv[1], &x.n);
    if (p == NULL) {
	return TCL_ERROR;
    }
#if !defined(TCL_NO_DEPRECATED) && defined(__clang__)
#   pragma clang diagnostic pop
#endif

    if (x.m != 1) {
	Tcl_AppendResult(interp, "Tcl_GetBytesFromObj() overwrites variable", (char *)NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(p, x.n));
    return TCL_OK;
Changes to generic/tclTestABSList.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
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
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+

















-
+
-
-
-
-
-
-
-
+
+
+
-
-
-
-
+
-
-
-
+
-
-
+
-
-
-
-
-
-
+
-
-
-

-
+












+




+
+
-
+






-
+
-
-
-
-
-
-
-
-
-
+
+






-
-
+
+
-
-
-
-
-
-
-







-
+
-
-
+
-
-
-
-
-
-







-
+
-
-
-
+
-
-
-
-
-







-
+
-
-
-
-
+
-
-
-
-







-
+
-
-
-
-
-
+
-
-
-







-
+
-
-
-
-
-
-
+
-
-







-
+
-
-
-
-
-
-
-
+
-







-
+
-
-
-
-
-
-
-
-
+







-
+
-
-
-
-
-
-
-
-
+







-
+
-
-
-
-
-
-
-
-
+







/*
 * Copyright © 2021, 2024 Nathan Coulter.  All rights reserved.
 *
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.
// Tcl Abstract List test command: "lstring"

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 *	Functions to test abstract lists.
 *
 * tclTestABSList.c --
 */

#undef BUILD_tcl
#undef STATIC_BUILD
#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include <string.h>
#include <limits.h>
#include "tclInt.h"

/*
 * Forward references
 */

Tcl_Obj *myNewLStringObj(Tcl_WideInt start,
			 Tcl_WideInt length);
static void freeRep(Tcl_Obj* alObj);
static Tcl_Obj* my_LStringObjSetElem(Tcl_Interp *interp,
static Tcl_ObjInterfaceListSetDeepProc my_LStringObjSetElemR;
				     Tcl_Obj *listPtr,
				     Tcl_Size numIndcies,
				     Tcl_Obj *const indicies[],
				     Tcl_Obj *valueObj);
static void DupLStringRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static Tcl_Size my_LStringObjLength(Tcl_Obj *lstringObjPtr);
static int my_LStringObjIndex(Tcl_Interp *interp,
static Tcl_DupInternalRepProc DupLStringRep;
static Tcl_ObjInterfaceListLengthProc my_LStringObjLength;
static Tcl_ObjInterfaceListIndexProc my_LStringObjIndex;
			      Tcl_Obj *lstringObj,
			      Tcl_Size index,
			      Tcl_Obj **charObjPtr);
static int my_LStringObjRange(Tcl_Interp *interp, Tcl_Obj *lstringObj,
static Tcl_ObjInterfaceListRangeProc my_LStringObjRange;
			      Tcl_Size fromIdx, Tcl_Size toIdx,
			      Tcl_Obj **newObjPtr);
static int my_LStringObjReverse(Tcl_Interp *interp, Tcl_Obj *srcObj,
static Tcl_ObjInterfaceListReverseProc my_LStringObjReverse;
			  Tcl_Obj **newObjPtr);
static int my_LStringReplace(Tcl_Interp *interp,
static Tcl_ObjInterfaceListReplaceProc my_LStringReplace;
		      Tcl_Obj *listObj,
		      Tcl_Size first,
		      Tcl_Size numToDelete,
		      Tcl_Size numToInsert,
		      Tcl_Obj *const insertObjs[]);
static int my_LStringGetElements(Tcl_Interp *interp,
static Tcl_ObjInterfaceListAllProc my_LStringGetElements;
				 Tcl_Obj *listPtr,
				 Tcl_Size *objcptr,
				 Tcl_Obj ***objvptr);
static void lstringFreeElements(Tcl_Obj* lstringObj);
static void UpdateStringOfLString(Tcl_Obj *objPtr);
static Tcl_UpdateStringProc UpdateStringOfLString;

/*
 * Internal Representation of an lstring type value
 */

typedef struct LString {
    char *string;	// NULL terminated utf-8 string
    Tcl_Size strlen;	// num bytes in string
    Tcl_Size allocated; // num bytes allocated
    Tcl_Obj**elements;	// elements array, allocated when GetElements is
			// called
} LString;


/*
 * AbstractList definition of an lstring type
 */


static const Tcl_ObjType lstringTypes[11] = {
static ObjectType lstringTypes[11] = {
    {/*0*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	2,
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace,     /* Replace */
	    NULL)                  /* "in" operator */
	},
	NULL
    },
    {/*1*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    NULL,   /* Length */
	2,
	NULL
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace,     /* Replace */
	    NULL)                  /* "in" operator */
    },
    {/*2*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	2,
	    my_LStringObjLength,   /* Length */
	    NULL,                  /* Index */
	NULL
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace,     /* Replace */
	    NULL)                  /* "in" operator */
    },
    {/*3*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	2,
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    NULL,                  /* Slice */
	NULL
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace,     /* Replace */
	    NULL)                  /* "in" operator */
    },
    {/*4*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	2,
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    NULL,                  /* Reverse */
	NULL
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace,     /* Replace */
	    NULL)                  /* "in" operator */
    },
    {/*5*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	2,
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    NULL,                  /* GetElements */
	NULL
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace,     /* Replace */
	    NULL)                  /* "in" operator */
    },
    {/*6*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	2,
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    NULL,                  /* SetElement */
	NULL
	    my_LStringReplace,     /* Replace */
	    NULL)                  /* "in" operator */
    },
    {/*7*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	2,
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    NULL,                  /* Replace */
	NULL
	    NULL)                  /* "in" operator */
    },
    {/*8*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	2,
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace,     /* Replace */
	    NULL)                  /* "in" operator */
	NULL
    },
    {/*9*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	2,
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace,     /* Replace */
	    NULL)                  /* "in" operator */
	NULL
    },
    {/*10*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	2,
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace,     /* Replace */
	    NULL)                  /* "in" operator */
	NULL
    }
};


/*
 *----------------------------------------------------------------------
 *
296
297
298
299
300
301
302
303
304


305
306
307


308
309
310
311
312
313
314
219
220
221
222
223
224
225


226
227
228
229

230
231
232
233
234
235
236
237
238







-
-
+
+


-
+
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Size
my_LStringObjLength(Tcl_Obj *lstringObjPtr)
static int
my_LStringObjLength(TCL_UNUSED(Tcl_Interp *), Tcl_Obj *lstringObjPtr, Tcl_Size *lenPtr )
{
    LString *lstringRepPtr = (LString *)lstringObjPtr->internalRep.twoPtrValue.ptr1;
    return lstringRepPtr->strlen;
    *lenPtr = lstringRepPtr->strlen;
    return TCL_OK; 
}


/*
 *----------------------------------------------------------------------
 *
 * DupLStringRep --
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
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







-
+
















-
-
+
+



-
-
+
+
+




-
+



-
-
+
+
+


-
+

+
-
+


-
-
+
+



















-
+

+
-
+


















-
+




-
+

-
+








+





-
+


















-
+

+








  return;
}

/*
 *----------------------------------------------------------------------
 *
 * my_LStringObjSetElem --
 * my_LStringObjSetElemR --
 *
 *	Replace the element value at the given (nested) index with the
 *	valueObj provided.  If the lstring obj is shared, a new list is
 *	created conntaining the modifed element.
 *
 * Results:
 *	The modifed lstring is returned, either new or original. If the
 *	index is invalid, NULL is returned, and an error is added to the
 *	interp, if provided.
 *
 * Side effects:
 *	A new obj may be created.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj*
my_LStringObjSetElem(
static int
my_LStringObjSetElemR(
    Tcl_Interp *interp,
    Tcl_Obj *lstringObj,
    Tcl_Size numIndicies,
    Tcl_Obj *const indicies[],
    Tcl_Obj *valueObj)
    Tcl_Obj *const indices[],
    Tcl_Obj *valueObj,
    Tcl_Obj **resPtrPtr)
{
    LString *lstringRepPtr = (LString*)lstringObj->internalRep.twoPtrValue.ptr1;
    Tcl_Size index;
    int status;
    Tcl_Obj *returnObj;
    Tcl_Obj *resPtr;

    if (numIndicies > 1) {
	Tcl_SetObjResult(interp,
	    Tcl_ObjPrintf("Multiple indicies not supported by lstring."));
	return NULL;
	    Tcl_ObjPrintf("Multiple indices not supported by lstring."));
	*resPtrPtr = NULL;
	return TCL_ERROR;
    }

    status = Tcl_GetIntForIndex(interp, indicies[0], lstringRepPtr->strlen, &index);
    status = Tcl_GetIntForIndex(interp, indices[0], lstringRepPtr->strlen, &index);
    if (status != TCL_OK) {
	resPtrPtr = NULL;
	return NULL;
	return TCL_ERROR;
    }

    returnObj = Tcl_IsShared(lstringObj) ? Tcl_DuplicateObj(lstringObj) : lstringObj;
    lstringRepPtr = (LString*)returnObj->internalRep.twoPtrValue.ptr1;
    resPtr = Tcl_IsShared(lstringObj) ? Tcl_DuplicateObj(lstringObj) : lstringObj;
    lstringRepPtr = (LString*)resPtr->internalRep.twoPtrValue.ptr1;

    if (index >= lstringRepPtr->strlen) {
	index = lstringRepPtr->strlen;
	lstringRepPtr->strlen++;
	lstringRepPtr->string = (char*)Tcl_Realloc(lstringRepPtr->string, lstringRepPtr->strlen+1);
    }

    if (valueObj) {
	const char newvalue = Tcl_GetString(valueObj)[0];
	lstringRepPtr->string[index] = newvalue;
    } else if (index < lstringRepPtr->strlen) {
	/* Remove the char by sliding the tail of the string down */
	char *sptr = &lstringRepPtr->string[index];
	/* This is an overlapping copy, by definition */
	lstringRepPtr->strlen--;
	memmove(sptr, (sptr+1), (lstringRepPtr->strlen - index));
    }
    // else do nothing

    Tcl_InvalidateStringRep(returnObj);
    Tcl_InvalidateStringRep(resPtr);

    *resPtrPtr = resPtr;
    return returnObj;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * my_LStringObjRange --
 *
 *	Creates a new Obj with a slice of the src listPtr.
 *
 * Results:
 *	A new Obj is assigned to newObjPtr. Returns TCL_OK
 *
 * Side effects:
 *	A new Obj is created.
 *
 *----------------------------------------------------------------------
 */

static int my_LStringObjRange(
int my_LStringObjRange(
    Tcl_Interp *interp,
    Tcl_Obj *lstringObj,
    Tcl_Size fromIdx,
    Tcl_Size toIdx,
    Tcl_Obj **newObjPtr)
    Tcl_Obj **resPtrPtr)
{
    Tcl_Obj *rangeObj;
    Tcl_Obj *rangeObj, *newObjPtr;
    LString *lstringRepPtr = (LString*)lstringObj->internalRep.twoPtrValue.ptr1;
    LString *rangeRep;
    Tcl_WideInt len = toIdx - fromIdx + 1;

    if (lstringRepPtr->strlen < fromIdx ||
	lstringRepPtr->strlen < toIdx) {
	Tcl_SetObjResult(interp,
	    Tcl_ObjPrintf("Range out of bounds "));
	*resPtrPtr = NULL;
	return TCL_ERROR;
    }

    if (len <= 0) {
	// Return empty value;
	*newObjPtr = Tcl_NewObj();
	newObjPtr = Tcl_NewObj();
    } else {
	rangeRep = (LString*)Tcl_Alloc(sizeof(LString));
	rangeRep->allocated = len+1;
	rangeRep->strlen = len;
	rangeRep->string = (char*)Tcl_Alloc(rangeRep->allocated);
	strncpy(rangeRep->string,&lstringRepPtr->string[fromIdx],len);
	rangeRep->string[len] = 0;
	rangeRep->elements = NULL;
	rangeObj = Tcl_NewObj();
	Tcl_ObjInternalRep itr;
	itr.twoPtrValue.ptr1 = rangeRep;
	itr.twoPtrValue.ptr2 = NULL;
	Tcl_StoreInternalRep(rangeObj, lstringObj->typePtr, &itr);
	if (rangeRep->strlen > 0) {
	    Tcl_InvalidateStringRep(rangeObj);
	} else {
	    Tcl_InitStringRep(rangeObj, NULL, 0);
	}
	*newObjPtr = rangeObj;
	newObjPtr = rangeObj;
    }
    *resPtrPtr = newObjPtr;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * my_LStringObjReverse --
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
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







-
+


-
-
-

-
-
+
+
+
+
+
+
+

-
-
-
-


-
-
+

+
-
+
-
-
+
-
-
-
-
-
-
-

-







 * Side effects:
 *	A new Obj is created.
 *
 *----------------------------------------------------------------------
 */

static int
my_LStringObjReverse(Tcl_Interp *interp, Tcl_Obj *srcObj, Tcl_Obj **newObjPtr)
my_LStringObjReverse(Tcl_Interp *interp, Tcl_Obj *srcObj)
{
    LString *srcRep = (LString*)srcObj->internalRep.twoPtrValue.ptr1;
    Tcl_Obj *revObj;
    LString *revRep = (LString*)Tcl_Alloc(sizeof(LString));
    Tcl_ObjInternalRep itr;
    Tcl_Size len;
    char *srcp, *dstp, *endp;
    (void)interp;
    char *srcp, *endp;
    char temp;
    (void)interp;  
    if (Tcl_IsShared(srcObj)) {
	Tcl_Panic("%s called with shared object", "my_LStringObjReverse");
    }

    len = srcRep->strlen;
    revRep->strlen = len;
    revRep->allocated = len+1;
    revRep->string = (char*)Tcl_Alloc(revRep->allocated);
    revRep->elements = NULL;
    srcp = srcRep->string;
    endp = &srcRep->string[len];
    dstp = &revRep->string[len];
    *dstp-- = 0;
    endp--;
    while (srcp < endp) {
	temp = *endp;
	*dstp-- = *srcp++;
	*endp-- = *srcp;
    }
    revObj = Tcl_NewObj();
	*srcp++ = temp;
    itr.twoPtrValue.ptr1 = revRep;
    itr.twoPtrValue.ptr2 = NULL;
    Tcl_StoreInternalRep(revObj, srcObj->typePtr, &itr);
    if (revRep->strlen > 0) {
	Tcl_InvalidateStringRep(revObj);
    } else {
	Tcl_InitStringRep(revObj, NULL, 0);
    }
    *newObjPtr = revObj;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * my_LStringReplace --
636
637
638
639
640
641
642
643

644
645
646
647
648

649
650
651
652
653
654
655
555
556
557
558
559
560
561

562
563
564
565
566

567
568
569
570
571
572
573
574







-
+




-
+








    return TCL_OK;
}

static const Tcl_ObjType *
my_SetAbstractProc(int ptype)
{
    const Tcl_ObjType *typePtr = &lstringTypes[0]; /* default value */
    const ObjectType *typePtr = &lstringTypes[0]; /* default value */
    if (4 <= ptype && ptype <= 11) {
	/* Table has no entries for the slots upto setfromany */
	typePtr = &lstringTypes[(ptype-3)];
    }
    return typePtr;
    return (Tcl_ObjType *)typePtr;
}


/*
 *----------------------------------------------------------------------
 *
 * my_NewLStringObj --
679
680
681
682
683
684
685
686

687
688
689
690
691
692
693
598
599
600
601
602
603
604

605
606
607
608
609
610
611
612







-
+







    static const char* procTypeNames[] = {
	"FREEREP", "DUPREP", "UPDATESTRING", "SETFROMANY",
	"LENGTH", "INDEX", "SLICE", "REVERSE", "GETELEMENTS",
	"SETELEMENT", "REPLACE", NULL
    };
    int i = 0;
    int ptype;
    const Tcl_ObjType *lstringTypePtr = &lstringTypes[10];
    const Tcl_ObjType *lstringTypePtr = (Tcl_ObjType *)&lstringTypes[10];

    repSize = sizeof(LString);
    lstringRepPtr = (LString*)Tcl_Alloc(repSize);

    while (i<objc) {
	const char *s = Tcl_GetString(objv[i]);
	if (strcmp(s, "-not")==0) {
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
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







-


-
+
+





-
-
+
+


















+
-
+
+







*/

static void
UpdateStringOfLString(Tcl_Obj *objPtr)
{
#   define LOCAL_SIZE 64
    int localFlags[LOCAL_SIZE], *flagPtr = NULL;
    Tcl_ObjType const *typePtr = objPtr->typePtr;
    char *p;
    int bytesNeeded = 0;
    int llen, i;
    int status;
    Tcl_Size i ,llen;


    /*
     * Handle empty list case first, so rest of the routine is simpler.
     */
    llen = typePtr->lengthProc(objPtr);
    if (llen <= 0) {
    status = my_LStringObjLength(NULL, objPtr, &llen);
    if ((status != TCL_OK) || llen <= 0) {
	Tcl_InitStringRep(objPtr, NULL, 0);
	return;
    }

    /*
     * Pass 1: estimate space.
     */
    if (llen <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	/* We know numElems <= LIST_MAX, so this is safe. */
	flagPtr = (int *) Tcl_Alloc(llen*sizeof(int));
    }
    for (bytesNeeded = 0, i = 0; i < llen; i++) {
	Tcl_Obj *elemObj;
	const char *elemStr;
	Tcl_Size elemLen;
	flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);

	typePtr->indexProc(NULL, objPtr, i, &elemObj);
	my_LStringObjIndex(NULL, objPtr, i, &elemObj);

	Tcl_IncrRefCount(elemObj);
	elemStr = Tcl_GetStringFromObj(elemObj, &elemLen);
	/* Note TclScanElement updates flagPtr[i] */
	bytesNeeded += Tcl_ScanCountedElement(elemStr, elemLen, &flagPtr[i]);
	if (bytesNeeded < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}
881
882
883
884
885
886
887
888

889
890
891
892
893
894
895
802
803
804
805
806
807
808

809
810
811
812
813
814
815
816







-
+







    objPtr->bytes = (char *) Tcl_Alloc(bytesNeeded);
    p = objPtr->bytes;
    for (i = 0; i < llen; i++) {
	Tcl_Obj *elemObj;
	const char *elemStr;
	Tcl_Size elemLen;
	flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
	typePtr->indexProc(NULL, objPtr, i, &elemObj);
	my_LStringObjIndex(NULL, objPtr, i, &elemObj);
	Tcl_IncrRefCount(elemObj);
	elemStr = Tcl_GetStringFromObj(elemObj, &elemLen);
	p += Tcl_ConvertCountedElement(elemStr, elemLen, p, flagPtr[i]);
	*p++ = ' ';
	Tcl_DecrRefCount(elemObj);
    }
    p[-1] = '\0'; /* Overwrite last space added */
991
992
993
994
995
996
997
998
999


1000
1001
1002


1003
1004
1005
1006
1007
1008
1009
912
913
914
915
916
917
918


919
920
921
922

923
924
925
926
927
928
929
930
931







-
-
+
+


-
+
+







    }
    return elemObj;
}

/*
 *  Abstract List Length function
 */
static Tcl_Size
lgenSeriesObjLength(Tcl_Obj *objPtr)
static int
lgenSeriesObjLength(TCL_UNUSED(Tcl_Interp *), Tcl_Obj *objPtr, Tcl_Size *lenPtr)
{
    LgenSeries *lgenSeriesRepPtr = (LgenSeries *)objPtr->internalRep.twoPtrValue.ptr1;
    return lgenSeriesRepPtr->len;
    *lenPtr = lgenSeriesRepPtr->len;
    return TCL_OK;
}

/*
 *  Abstract List Index function
 */
static int
lgenSeriesObjIndex(
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
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







-
+
+





-
-
-
-
+
+
-
-
-
-
-


+
+
+

















-
+








static void DupLgenSeriesRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);

/*
 *  Abstract List ObjType definition
 */

static const Tcl_ObjType lgenType = {

static ObjectType lgenObjectType = {
    "lgenseries",
    FreeLgenInternalRep,
    DupLgenSeriesRep,
    UpdateStringOfLgen,
    NULL, /* SetFromAnyProc */
    TCL_OBJTYPE_V2(
	lgenSeriesObjLength,
	lgenSeriesObjIndex,
	NULL, /* slice */
    0,
    NULL
	NULL, /* reverse */
	NULL, /* get elements */
	NULL, /* set element */
	NULL, /* replace */
	NULL) /* "in" operator */
};


static Tcl_ObjType *lgenTypePtr = (Tcl_ObjType *)&lgenObjectType;

/*
 *  ObjType Duplicate Internal Rep Function
 */
static void
DupLgenSeriesRep(
    Tcl_Obj *srcPtr,
    Tcl_Obj *copyPtr)
{
    LgenSeries *srcLgenSeries = (LgenSeries*)srcPtr->internalRep.twoPtrValue.ptr1;
    Tcl_Size repSize = sizeof(LgenSeries);
    LgenSeries *copyLgenSeries = (LgenSeries*)Tcl_Alloc(repSize);

    copyLgenSeries->interp = srcLgenSeries->interp;
    copyLgenSeries->nargs = srcLgenSeries->nargs;
    copyLgenSeries->len = srcLgenSeries->len;
    copyLgenSeries->genFnObj = Tcl_DuplicateObj(srcLgenSeries->genFnObj);
    Tcl_IncrRefCount(copyLgenSeries->genFnObj);
    copyPtr->typePtr = &lgenType;
    copyPtr->typePtr = lgenTypePtr;
    copyPtr->internalRep.twoPtrValue.ptr1 = copyLgenSeries;
    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
    return;
}

/*
 *  Create a new lgen Tcl_Obj
1166
1167
1168
1169
1170
1171
1172
1173

1174
1175
1176
1177
1178
1179
1180
1085
1086
1087
1088
1089
1090
1091

1092
1093
1094
1095
1096
1097
1098
1099







-
+







    lGenSeriesRepPtr->nargs = objc;
    lGenSeriesRepPtr->genFnObj = Tcl_NewListObj(objc-1, objv+1);
    // Addd 0 placeholder for index
    Tcl_ListObjAppendElement(interp, lGenSeriesRepPtr->genFnObj, Tcl_NewIntObj(0));
    Tcl_IncrRefCount(lGenSeriesRepPtr->genFnObj);
    lGenSeriesObj->internalRep.twoPtrValue.ptr1 = lGenSeriesRepPtr;
    lGenSeriesObj->internalRep.twoPtrValue.ptr2 = NULL;
    lGenSeriesObj->typePtr = &lgenType;
    lGenSeriesObj->typePtr = lgenTypePtr;

    if (length > 0) {
	Tcl_InvalidateStringRep(lGenSeriesObj);
    } else {
	Tcl_InitStringRep(lGenSeriesObj, NULL, 0);
    }
    return lGenSeriesObj;
1245
1246
1247
1248
1249
1250
1251



















































































1252
1253
1254

1255
1256
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



+


 *----------------------------------------------------------------------
 */

int Tcl_ABSListTest_Init(Tcl_Interp *interp) {
    if (Tcl_InitStubs(interp, "8.7-", 0) == NULL) {
	return TCL_ERROR;
    }
    Tcl_ObjInterface *lgenIfPtr ,*lstringfullPtr ,*lstringNoLengthPtr ,*lstringNoIndexPtr
	,*lstringNoRangePtr ,*lstringNoGetElementsPtr
	,*lstringNoSetElementRPtr ,*lstringNoReplacePtr
	;
    
    lstringfullPtr = Tcl_NewObjInterface();
    Tcl_ObjInterfaceSetVersion(lstringfullPtr ,1);
    Tcl_ObjInterfaceSetFnListAll(lstringfullPtr , my_LStringGetElements);
    Tcl_ObjInterfaceSetFnListIndex(lstringfullPtr ,my_LStringObjIndex);
    Tcl_ObjInterfaceSetFnListLength(lstringfullPtr ,my_LStringObjLength);
    Tcl_ObjInterfaceSetFnListRange(lstringfullPtr ,my_LStringObjRange);
    Tcl_ObjInterfaceSetFnListReplace(lstringfullPtr ,my_LStringReplace);
    Tcl_ObjInterfaceSetFnListReverse(lstringfullPtr ,my_LStringObjReverse);
    Tcl_ObjInterfaceSetFnListSetDeep(lstringfullPtr ,my_LStringObjSetElemR);
    Tcl_ObjTypeSetInterface((Tcl_ObjType *)&lstringTypes[0], lstringfullPtr);
    Tcl_ObjTypeSetInterface((Tcl_ObjType *)&lstringTypes[4], lstringfullPtr);
    Tcl_ObjTypeSetInterface((Tcl_ObjType *)&lstringTypes[8], lstringfullPtr);
    Tcl_ObjTypeSetInterface((Tcl_ObjType *)&lstringTypes[9], lstringfullPtr);
    Tcl_ObjTypeSetInterface((Tcl_ObjType *)&lstringTypes[10], lstringfullPtr);

    lstringNoLengthPtr = Tcl_NewObjInterface();
    Tcl_ObjInterfaceSetFnListAll(lstringNoLengthPtr , my_LStringGetElements);
    Tcl_ObjInterfaceSetFnListIndex(lstringNoLengthPtr ,my_LStringObjIndex);
    Tcl_ObjInterfaceSetFnListRange(lstringNoLengthPtr ,my_LStringObjRange);
    Tcl_ObjInterfaceSetFnListReplace(lstringNoLengthPtr ,my_LStringReplace);
    Tcl_ObjInterfaceSetFnListReverse(lstringNoLengthPtr ,my_LStringObjReverse);
    Tcl_ObjInterfaceSetFnListSetDeep(lstringNoLengthPtr ,my_LStringObjSetElemR);
    Tcl_ObjTypeSetInterface((Tcl_ObjType *)&lstringTypes[1], lstringNoLengthPtr);

    lstringNoIndexPtr = Tcl_NewObjInterface();
    Tcl_ObjInterfaceSetFnListAll(lstringNoIndexPtr , my_LStringGetElements);
    Tcl_ObjInterfaceSetFnListLength(lstringNoIndexPtr ,my_LStringObjLength);
    Tcl_ObjInterfaceSetFnListRange(lstringNoIndexPtr ,my_LStringObjRange);
    Tcl_ObjInterfaceSetFnListReplace(lstringNoIndexPtr ,my_LStringReplace);
    Tcl_ObjInterfaceSetFnListReverse(lstringNoIndexPtr ,my_LStringObjReverse);
    Tcl_ObjInterfaceSetFnListSetDeep(lstringNoIndexPtr ,my_LStringObjSetElemR);
    Tcl_ObjTypeSetInterface((Tcl_ObjType *)&lstringTypes[2], lstringNoIndexPtr);

    lstringNoRangePtr = Tcl_NewObjInterface();
    Tcl_ObjInterfaceSetFnListAll(lstringNoRangePtr , my_LStringGetElements);
    Tcl_ObjInterfaceSetFnListIndex(lstringNoRangePtr ,my_LStringObjIndex);
    Tcl_ObjInterfaceSetFnListLength(lstringNoRangePtr ,my_LStringObjLength);
    Tcl_ObjInterfaceSetFnListReplace(lstringNoRangePtr ,my_LStringReplace);
    Tcl_ObjInterfaceSetFnListReverse(lstringNoRangePtr ,my_LStringObjReverse);
    Tcl_ObjInterfaceSetFnListSetDeep(lstringNoRangePtr ,my_LStringObjSetElemR);
    Tcl_ObjTypeSetInterface((Tcl_ObjType *)&lstringTypes[3], lstringNoRangePtr);

    lstringNoGetElementsPtr = Tcl_NewObjInterface();
    Tcl_ObjInterfaceSetVersion(lstringNoGetElementsPtr ,1);
    Tcl_ObjInterfaceSetFnListIndex(lstringNoGetElementsPtr ,my_LStringObjIndex);
    Tcl_ObjInterfaceSetFnListLength(lstringNoGetElementsPtr ,my_LStringObjLength);
    Tcl_ObjInterfaceSetFnListRange(lstringNoGetElementsPtr ,my_LStringObjRange);
    Tcl_ObjInterfaceSetFnListReplace(lstringNoGetElementsPtr ,my_LStringReplace);
    Tcl_ObjInterfaceSetFnListReverse(lstringNoGetElementsPtr ,my_LStringObjReverse);
    Tcl_ObjInterfaceSetFnListSetDeep(lstringNoGetElementsPtr ,my_LStringObjSetElemR);
    Tcl_ObjTypeSetInterface((Tcl_ObjType *)&lstringTypes[5], lstringNoGetElementsPtr);

    lstringNoSetElementRPtr = Tcl_NewObjInterface();
    Tcl_ObjInterfaceSetVersion(lstringNoSetElementRPtr ,1);
    Tcl_ObjInterfaceSetFnListAll(lstringNoSetElementRPtr , my_LStringGetElements);
    Tcl_ObjInterfaceSetFnListIndex(lstringNoSetElementRPtr ,my_LStringObjIndex);
    Tcl_ObjInterfaceSetFnListLength(lstringNoSetElementRPtr ,my_LStringObjLength);
    Tcl_ObjInterfaceSetFnListRange(lstringNoSetElementRPtr ,my_LStringObjRange);
    Tcl_ObjInterfaceSetFnListReplace(lstringNoSetElementRPtr ,my_LStringReplace);
    Tcl_ObjInterfaceSetFnListReverse(lstringNoSetElementRPtr ,my_LStringObjReverse);
    Tcl_ObjTypeSetInterface((Tcl_ObjType *)&lstringTypes[6], lstringfullPtr);

    lstringNoReplacePtr = Tcl_NewObjInterface();
    Tcl_ObjInterfaceSetVersion(lstringNoReplacePtr ,1);
    Tcl_ObjInterfaceSetFnListAll(lstringNoReplacePtr , my_LStringGetElements);
    Tcl_ObjInterfaceSetFnListIndex(lstringNoReplacePtr ,my_LStringObjIndex);
    Tcl_ObjInterfaceSetFnListLength(lstringNoReplacePtr ,my_LStringObjLength);
    Tcl_ObjInterfaceSetFnListRange(lstringNoReplacePtr ,my_LStringObjRange);
    Tcl_ObjInterfaceSetFnListReverse(lstringNoReplacePtr ,my_LStringObjReverse);
    Tcl_ObjInterfaceSetFnListSetDeep(lstringNoReplacePtr ,my_LStringObjSetElemR);
    Tcl_ObjTypeSetInterface((Tcl_ObjType *)&lstringTypes[7], lstringNoReplacePtr);

    lgenIfPtr = Tcl_NewObjInterface();
    Tcl_ObjInterfaceSetVersion(lgenIfPtr ,1);
    Tcl_ObjInterfaceSetFnListIndex(lgenIfPtr ,lgenSeriesObjIndex);
    Tcl_ObjInterfaceSetFnListLength(lgenIfPtr ,lgenSeriesObjLength);
    Tcl_ObjTypeSetInterface(lgenTypePtr, lgenIfPtr);

    Tcl_CreateObjCommand(interp, "lstring", lLStringObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "lgen", lGenObjCmd, NULL, NULL);
    Tcl_PkgProvide(interp, "abstractlisttest", "1.0.0");

    return TCL_OK;
}
Changes to generic/tclTestObj.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
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

-
-
-
-
-
-
-








+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+


-







+
+




















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclTestObj.c --
 *
 *	This file contains C command functions for the additional Tcl commands
 *	that are used for testing implementations of the Tcl object types.
 *	These commands are not normally included in Tcl applications; they're
 *	only used for testing.
 *
 * Copyright © 1995-1998 Sun Microsystems, Inc.
 * Copyright © 1999 Scriptics Corporation.
 * Copyright © 2005 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.
#undef BUILD_tcl

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclTestObj.c --
 *
 *	This file contains procedures for the additional Tcl commands
 *	that are used for testing implementations of the Tcl_ObjType structs.
 *	These commands are built into a separate Tcl executable used to run the
 *	tests.
 */

#ifndef USE_TCL_STUBS
#	undef BUILD_tcl
#   define USE_TCL_STUBS
#endif
#define TCLBOOLWARNING(boolPtr) /* needed here because we compile with -Wc++-compat */
#include "tclInt.h"
#ifdef TCL_WITH_EXTERNAL_TOMMATH
#   include "tommath.h"
#else
#   include "tclTomMath.h"
#endif
#include "tclStringRep.h"
#undef TCLBOOLWARNING
#define TCLBOOLWARNING(boolPtr) /* needed here because we compile with -Wc++-compat */

#include <assert.h>

/*
 * Forward declarations for functions defined later in this file:
 */

static int		CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, Tcl_Size varIndex);
static int		GetVariableIndex(Tcl_Interp *interp,
			    Tcl_Obj *obj, Tcl_Size *indexPtr);
static void		SetVarToObj(Tcl_Obj **varPtr, Tcl_Size varIndex, Tcl_Obj *objPtr);
static Tcl_ObjCmdProc	TestbignumobjCmd;
static Tcl_ObjCmdProc	TestbooleanobjCmd;
static Tcl_ObjCmdProc	TestdoubleobjCmd;
static Tcl_ObjCmdProc	TestindexobjCmd;
static Tcl_ObjCmdProc	TestintobjCmd;
static Tcl_ObjCmdProc	TestlistobjCmd;
static Tcl_ObjCmdProc	TestobjCmd;
static Tcl_ObjCmdProc	TeststringobjCmd;
static Tcl_ObjCmdProc	TestbigdataCmd;

static int TestStringObjIsEmpty(tclObjTypeInterfaceArgsStringIsEmpty);
static int TestListObjLength(tclObjTypeInterfaceArgsListLength);
static void v2UpdateString(Tcl_Obj *objPtr);

static ObjectType v2TestListObjectType = {
    "testlist",		/* name */
    NULL,		/* freeIntRepProc */
    NULL,		/* dupIntRepProc */
    v2UpdateString,	/* updateStringProc */
    NULL,		/* setFromAnyProc */
    2,			/* This is a version  objType, which doesn't have an StringIsEmpty proc */
    NULL
};

Tcl_ObjType *v2TestListTypePtr = (Tcl_ObjType *)&v2TestListObjectType;

static ObjectType v3TestListObjectType = {
    "testlist2",	/* name */
    NULL,		/* freeIntRepProc */
    NULL,		/* dupIntRepProc */
    NULL,		/* updateStringProc */
    NULL,		/* setFromAnyProc */
    3,			/* This is a version  objType, which doesn't have an StringIsEmpty proc */
    NULL
};
Tcl_ObjType *v3TestListTypePtr = (Tcl_ObjType *)&v3TestListObjectType;




#define VARPTR_KEY "TCLOBJTEST_VARPTR"
#define NUMBER_OF_OBJECT_VARS 20

static void
VarPtrDeleteProc(
    void *clientData,
75
76
77
78
79
80
81
82
83


84
85
86
87


88
89
90

91
92
93
94
95
96
97
117
118
119
120
121
122
123


124
125
126
127


128
129
130
131

132
133
134
135
136
137
138
139







-
-
+
+


-
-
+
+


-
+







}

/*
 *----------------------------------------------------------------------
 *
 * TclObjTest_Init --
 *
 *	This function creates additional commands that are used to test the
 *	Tcl object support.
 *	Creates additional commands that are used to test
 *	Tcl_Obj support.
 *
 * Results:
 *	Returns a standard Tcl completion code, and leaves an error
 *	message in the interp's result if an error occurs.
 *	Returns a standard Tcl completion code, and if an error occurs, leaves an
 *	error message in the interp result.
 *
 * Side effects:
 *	Creates and registers several new testing commands.
 *	Creates new commands used by tests.
 *
 *----------------------------------------------------------------------
 */

int
TclObjTest_Init(
    Tcl_Interp *interp)
113
114
115
116
117
118
119













120
121
122
123
124
125
126
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







+
+
+
+
+
+
+
+
+
+
+
+
+







    if (!varPtr) {
	return TCL_ERROR;
    }
    Tcl_SetAssocData(interp, VARPTR_KEY, VarPtrDeleteProc, varPtr);
    for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
	varPtr[i] = NULL;
    }


    Tcl_ObjInterface * oiPtr = Tcl_NewObjInterface();
    Tcl_ObjInterfaceSetVersion(oiPtr ,2);
    Tcl_ObjInterfaceSetFnListLength(oiPtr , TestListObjLength);
    Tcl_ObjTypeSetInterface(v2TestListTypePtr ,oiPtr);

    oiPtr = Tcl_NewObjInterface();
    Tcl_ObjInterfaceSetVersion(oiPtr ,3);
    Tcl_ObjInterfaceSetFnListLength(oiPtr , TestListObjLength);
    Tcl_ObjInterfaceSetFnStringIsEmpty(oiPtr , TestStringObjIsEmpty);
    Tcl_ObjTypeSetInterface(v3TestListTypePtr ,oiPtr);


    Tcl_CreateObjCommand(interp, "testbignumobj", TestbignumobjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testbooleanobj", TestbooleanobjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testdoubleobj", TestdoubleobjCmd,
	    NULL, NULL);
161
162
163
164
165
166
167
168

169
170
171
172
173
174
175
216
217
218
219
220
221
222

223
224
225
226
227
228
229
230







-
+







static int
TestbignumobjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Argument count */
    Tcl_Obj *const objv[])	/* Argument vector */
{
    static const char *const subcmds[] = {
    const char *const subcmds[] = {
	"set", "get", "mult10", "div10", "iseven", "radixsize", NULL
    };
    enum options {
	BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10, BIGNUM_ISEVEN,
	BIGNUM_RADIXSIZE
    } idx;
    int index;
895
896
897
898
899
900
901
902

903
904
905
906
907
908
909
950
951
952
953
954
955
956

957
958
959
960
961
962
963
964







-
+







TestlistobjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Number of arguments */
    Tcl_Obj *const objv[])	/* Argument objects */
{
    /* Subcommands supported by this command */
    static const char* const subcommands[] = {
    const char* const subcommands[] = {
	"set",
	"get",
	"replace",
	"indexmemcheck",
	"getelementsmemcheck",
	"index",
	NULL
928
929
930
931
932
933
934
935

936
937
938
939
940
941
942
983
984
985
986
987
988
989

990
991
992
993
994
995
996
997







-
+







	return TCL_ERROR;
    }
    varPtr = GetVarPtr(interp);
    if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "command",
			    0, &cmdIndex) != TCL_OK) {
			    TCL_INDEX_TEMP_TABLE, &cmdIndex) != TCL_OK) {
	return TCL_ERROR;
    }
    switch(cmdIndex) {
    case LISTOBJ_SET:
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetListObj(varPtr[varIndex], objc-3, objv+3);
	} else {
986
987
988
989
990
991
992


993
994
995
996
997
998






999
1000
1001
1002
1003
1004
1005
1041
1042
1043
1044
1045
1046
1047
1048
1049






1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062







+
+
-
-
-
-
-
-
+
+
+
+
+
+







	}
	for (i = 0; i < len; ++i) {
	    Tcl_Obj *objP;
	    if (Tcl_ListObjIndex(interp, varPtr[varIndex], i, &objP)
		!= TCL_OK) {
		return TCL_ERROR;
	    }
	    Tcl_IncrRefCount(objP);
	    Tcl_DecrRefCount(objP);
	    if (objP->refCount < 0) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"Tcl_ListObjIndex returned object with ref count < 0",
			TCL_INDEX_NONE));
		/* Keep looping since we are also looping for leaks */
	    }
		if (objP->refCount < 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "Tcl_ListObjIndex returned object with ref count < 0",
			    TCL_INDEX_NONE));
		    /* Keep looping since we are also looping for leaks */
		}
	    Tcl_BounceRefCount(objP);
	}
	break;

    case LISTOBJ_GETELEMENTSMEMCHECK:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
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
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







+
+
-
-
+
+
+
+
+
+
+
+
+


-
-
-
-
-
+
+
+
+
+
-
-
+



-
+
-
-
+
-
-
-
-
-
+
+
+
+
+
-
-
-
-
+












-
+







 *
 * Side effects:
 *	Creates and frees objects.
 *
 *----------------------------------------------------------------------
 */

void v2UpdateString(Tcl_Obj *objPtr) {
    char *val, *newval;
static Tcl_Size V1TestListObjLength(TCL_UNUSED(Tcl_Obj *)) {
    return 100;
    Tcl_Size size;
    val = (char *)"hello";
    size = strlen(val) + 1;
    newval = (char *)Tcl_Alloc(size);
    strcpy(newval, val);
    newval[size] = 0;
    objPtr->bytes = newval;
    objPtr->length = size;
    return;
}

static int V1TestListObjIndex(
    TCL_UNUSED(Tcl_Interp *),
    TCL_UNUSED(Tcl_Obj *),
    TCL_UNUSED(Tcl_Size),
    Tcl_Obj **objPtr)
static int TestListObjLength(
	TCL_UNUSED(Tcl_Interp *)
	,TCL_UNUSED(Tcl_Obj *)
	,Tcl_Size *size 
) {
{
    *objPtr = Tcl_NewStringObj("This indexProc should never be accessed (bug: e58d7e19e9)", -1);
    *size = 100;
    return TCL_OK;
}

static const Tcl_ObjType v1TestListType = {
static int TestStringObjIsEmpty(
    "testlist",			/* name */
    NULL,		/* freeIntRepProc */
    TCL_UNUSED(Tcl_Interp *)
    NULL,		/* dupIntRepProc */
    NULL,		/* updateStringProc */
    NULL,		/* setFromAnyProc */
    offsetof(Tcl_ObjType, indexProc),			/* This is a V1 objType, which doesn't have an indexProc */
    V1TestListObjLength, /* always return 100, doesn't really matter */
    ,TCL_UNUSED(Tcl_Obj*)
    ,int *res)
{
    *res = 1;
    return TCL_OK;
    V1TestListObjIndex, /* should never be accessed, because this objType = V1*/
    NULL, NULL, NULL, NULL, NULL, NULL
};

}

static int
TestobjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Size varIndex, destIndex;
    int i;
    const Tcl_ObjType *targetType;
    Tcl_Obj **varPtr;
    static const char *const subcommands[] = {
    const char *subcommands[] = {
	"freeallvars", "bug3598580", "buge58d7e19e9",
	"types", "objtype", "newobj", "set",
	"assign", "convert", "duplicate",
	"invalidateStringRep", "refcount", "type",
	NULL
    };
    enum testobjCmdIndex {
1152
1153
1154
1155
1156
1157
1158


1159
1160












1161
1162
1163
1164
1165
1166
1167
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







+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+







	    Tcl_SetObjResult(interp, listObjPtr);
	}
	return TCL_OK;
    case TESTOBJ_BUGE58D7E19E9:
	if (objc != 3) {
	    goto wrongNumArgs;
	} else {
	    int v;
	    Tcl_GetIntFromObj(NULL, objv[2],&v);
	    Tcl_Obj *listObjPtr = Tcl_NewStringObj(Tcl_GetString(objv[2]), -1);
	    listObjPtr->typePtr = &v1TestListType;
	    Tcl_Obj *listObjPtr = Tcl_NewObj();
	    switch (v) {
		case 2:
		    listObjPtr->typePtr = v2TestListTypePtr;
		    break;
		case 3:
		    listObjPtr->typePtr = v3TestListTypePtr;
		    break;
		default:
		    return TCL_ERROR;
	    }
	    Tcl_InvalidateStringRep(listObjPtr);
	    Tcl_SetObjResult(interp, listObjPtr);
	}
	return TCL_OK;
    case TESTOBJ_TYPES:
	if (objc != 2) {
	    goto wrongNumArgs;
	} else {
Added generic/tclTestObjInterface.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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * Copyright © 2021 Nathan Coulter
 *
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclTestObjInterface.c --
 *
 *	This file contains C command functions for the additional Tcl commands
 *	that are used for testing implementations of the Tcl object types.
 *	These commands are not normally included in Tcl applications; they're
 *	only used for testing.
 */

#include "tcl.h"
#include "tclInt.h"

/*
 * Prototypes for functions defined later in this file:
 */
typedef struct indexHex {
    int refCount;
    Tcl_Size offset;
} indexHex;


int TcltestObjectInterfaceInit(Tcl_Interp *interp);

int NewTestIndexHex (
    ClientData, Tcl_Interp *interp, Tcl_Size argc, Tcl_Obj *const objv[]);
static void		DupTestIndexHexInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void		FreeTestIndexHexInternalRep(Tcl_Obj *objPtr);
static int		SetTestIndexHexFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		UpdateStringOfTestIndexHex(Tcl_Obj *listPtr);

static Tcl_ObjInterfaceStringIndexProc indexHexListStringIndex;
static Tcl_ObjInterfaceStringIndexEndProc indexHexListStringIndexEnd;
static Tcl_ObjInterfaceStringLengthProc indexHexListStringLength;
static int indexHexStringListIndexFromStringIndex(
    Tcl_Size *index, Tcl_Size *itemchars, Tcl_Size *totalitems);
static Tcl_ObjInterfaceStringRangeProc indexHexListStringRange;
static Tcl_ObjInterfaceStringRangeEndProc indexHexListStringRangeEnd;
static Tcl_ObjInterfaceListAllProc indexHexListObjGetElements;
static Tcl_ObjInterfaceListAppendProc indexHexListObjAppendElement;
static Tcl_ObjInterfaceListAppendlistProc indexHexListObjAppendList;
static Tcl_ObjInterfaceListIndexProc indexHexListObjIndex;
static Tcl_ObjInterfaceListIndexEndProc indexHexListObjIndexEnd;
static Tcl_ObjInterfaceListIsSortedProc indexHexListObjIsSorted;
static Tcl_ObjInterfaceListLengthProc indexHexListObjLength;
static Tcl_ObjInterfaceListRangeProc indexHexListObjRange;
static Tcl_ObjInterfaceListRangeEndProc indexHexListObjRangeEnd;
static Tcl_ObjInterfaceListReplaceProc indexHexListObjReplace;
static Tcl_ObjInterfaceListSetProc indexHexListObjSet;
static Tcl_ObjInterfaceListSetDeepProc indexHexListObjSetDeep;

static int indexHexListErrorIndeterminate (Tcl_Interp *interp);
static int indexHexListErrorReadOnly (Tcl_Interp *interp);


Tcl_ObjType *testIndexHexTypePtr;


int TcltestObjectInterfaceInit(Tcl_Interp *interp) {
    testIndexHexTypePtr = Tcl_NewObjType();
    Tcl_ObjTypeSetName(testIndexHexTypePtr ,(char *)"testindexHex");
    Tcl_ObjTypeSetFreeInternalRepProc(testIndexHexTypePtr , FreeTestIndexHexInternalRep);
    Tcl_ObjTypeSetDupInternalRepProc(testIndexHexTypePtr, DupTestIndexHexInternalRep);
    Tcl_ObjTypeSetUpdateStringProc(testIndexHexTypePtr, UpdateStringOfTestIndexHex);
    Tcl_ObjTypeSetSetFromAnyProc(testIndexHexTypePtr ,SetTestIndexHexFromAny);
    Tcl_ObjTypeSetVersion(testIndexHexTypePtr ,2);

    Tcl_ObjInterface * oiPtr = Tcl_NewObjInterface();
    Tcl_ObjInterfaceSetVersion(oiPtr ,1);

    Tcl_ObjInterfaceSetFnStringIndex(oiPtr ,indexHexListStringIndex);
    Tcl_ObjInterfaceSetFnStringIndexEnd(oiPtr ,indexHexListStringIndexEnd);
    Tcl_ObjInterfaceSetFnStringLength(oiPtr ,indexHexListStringLength);
    Tcl_ObjInterfaceSetFnStringRange(oiPtr ,indexHexListStringRange);
    Tcl_ObjInterfaceSetFnStringRangeEnd(oiPtr ,indexHexListStringRangeEnd);

    Tcl_ObjInterfaceSetFnListAll(oiPtr ,indexHexListObjGetElements);
    Tcl_ObjInterfaceSetFnListAppend(oiPtr ,indexHexListObjAppendElement);
    Tcl_ObjInterfaceSetFnListAppendList(oiPtr ,indexHexListObjAppendList);
    Tcl_ObjInterfaceSetFnListIndex(oiPtr ,indexHexListObjIndex);
    Tcl_ObjInterfaceSetFnListIndexEnd(oiPtr ,indexHexListObjIndexEnd);
    Tcl_ObjInterfaceSetFnListIsSorted(oiPtr ,indexHexListObjIsSorted);
    Tcl_ObjInterfaceSetFnListLength(oiPtr ,indexHexListObjLength);
    Tcl_ObjInterfaceSetFnListRange(oiPtr ,indexHexListObjRange);
    Tcl_ObjInterfaceSetFnListRangeEnd(oiPtr ,indexHexListObjRangeEnd);
    Tcl_ObjInterfaceSetFnListReplace(oiPtr ,indexHexListObjReplace);
    Tcl_ObjInterfaceSetFnListSet(oiPtr ,indexHexListObjSet);
    Tcl_ObjInterfaceSetFnListSetDeep(oiPtr ,indexHexListObjSetDeep);
    
    Tcl_ObjTypeSetInterface(testIndexHexTypePtr ,oiPtr);

    Tcl_CreateObjCommand2(interp, "testindexhex", NewTestIndexHex, NULL, NULL);
    return TCL_OK;
}



int NewTestIndexHex (
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_Size argc,
    Tcl_Obj *const objv[])
{
    Tcl_WideInt offset;
    Tcl_ObjInternalRep intrep;
    if (argc > 2) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("too many arguments", -1));
	    return TCL_ERROR;
	}
    }
    if (argc == 2) {
	if (Tcl_GetWideIntFromObj(interp, objv[1], &offset) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (offset < 0) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("bad offset", -1));
	    return TCL_ERROR;
	}
    }  else {
	offset = 0;
    }
    Tcl_Obj *objPtr = Tcl_NewObj();
    Tcl_InvalidateStringRep(objPtr);

    indexHex *indexHexPtr = (indexHex *)Tcl_Alloc(sizeof(indexHex));
    indexHexPtr->refCount = 1;
    indexHexPtr->offset = offset;
    intrep.twoPtrValue.ptr1 = indexHexPtr;
    Tcl_StoreInternalRep(objPtr, testIndexHexTypePtr, &intrep);
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}


static void
DupTestIndexHexInternalRep(
    TCL_UNUSED(Tcl_Obj *),
    TCL_UNUSED(Tcl_Obj *))
{
    return;
}


static void
FreeTestIndexHexInternalRep(Tcl_Obj *objPtr)
{
    indexHex *indexHexPtr = (indexHex *)objPtr->internalRep.twoPtrValue.ptr1;
    if (--indexHexPtr->refCount == 0) {
	Tcl_Free(indexHexPtr);
    }
    return;
}


static int
SetTestIndexHexFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr)
{
    if (TclHasInternalRep(objPtr, testIndexHexTypePtr)) {
	return TCL_OK;
    } else {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp,
		Tcl_NewStringObj("can not set an existing value to this type", -1));
	}
	return TCL_ERROR;
    }
}


static void
UpdateStringOfTestIndexHex(
    TCL_UNUSED(Tcl_Obj *))
{
    return;
}



static int indexHexListStringIndex(tclObjTypeInterfaceArgsStringIndex) {
    Tcl_Obj *hexPtr;
    int status;
    Tcl_Size itemchars, totalitems;

    status = indexHexStringListIndexFromStringIndex(
	&index, &itemchars, &totalitems);
    if (status != TCL_OK) {
	return TCL_ERROR;
    }

    status = indexHexListObjIndex(interp, objPtr, totalitems, &hexPtr);
    if (status != TCL_OK) {
	return TCL_ERROR;
    }

    if (index == itemchars - 1) {
	/* index refers to the space delimiter after the item. */
	*resPtrPtr = Tcl_NewStringObj(" ", -1);
    } else {
	*resPtrPtr = Tcl_GetRange(hexPtr, index, index);
    }
    Tcl_DecrRefCount(hexPtr);
    return status;
}


static int indexHexListErrorIndeterminate (Tcl_Interp *interp) {
    Tcl_SetObjResult(interp,
	Tcl_NewStringObj("list length indeterminate", -1));
    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "INDETERMINATE", NULL);
    return TCL_ERROR;
}


static int indexHexListErrorReadOnly (Tcl_Interp *interp) {
    if (interp != NULL) {
	Tcl_SetObjResult(interp,
	    Tcl_NewStringObj("list length indeterminate", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "INTERFACE",
	    "READONLY", NULL);
    }
    return TCL_ERROR;
}


static int indexHexStringListIndexFromStringIndex(
    Tcl_Size *indexPtr, Tcl_Size *itemcharsPtr, Tcl_Size *totalitemsPtr)
{
    Tcl_Size itemoffset, last = 0, power = 1, lasttotalchars = 0, newitems,
       top, totalchars = 0;

    /* add 1 for the space after the item */
    *itemcharsPtr = power + 1;
    *totalitemsPtr = 0;

    /* Count the number of characters in the items that contain fewer
     * characters than the item containing the requested index. */
    while (1) {
	top = 1u << (4 * power);
	if (top < 1u << (4 * (power - 1))) {
	    /* operation wrapped around */
	    power -= 1;
	    break;
	}
	newitems = top - last;
	lasttotalchars = totalchars;
	totalchars += newitems * *itemcharsPtr;
	last = top;
	if (*indexPtr < totalchars) {
	    break;
	}
	power += 1;
	*itemcharsPtr += 1;
	*totalitemsPtr += newitems;
    }

    *indexPtr -= lasttotalchars;
    /* Determine how many items containing the same number of characters
     * precede the requested item. */
    itemoffset = *indexPtr / *itemcharsPtr ;
    *indexPtr = *indexPtr % *itemcharsPtr;
    /* Add the number of new characters. */
    *totalitemsPtr += itemoffset;
    return TCL_OK;
}


static int indexHexListStringIndexEnd(
    Tcl_Interp *interp,	
    TCL_UNUSED(Tcl_Obj *),
    TCL_UNUSED(Tcl_Size),
    TCL_UNUSED(Tcl_Obj **)
) {
    return indexHexListErrorIndeterminate(interp);
}

static int indexHexListStringLength(
    TCL_UNUSED(Tcl_Obj *)
    ,Tcl_Size *length
) {
    *length = -1;
    return TCL_ERROR;
}

static int indexHexListStringRange(tclObjTypeInterfaceArgsStringRange) {
    Tcl_Obj *itemPtr, *item2Ptr, *resPtr;
    Tcl_Size index = first, status;
    Tcl_Size itemchars, needed, rangeLength, newStringLength,
       stringLength, totalitems;

    if (last < first) {
	*resPtrPtr = Tcl_NewStringObj("", -1);
	return TCL_OK;
    }

    status = indexHexStringListIndexFromStringIndex(
	&index, &itemchars, &totalitems);
    if (status != TCL_OK) {
	return status;
    }

    status = indexHexListObjIndex(NULL, objPtr, totalitems, &itemPtr);
    if (status != TCL_OK) {
	return status;
    }

    rangeLength = last - first + 1;

    resPtr = Tcl_GetRange(itemPtr, index, index + rangeLength - 1);
    Tcl_DecrRefCount(itemPtr);

    stringLength = Tcl_GetCharLength(resPtr);
    if (stringLength < rangeLength) {
	needed = rangeLength - stringLength;
	while (needed > 0) {
	    totalitems++;
	    status = indexHexListObjIndex(NULL, objPtr, totalitems, &itemPtr);
	    if (status != TCL_OK) {
		return status;
	    }
	    Tcl_AppendToObj(resPtr, " ", 1);
	    stringLength += newStringLength;
	    needed -= 1;
	    if (needed > 0) {
		newStringLength = Tcl_GetCharLength(itemPtr);
		if (newStringLength >= needed) {
		    item2Ptr = Tcl_GetRange(itemPtr, 0, needed-1);
		    newStringLength = Tcl_GetCharLength(item2Ptr);
		    Tcl_AppendObjToObj(resPtr, item2Ptr);
		    Tcl_DecrRefCount(item2Ptr);
		} else {
		    Tcl_AppendObjToObj(resPtr, itemPtr);
		}
		stringLength += newStringLength;
		needed -= newStringLength;
	    }
	    Tcl_DecrRefCount(itemPtr);
	}
    }
    *resPtrPtr = resPtr;
    return TCL_OK;
}

static int indexHexListStringRangeEnd(
    TCL_UNUSED(Tcl_Obj *),/* The Tcl object to find the range of. */
    TCL_UNUSED(Tcl_Size),/* First index of the range. */
    TCL_UNUSED(Tcl_Size), /* Last index of the range. */
    Tcl_Obj **resultPtr
) {
    *resultPtr = NULL;
    return TCL_OK;
}



static int
indexHexListObjGetElements(
    Tcl_Interp *interp,	/* Used to report errors if not NULL. */
    TCL_UNUSED(Tcl_Obj *),/* List object for which an element array
			   * is to be returned. */
    TCL_UNUSED(Tcl_Size *),/* Where to store the count of objects
			    * referenced by objv. */
    TCL_UNUSED(Tcl_Obj ***)/* Where to store the pointer to an
			    * array of */
)
{
    if (interp != NULL) {
	Tcl_SetObjResult(interp,Tcl_NewStringObj("infinite list", -1));
    }
    return TCL_ERROR;
}


static int
indexHexListObjAppendElement(
    Tcl_Interp *interp,	/* Used to report errors if not NULL. */
    TCL_UNUSED(Tcl_Obj *),/* List object to append objPtr to. */
    TCL_UNUSED(Tcl_Obj *)/* Object to append to listPtr's list. */
)
{
    indexHexListErrorReadOnly(interp);
    return TCL_ERROR;
}


static int
indexHexListObjAppendList(
    Tcl_Interp *interp,	    /* Used to report errors if not NULL. */
    TCL_UNUSED(Tcl_Obj *),  /* List object to append elements to. */
    TCL_UNUSED(Tcl_Obj *)   /* List obj with elements to append. */
)
{
    indexHexListErrorReadOnly(interp);
    return TCL_ERROR;
}


static int
indexHexListObjIndex(
    TCL_UNUSED(Tcl_Interp *),/* Used to report errors if not NULL. */ \
    TCL_UNUSED(Tcl_Obj *),	/* List object to index into. */ \
    Tcl_Size index,	/* Index of element to return. */ \
    Tcl_Obj **objPtrPtr	/* The resulting Tcl_Obj* is stored here. */
)
{
    Tcl_Obj *resPtr;
    resPtr = Tcl_ObjPrintf("%" TCL_T_MODIFIER "x", index);
    *objPtrPtr = resPtr;
    return TCL_OK;
}


static int
indexHexListObjIndexEnd(
    Tcl_Interp * interp,/* Used to report errors if not NULL. */ \
    TCL_UNUSED(Tcl_Obj *),/* List object to index into. */ \
    TCL_UNUSED(Tcl_Size),/* Index of element to return. */ \
    TCL_UNUSED(Tcl_Obj **)/* The resulting Tcl_Obj* is stored here. */
)
{
    return indexHexListErrorIndeterminate(interp);
}


static int indexHexListObjIsSorted(
    TCL_UNUSED(Tcl_Interp *), /* Used to report errors */
    TCL_UNUSED(Tcl_Obj *),	/* The list in question */
    TCL_UNUSED(size_t) /* flags */
)
{
    return 1;
}


static int
indexHexListObjLength(
    TCL_UNUSED(Tcl_Interp *),	/* Used to report errors if not NULL. */
    TCL_UNUSED(Tcl_Obj *),	/* List object whose #elements to return. */
    Tcl_Size *lenPtr		/* The resulting length is stored here. */
)
{
    *lenPtr = -1;
    return TCL_OK;
}


static int 
indexHexListObjRange(tclObjTypeInterfaceArgsListRange)
{
    Tcl_Obj *itemPtr, *resPtr;
    Tcl_Size length;
    int status;
    resPtr = Tcl_NewListObj(0, NULL);
    status = Tcl_ListObjLength(interp, listPtr, &length);
    if (!status) {
	*resPtrPtr = NULL;
	return TCL_OK;
    }
    while (fromIdx <= length && fromIdx <= toIdx) {
	indexHexListObjIndex(interp, listPtr, fromIdx, &itemPtr);
	if (
	    Tcl_ListObjAppendElement(interp, resPtr, itemPtr) != TCL_OK
	) {
	    Tcl_DecrRefCount(resPtr);
	    *resPtrPtr = NULL;
	    return TCL_OK;
	}
	fromIdx++;
    }
    *resPtrPtr = resPtr;
    return TCL_OK;
}


static int
indexHexListObjRangeEnd(tclObjTypeInterfaceArgsListRangeEnd) {
    if (fromAnchor == 1 || toAnchor == 1) {
	indexHexListErrorIndeterminate(interp);
	*resPtrPtr = NULL;
	return TCL_OK;
    }
    return indexHexListObjRange(interp, listPtr, fromIdx, toIdx, resPtrPtr);
}


static int
indexHexListObjReplace(
    Tcl_Interp *interp, /* Used for error reporting if not NULL. */ \
    TCL_UNUSED(Tcl_Obj *),   /* List object whose elements to replace. */ \
    TCL_UNUSED(Tcl_Size),     /* Index of first element to replace. */ \
    TCL_UNUSED(Tcl_Size),	/* Number of elements to replace. */ \
    TCL_UNUSED(Tcl_Size),	/* Number of objects to insert. */ \
        		/* An array of objc pointers to Tcl \
        		 * objects to insert. */ \
    TCL_UNUSEDVAR(Tcl_Obj *const insertObjs[])
)
{
    indexHexListErrorReadOnly(interp);
    return TCL_ERROR;
}


static int
indexHexListObjSet(
    Tcl_Interp *interp,		/* Tcl interpreter; used for error reporting
				 * if not NULL. */
    TCL_UNUSED(Tcl_Obj *),	/* List object in which element should be
				 * stored. */
    TCL_UNUSED(Tcl_Size),	/* Index of element to store. */
    TCL_UNUSED(Tcl_Obj *)/* Tcl object to store in the designated list 
				 * element. */
)
{
    indexHexListErrorReadOnly(interp);
    return TCL_ERROR;
}


static int indexHexListObjSetDeep (
    Tcl_Interp *interp,		/* Tcl interpreter. */ \
    TCL_UNUSED(Tcl_Obj *),	/* Pointer to the list being modified. */ \
    TCL_UNUSED(Tcl_Size),	/* Number of index args. */ \
    TCL_UNUSEDVAR(Tcl_Obj *const indexArray[]),	/* Index args. */ \
    TCL_UNUSED(Tcl_Obj *),   /* Value arg to 'lset' or NULL to 'lpop'. */
    Tcl_Obj **resPtrPtr)
{
    indexHexListErrorReadOnly(interp);
    *resPtrPtr = NULL;
    return TCL_ERROR;
}
Added generic/tclTestObjInterfaceInteger.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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * Copyright © 2021 Nathan Coulter
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclTestObjInterfce.c --
 *
 *	This file contains C command functions for the additional Tcl commands
 *	that are used for testing implementations of the Tcl object types.
 *	These commands are not normally included in Tcl applications; they're
 *	only used for testing.
 */

#include "tcl.h"
#include "tclInt.h"

/*
 * Prototypes for functions defined later in this file:
 */
int TestListInteger (
    ClientData, Tcl_Interp *interp, Tcl_Size argc, Tcl_Obj *const objv[]);
static Tcl_Obj* NewTestListInteger();
static void	DupTestListIntegerInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);

static void	FreeTestListIntegerInternalRep(Tcl_Obj *objPtr);
static int	SetTestListIntegerFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void	UpdateStringOfTestListInteger(Tcl_Obj *listPtr);

int TestListIntegerGetElements(TCL_UNUSED(void *), Tcl_Interp *interp,
    Tcl_Size argc, Tcl_Obj *const objv[]);

static Tcl_ObjInterfaceStringIndexProc ListIntegerListStringIndex;
static Tcl_ObjInterfaceStringIndexEndProc ListIntegerListStringIndexEnd;
static Tcl_ObjInterfaceStringLengthProc ListIntegerListStringLength;
/*
static int ListIntegerStringListIndexFromStringIndex(
    Tcl_Size *index, Tcl_Size *itemchars, Tcl_Size *totalitems);
*/
static Tcl_ObjInterfaceStringRangeProc ListIntegerListStringRange;
static Tcl_ObjInterfaceStringRangeEndProc ListIntegerListStringRangeEnd;

static Tcl_ObjInterfaceListAppendProc ListIntegerListObjAppendElement;
static Tcl_ObjInterfaceListAppendlistProc ListIntegerListObjAppendList;
static Tcl_ObjInterfaceListIndexProc ListIntegerListObjIndex;
static Tcl_ObjInterfaceListIndexEndProc ListIntegerListObjIndexEnd;
static Tcl_ObjInterfaceListIsSortedProc ListIntegerListObjIsSorted;
static Tcl_ObjInterfaceListLengthProc ListIntegerListObjLength;
static Tcl_ObjInterfaceListRangeProc ListIntegerListObjRange;
static Tcl_ObjInterfaceListRangeEndProc ListIntegerListObjRangeEnd;
static Tcl_ObjInterfaceListReplaceProc ListIntegerListObjReplace;
static Tcl_ObjInterfaceListReplaceListProc ListIntegerListObjReplaceList;
static Tcl_ObjInterfaceListSetProc ListIntegerLset;
static Tcl_ObjInterfaceListSetDeepProc ListIntegerListObjSetDeep;

static int ErrorMaxElementsExceeded(Tcl_Interp *interp);


typedef struct ListInteger {
    int refCount;
    int ownstring;
    int size;
    int used;
    int values[1];
} ListInteger;


static ListInteger* NewTestListIntegerIntrep();
static ListInteger* ListGetInternalRep(Tcl_Obj *listPtr);
static void ListIntegerDecrRefCount(ListInteger *listIntegerPtr);

static ObjectType testListIntegerType = {
    "testListInteger",
    FreeTestListIntegerInternalRep,	/* freeIntRepProc */
    DupTestListIntegerInternalRep,		/* dupIntRepProc */
    UpdateStringOfTestListInteger,		/* updateStringProc */
    SetTestListIntegerFromAny,		/* setFromAnyProc */
    2,
    NULL
};

Tcl_ObjType *testListIntegerTypePtr = (Tcl_ObjType *)&testListIntegerType;



int TcltestObjectInterfaceListIntegerInit(Tcl_Interp *interp) {
    Tcl_ObjInterface *oiPtr;
    oiPtr = Tcl_NewObjInterface();
    Tcl_ObjInterfaceSetFnStringIndex(oiPtr ,ListIntegerListStringIndex);
    Tcl_ObjInterfaceSetFnStringIndexEnd(oiPtr ,ListIntegerListStringIndexEnd);
    Tcl_ObjInterfaceSetFnStringLength(oiPtr ,ListIntegerListStringLength);
    Tcl_ObjInterfaceSetFnStringRange(oiPtr ,ListIntegerListStringRange);
    Tcl_ObjInterfaceSetFnStringRangeEnd(oiPtr ,ListIntegerListStringRangeEnd);
    Tcl_ObjInterfaceSetFnListAppend(oiPtr ,ListIntegerListObjAppendElement);
    Tcl_ObjInterfaceSetFnListAppendList(oiPtr ,ListIntegerListObjAppendList);
    Tcl_ObjInterfaceSetFnListIndex(oiPtr ,ListIntegerListObjIndex);
    Tcl_ObjInterfaceSetFnListIndexEnd(oiPtr ,ListIntegerListObjIndexEnd);
    Tcl_ObjInterfaceSetFnListIsSorted(oiPtr ,ListIntegerListObjIsSorted);
    Tcl_ObjInterfaceSetFnListLength(oiPtr ,ListIntegerListObjLength);
    Tcl_ObjInterfaceSetFnListRange(oiPtr ,ListIntegerListObjRange);
    Tcl_ObjInterfaceSetFnListRangeEnd(oiPtr ,ListIntegerListObjRangeEnd);
    Tcl_ObjInterfaceSetFnListReplace(oiPtr ,ListIntegerListObjReplace);
    Tcl_ObjInterfaceSetFnListReplaceList(oiPtr ,ListIntegerListObjReplaceList);
    Tcl_ObjInterfaceSetFnListSet(oiPtr , ListIntegerLset);
    Tcl_ObjInterfaceSetFnListSetDeep(oiPtr ,ListIntegerListObjSetDeep);
    Tcl_ObjTypeSetInterface(testListIntegerTypePtr,oiPtr);


    Tcl_CreateObjCommand2(interp, "testlistinteger", TestListInteger, NULL, NULL);
    Tcl_CreateObjCommand2(interp, "testlistintegergetelements", TestListIntegerGetElements, NULL, NULL);
    return TCL_OK;
}

int TestListInteger(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_Size argc,
    Tcl_Obj *const objv[])
{
    int status;
    if (argc != 2) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # arguments", -1));
	}
	return TCL_ERROR;
    }
    status = Tcl_ConvertToType(interp, objv[1], testListIntegerTypePtr);
    Tcl_SetObjResult(interp, objv[1]);
    return status;
}

int TestListIntegerGetElements(
    TCL_UNUSED(void *),
    TCL_UNUSED(Tcl_Interp *),
    TCL_UNUSED(Tcl_Size),
    TCL_UNUSED(Tcl_Obj * const *))
{
    return 0;
}


Tcl_Obj*
NewTestListInteger() {
    Tcl_ObjInternalRep intrep;
    Tcl_Obj *listPtr = Tcl_NewObj();
    Tcl_InvalidateStringRep(listPtr);
    ListInteger *listIntegerPtr = NewTestListIntegerIntrep();
    intrep.twoPtrValue.ptr1 = listIntegerPtr;
    Tcl_StoreInternalRep(listPtr, testListIntegerTypePtr, &intrep);
    return listPtr;
}


ListInteger*
NewTestListIntegerIntrep() {
    ListInteger *listIntegerPtr = (ListInteger *)Tcl_Alloc(sizeof(ListInteger));
    listIntegerPtr->refCount = 1;
    listIntegerPtr->ownstring = 0;
    listIntegerPtr->size = 1;
    listIntegerPtr->used = 0;
    return listIntegerPtr;
}

static ListInteger* ListGetInternalRep(Tcl_Obj *listPtr) {
    return (ListInteger *)listPtr->internalRep.twoPtrValue.ptr1;
}




static void DupTestListIntegerInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) {
    Tcl_ObjInternalRep intrep;
    ListInteger *listRepPtr = ListGetInternalRep(srcPtr);
    listRepPtr->refCount++;
    intrep.twoPtrValue.ptr1 = listRepPtr;
    Tcl_StoreInternalRep(copyPtr, testListIntegerTypePtr, &intrep);
    return;
}

static void FreeTestListIntegerInternalRep(Tcl_Obj *listPtr) {
    ListInteger *listRepPtr = ListGetInternalRep(listPtr);
    ListIntegerDecrRefCount(listRepPtr);
    return;
}

static int SetTestListIntegerFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) {
    int status;
    Tcl_Size i, length;
    Tcl_Obj *itemPtr, *listPtr;
    Tcl_ObjInternalRep intrep;
    ListInteger *listRepPtr;
    if (TclHasInternalRep(objPtr, testListIntegerTypePtr)) {
	return TCL_OK;
    } else {
	status = Tcl_ListObjLength(interp, objPtr, &length);
	if (status != TCL_OK) {
	    return TCL_ERROR;
	}
	listPtr = NewTestListInteger();
	for (i = 0; i < length; i++) {
	    status = Tcl_ListObjIndex(interp, objPtr, i, &itemPtr);
	    if (status != TCL_OK) {
		Tcl_DecrRefCount(listPtr);
		return status;
	    }
	    status = ListIntegerListObjReplace(interp, listPtr, i, 0, 1, &itemPtr);
	    status = TCL_OK;
	    if (status != TCL_OK) {
		Tcl_DecrRefCount(listPtr);
		return status;
	    }
	}
	listRepPtr = ListGetInternalRep(listPtr);
	intrep.twoPtrValue.ptr1 = listRepPtr;
	listRepPtr->refCount++;
	Tcl_StoreInternalRep(objPtr, testListIntegerTypePtr, &intrep);
	Tcl_DecrRefCount(listPtr);
	return TCL_OK;
    }
}

static void UpdateStringOfTestListInteger(Tcl_Obj *listPtr) {
    ListInteger *listRepPtr = ListGetInternalRep(listPtr);
    int i, num, used = listRepPtr->used;
    Tcl_Obj *strPtr, *numObjPtr;
    if (used > 0) {
	strPtr = Tcl_NewObj();
	Tcl_IncrRefCount(strPtr);
	num = listRepPtr->values[0];
	numObjPtr = Tcl_NewIntObj(num);
	Tcl_IncrRefCount(numObjPtr);
	Tcl_AppendFormatToObj(NULL, strPtr, "%d", 1, &numObjPtr);
	Tcl_DecrRefCount(numObjPtr);
	for (i = 1; i < used; i++) {
	    num = listRepPtr->values[i];
	    numObjPtr = Tcl_NewIntObj(num);
	    Tcl_IncrRefCount(numObjPtr);
	    Tcl_AppendFormatToObj(NULL, strPtr, " %d", 1, &numObjPtr);
	    Tcl_DecrRefCount(numObjPtr);
	}
	listPtr->bytes = strPtr->bytes;
	listPtr->length = strPtr->length;
	strPtr->bytes = 0;
	strPtr->length = 0;
	Tcl_DecrRefCount(strPtr);
    } else {
	Tcl_InitStringRep(listPtr, NULL, 0);
    }
    listRepPtr->ownstring = 1;
    return;
}

static void ListIntegerDecrRefCount(ListInteger *listIntegerPtr) {
    if (--listIntegerPtr->refCount <= 0) {
	Tcl_Free(listIntegerPtr);
    }
    return;
}

static int ListIntegerListStringIndex (
    TCL_UNUSED(Tcl_Interp *),/* Used to report errors if not NULL. */ \
    TCL_UNUSED(Tcl_Obj *),	/* List object to index into. */ \
    TCL_UNUSED(Tcl_Size),	/* Index of element to return. */ \
    TCL_UNUSED(Tcl_Obj **)/* The resulting Tcl_Obj* is stored here. */
)
{
    return TCL_ERROR;
}

static int ListIntegerListStringIndexEnd(
    TCL_UNUSED(Tcl_Interp *),/* Used to report errors if not NULL. */ \
    TCL_UNUSED(Tcl_Obj *),/* List object to index into. */ \
    TCL_UNUSED(Tcl_Size),/* Index of element to return. */ \
    TCL_UNUSED(Tcl_Obj **)/* The resulting Tcl_Obj* is stored here. */
) {
    return TCL_ERROR;
}

static int ListIntegerListStringLength(
    TCL_UNUSED(Tcl_Obj *)
    ,Tcl_Size *lengthPtr
) {
    *lengthPtr = -1;
    return TCL_ERROR;
}

/*
static int ListIntegerStringListIndexFromStringIndex(
    TCL_UNUSEDVAR(Tcl_Size *index),
    TCL_UNUSEDVAR(Tcl_Size *itemchars),
    TCL_UNUSEDVAR(Tcl_Size *totalitems)
) {
    return TCL_ERROR;
}
*/

static int ListIntegerListStringRange(
    TCL_UNUSED(Tcl_Obj *),	/* The Tcl object to find the range of. */ \
    TCL_UNUSED(Tcl_Size),	/* First index of the range. */ \
    TCL_UNUSED(Tcl_Size),	/* Last index of the range. */ \
    Tcl_Obj **resPtrPtr	/* The resulting Tcl_Obj* is stored here. */
) {
    *resPtrPtr = NULL;
    return TCL_OK;
}

static int ListIntegerListStringRangeEnd(
    TCL_UNUSED(Tcl_Obj *),	/* The Tcl object to find the range of. */ \
    TCL_UNUSED(Tcl_Size),	/* First index of the range. */ \
    TCL_UNUSED(Tcl_Size),	/* Last index of the range. */ \
    Tcl_Obj **resPtrPtr	/* The resulting Tcl_Obj* is stored here. */)
{
    *resPtrPtr = NULL;
    return TCL_OK;
}


static int ListIntegerListObjAppendElement(tclObjTypeInterfaceArgsListAppend) {
    int status;
    Tcl_Size length;
    status = Tcl_ListObjLength(interp, listPtr, &length);
    if (status != TCL_OK) {
	return TCL_ERROR;
    }
    return ListIntegerListObjReplace(interp, listPtr, length, 0, 1, &objPtr);
}

static int ListIntegerListObjAppendList(
    TCL_UNUSEDVAR(Tcl_Interp *interp),	    /* Used to report errors if not NULL. */ \
    TCL_UNUSEDVAR(Tcl_Obj *listPtr),	    /* List object to append elements to. */ \
    TCL_UNUSEDVAR(Tcl_Obj *elemListPtr)    /* List obj with elements to append. */
) {
    return TCL_ERROR;
}

static int ListIntegerListObjIndex(
    TCL_UNUSED(Tcl_Interp *),/* Used to report errors if not NULL. */ \
    Tcl_Obj * listObj,/* List object to index into. */ \
    Tcl_Size index,	/* Index of element to return. */ \
    Tcl_Obj **objPtrPtr	/* The resulting Tcl_Obj* is stored here. */
) {
    ListInteger *listRepPtr = ListGetInternalRep(listObj);
    Tcl_Size num;
    if (index >= 0 && index < listRepPtr->used) {
	num = listRepPtr->values[index];
	*objPtrPtr = Tcl_NewLongObj(num);
    } else {
	*objPtrPtr = NULL;
    }
    return TCL_OK;
}

static int ListIntegerListObjIndexEnd(
    TCL_UNUSED(Tcl_Interp *),/* Used to report errors if not NULL. */ \
    TCL_UNUSED(Tcl_Obj *),/* List object to index into. */ \
    TCL_UNUSED(Tcl_Size),/* Index of element to return. */ \
    TCL_UNUSED(Tcl_Obj **)/* The resulting Tcl_Obj* is stored here. */
) {
    return TCL_ERROR;
}

static int ListIntegerListObjIsSorted(
    TCL_UNUSED(Tcl_Interp *), /* Used to report errors */
    TCL_UNUSED(Tcl_Obj *),	/* The list in question */
    TCL_UNUSED(size_t) /* flags */
) {
    return TCL_ERROR;
}

static int ListIntegerListObjLength(
    TCL_UNUSED(Tcl_Interp *),	/* Used to report errors if not NULL. */
    Tcl_Obj * listObj,	/* List object whose #elements to return. */
    Tcl_Size *lenPtr		/* The resulting length is stored here. */
) {
    ListInteger *listRepPtr = ListGetInternalRep(listObj);
    *lenPtr = listRepPtr->used;
    return TCL_OK;
}

static int ListIntegerListObjRange(tclObjTypeInterfaceArgsListRange) {
    ListInteger *listRepPtr = ListGetInternalRep(listPtr);
    Tcl_Size i, j, num, used = listRepPtr->used;
    Tcl_Obj *numObjPtr, *resPtr;

    if ((fromIdx == 0 && toIdx >= used - 1) || used == 0) {
	*resPtrPtr = listPtr;
	return TCL_OK;
    }

    if (Tcl_IsShared(listPtr) ||
	((listRepPtr->refCount > 1))) {
	if (fromIdx >= used || toIdx < fromIdx) {
	    *resPtrPtr = Tcl_NewObj();
	    return TCL_OK;
	} else {
	    resPtr = NewTestListInteger();
	    for (i = fromIdx, j = 0; i <= toIdx; i++, j++) {
		num = listRepPtr->values[i];
		numObjPtr = Tcl_NewIntObj(num);
		Tcl_IncrRefCount(numObjPtr);
		if (ListIntegerListObjReplace(
		    interp, resPtr, j , 0 , 1 ,&numObjPtr) != TCL_OK) {
		    Tcl_DecrRefCount(resPtr);
		    Tcl_DecrRefCount(numObjPtr);
		    *resPtrPtr = NULL;
		    return TCL_OK;
		}
		Tcl_DecrRefCount(numObjPtr);
	    }
	    *resPtrPtr = resPtr;
	    return TCL_OK;
	}
    }
    *resPtrPtr = NULL;
    return TCL_OK;
}


static int ListIntegerListObjRangeEnd(
    TCL_UNUSEDVAR(Tcl_Interp * interp), /* Used to report errors */ \
    TCL_UNUSEDVAR(Tcl_Obj *listPtr),	/* List object to take a range from. */ \
    TCL_UNUSEDVAR(Tcl_Size fromAnchor),/* 0 for start and 1 for end */ \
    TCL_UNUSEDVAR(Tcl_Size fromIdx),	/* Index of first element to include. */ \
    TCL_UNUSEDVAR(Tcl_Size toAnchor),	/* 0 for start and 1 for end */  \
    TCL_UNUSEDVAR(Tcl_Size toIdx),	/* Index of last element to include. */
    Tcl_Obj **resPtrPtr
) {
    *resPtrPtr = NULL;
    return TCL_OK;
}


static int ListIntegerListObjReplace(tclObjTypeInterfaceArgsListReplace) {
    int i, status;
    Tcl_Obj *tmpListPtr = Tcl_NewObj();
    Tcl_IncrRefCount(tmpListPtr);
    for (i = 0; i < numToInsert; i++) {
	status = Tcl_ListObjAppendElement(interp, tmpListPtr, insertObjs[i]);
	if (status != TCL_OK) {
	    Tcl_DecrRefCount(tmpListPtr);
	    return status;
	}
    }
    status = ListIntegerListObjReplaceList(
	interp, listObj, first, numToDelete, tmpListPtr);
    Tcl_DecrRefCount(tmpListPtr);
    return status;
}


static int ListIntegerListObjReplaceList(tclObjTypeInterfaceArgsListReplaceList) {
    ListInteger *listRepPtr = ListGetInternalRep(listPtr);
    ListInteger *newListRepPtr;
    int changed = 0, itemInt, status;
    Tcl_Size i, index, newmemsize, itemsLength, j, newsize,
	     newtailindex, newused, size, newtailend, tailindex, tailsize,
	     used;
    Tcl_Obj *itemPtr;
    size = listRepPtr->size;
    used = listRepPtr->used;
    if (first < used) {
	tailsize = used - first;
    } else {
	tailsize = 0;
    }

    status = Tcl_ListObjLength(interp, newItemsPtr, &itemsLength);
    if (status != TCL_OK) {
	return TCL_ERROR;
    }

    /* Currently this duplicates checks found in Tcl_ListObjReplace, but
     * could be removed in that function in the future.
    */

    if (first >= used) {
	first = used;
    } else if (first < 0) {
	first = 0;
    }

    if (count > tailsize) {
	count = tailsize;
    }

    /* If count == 0 and itemsLength == 0 this routine is logically a no-op,
     * but any non-canonical string representation must still be invalidated.
     */ 

    /* to do:
     * Recode this routine to work with incoming of unbounded length
     */

    if (used > 0) {
	tailindex = first + count;
	newtailindex = first + itemsLength;
	if (INT_MAX - tailsize - 1 < newtailindex) {
	    return ErrorMaxElementsExceeded(interp);
	}
	newused = newtailindex + tailsize;
	if (itemsLength > 0 && INT_MAX - itemsLength < newused) {
	    return ErrorMaxElementsExceeded(interp);
	}
    } else {
	tailindex = 0;
	newtailindex = 0;
	newused = itemsLength;
    }

    if (newused > size && newused > 1) {
	newsize = (newused + newused / 5 + 1);
	if (newsize < size) {
	    return ErrorMaxElementsExceeded(interp);
	}
    } else {
	newsize = size;
    }

    if (!listRepPtr->ownstring) {
	/* schedule canonicalization of the string rep */
	Tcl_InvalidateStringRep(listPtr);
	listRepPtr->ownstring = 1;
    }

    if (newused < used) {
	Tcl_InvalidateStringRep(listPtr);
    }


    newmemsize = sizeof(ListInteger) + newsize * sizeof(int) - sizeof(int);
    if (listRepPtr->refCount > 1) {
	Tcl_ObjInternalRep intrep;
	/* copy only the structure and the head of the old array */
	int movsize = sizeof(ListInteger)
	    + ((first + 1)  * sizeof(int) - sizeof(int));
	newListRepPtr = (ListInteger *)Tcl_Alloc(newmemsize);
	memmove(newListRepPtr, listRepPtr, movsize);
	newListRepPtr->size = newsize;
	newListRepPtr->refCount = 1;
	/* move the tail to its new location to make room for the new additions
	*/
	memmove(newListRepPtr->values + newtailindex,
	    listRepPtr->values + tailindex, tailsize * sizeof(int));
	intrep.twoPtrValue.ptr1 = newListRepPtr;
	Tcl_StoreInternalRep(listPtr, testListIntegerTypePtr, &intrep);
    } else {
	if (newsize > size && newused > 1) {
	    newListRepPtr = (ListInteger *)Tcl_Realloc(listRepPtr, newmemsize);
	} else {
	    newListRepPtr = listRepPtr;
	}
	newListRepPtr->size = newsize;
	if (tailsize > 0 && tailindex != newtailindex) {
	    /* move the tail to its new location to make room for the new
	     * additions */
	    memmove(newListRepPtr->values + newtailindex,
		    newListRepPtr->values + tailindex, tailsize);
	}
	listPtr->internalRep.twoPtrValue.ptr1 = newListRepPtr;
    }

    i = -1;
    while (1) {
	i++;
	index = first + i;
	status = Tcl_ListObjIndex(interp, newItemsPtr, i, &itemPtr);
	if (status != TCL_OK) {
	    return status;
	}
	if (itemPtr == NULL) {
	    break;
	}
	if (Tcl_GetIntFromObj(interp, itemPtr, &itemInt)
	    == TCL_OK) {
	    if (newListRepPtr->values[index] != itemInt) {
		changed = 1;
		newListRepPtr->values[index] = itemInt;
	    }
	    newListRepPtr->values[index] = itemInt;
	} else {
	    Tcl_Obj *realListPtr;
	    /* Fall back to normal list */
	    realListPtr = Tcl_NewListObj(newsize, NULL);
	    Tcl_IncrRefCount(realListPtr);

	    for (j = 0; j < index; j++) {
		itemPtr = Tcl_NewIntObj(newListRepPtr->values[j]);
		status = Tcl_ListObjAppendElement(
		    interp, realListPtr, itemPtr);
		if (status != TCL_OK) {
		    Tcl_DecrRefCount(realListPtr);
		    return status;
		}
	    }
	    while (1) {
		if (itemsLength == TCL_LENGTH_NONE) {
		    status = Tcl_ListObjLength(interp, newItemsPtr, &itemsLength);
		    if (status != TCL_OK) {
			Tcl_DecrRefCount(realListPtr);
			return status;
		    }
		}
		if (itemsLength != TCL_LENGTH_NONE && i >= itemsLength) {
		    break;
		}
		status = Tcl_ListObjIndex(interp, newItemsPtr, i, &itemPtr);
		if (status != TCL_OK) {
		    Tcl_DecrRefCount(realListPtr);
		    return status;
		}
		if (itemPtr == NULL) {
		    break;
		}
		status = Tcl_ListObjAppendElement(
		    interp, realListPtr, itemPtr);
		if (status != TCL_OK) {
		    Tcl_DecrRefCount(realListPtr);
		    return status;
		}
		i++;
	    }

	    newtailend = newtailindex + tailsize;
	    for (i = newtailindex; i < newtailend; i++) {
		itemPtr = Tcl_NewIntObj(newListRepPtr->values[i]);
		Tcl_ListObjAppendElement(interp, realListPtr, itemPtr);
		if (status != TCL_OK) {
		    Tcl_DecrRefCount(realListPtr);
		    return status;
		}
	    }

	    ListIntegerDecrRefCount(newListRepPtr);
	    listPtr->internalRep = realListPtr->internalRep;
	    listPtr->typePtr = realListPtr->typePtr;
	    realListPtr->typePtr = NULL;
	    Tcl_DecrRefCount(realListPtr);
	    /* this might not always be necessary, but probably the best that
	     * can be done in this case */
	    Tcl_InvalidateStringRep(listPtr);
	    return TCL_OK;
	}
    }

    if (changed) {
	Tcl_InvalidateStringRep(listPtr);
    }

    /* To make the operation transactional, update "used" only after all
     * elemnts have been succesfully added.
    */
    newListRepPtr->used = newused;
    return TCL_OK;
}


static int ListIntegerListObjSetDeep(
    TCL_UNUSED(Tcl_Interp *),	    /* Tcl interpreter. */ \
    TCL_UNUSED(Tcl_Obj *),	    /* Pointer to the list being modified. */ \
    TCL_UNUSED(Tcl_Size),    /* Number of index args. */ \
    TCL_UNUSED(Tcl_Obj *const *),    /* Index args. */ \
    TCL_UNUSED(Tcl_Obj *),/* Value arg to 'lset' or NULL to 'lpop'. */
    Tcl_Obj **resPtrPtr)
{
    *resPtrPtr = NULL;
    return TCL_ERROR;
}


static int ListIntegerLset(
    TCL_UNUSED(Tcl_Interp *),
    TCL_UNUSED(Tcl_Obj *),
    TCL_UNUSED(Tcl_Size),
    TCL_UNUSED(Tcl_Obj *))
{
    return TCL_ERROR;
}


static int ErrorMaxElementsExceeded(Tcl_Interp *interp) {
    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "max length of a Tcl list (%" TCL_T_MODIFIER "d elements) exceeded",
	    LIST_MAX));
    }
    return TCL_ERROR;
}
Changes to generic/tclTestProcBodyObj.c.
















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
-
-







/*
 * Copyright © 1998 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclTestProcBodyObj.c --
 *
 *	Implements the "procbodytest" package, which contains commands to test
 *	creation of Tcl procedures whose body argument is a Tcl_Obj of type
 *	"procbody" rather than a string.
 *
 * Copyright © 1998 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef BUILD_tcl
#undef STATIC_BUILD
#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
Changes to generic/tclThread.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
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

-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+












-
-
-
+
+
+







/*
 * tclThread.c --
 *
 *	This file implements Platform independent thread operations. Most of
 *	the real work is done in the platform dependent files.
 *
 * Copyright © 1998 Sun Microsystems, Inc.
 * Copyright © 2008 George Peter Staplin
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclThread.c --
 *
 *	This file implements Platform independent thread operations. Most of
 *	the real work is done in the platform dependent files.
 */

#include "tclInt.h"

/*
 * There are three classes of synchronization objects: mutexes, thread data
 * keys, and condition variables. The following are used to record the memory
 * used for these objects so they can be finalized.
 *
 * These statics are guarded by the mutex in the caller of
 * TclRememberThreadData, e.g., TclpThreadDataKeyInit
 */

typedef struct {
    int num;		/* Number of objects remembered */
    int max;		/* Max size of the array */
    void **list;	/* List of pointers */
    int num;			/* Number of objects remembered */
    int max;			/* Max size of the array */
    void **list;		/* List of pointers */
} SyncObjRecord;

static SyncObjRecord keyRecord = {0, 0, NULL};
static SyncObjRecord mutexRecord = {0, 0, NULL};
static SyncObjRecord condRecord = {0, 0, NULL};

/*
Changes to generic/tclThreadAlloc.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14

















15
16
17
18
19
20
21
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

-
-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclThreadAlloc.c --
 *
 *	This is a very fast storage allocator for used with threads (designed
 *	avoid lock contention). The basic strategy is to allocate memory in
 *	fixed size blocks from block caches.
 *
 * The Initial Developer of the Original Code is America Online, Inc.
 * Portions created by AOL are Copyright © 1999 America Online, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclThreadAlloc.c --
 *
 *	This is a very fast storage allocator for used with threads (designed
 *	avoid lock contention). The basic strategy is to allocate memory in
 *	fixed size blocks from block caches.
 */

#include "tclInt.h"
#if TCL_THREADS && defined(USE_THREAD_ALLOC)

/*
 * If range checking is enabled, an additional byte will be allocated to store
 * the magic number at the end of the requested memory.
 */
88
89
90
91
92
93
94
95

96
97
98
99
100
101
102
99
100
101
102
103
104
105

106
107
108
109
110
111
112
113







-
+







    size_t numFree;		/* Number of blocks available */

    /* All fields below for accounting only */

    size_t numRemoves;		/* Number of removes from bucket */
    size_t numInserts;		/* Number of inserts into bucket */
    size_t numLocks;		/* Number of locks acquired */
    size_t totalAssigned;		/* Total space assigned to bucket */
    size_t totalAssigned;	/* Total space assigned to bucket */
} Bucket;

/*
 * The following structure defines a cache of buckets and objs, of which there
 * will be (at most) one per thread. Any changes need to be reflected in the
 * struct AllocCache defined in tclInt.h, possibly also in the initialisation
 * code in Tcl_CreateInterp().
116
117
118
119
120
121
122
123

124
125
126
127
128
129
130
127
128
129
130
131
132
133

134
135
136
137
138
139
140
141







-
+







 * The following array specifies various per-bucket limits and locks. The
 * values are statically initialized to avoid calculating them repeatedly.
 */

static struct {
    size_t blockSize;		/* Bucket blocksize. */
    size_t maxBlocks;		/* Max blocks before move to share. */
    size_t numMove;			/* Num blocks to move to share. */
    size_t numMove;		/* Num blocks to move to share. */
    Tcl_Mutex *lockPtr;		/* Share bucket lock. */
} bucketInfo[NBUCKETS];

/*
 * Static functions defined in this file.
 */

1031
1032
1033
1034
1035
1036
1037
1038

1039
1040
1041
1042
1043
1044
1045
1042
1043
1044
1045
1046
1047
1048

1049
1050
1051
1052
1053
1054
1055
1056







-
+








/*
 *----------------------------------------------------------------------
 *
 * TclInitThreadAlloc --
 *
 *	Initializes the allocator cache-maintenance structures.
 *      It is done early and protected during the Tcl_InitSubsystems().
 *	It is done early and protected during the Tcl_InitSubsystems().
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
Changes to generic/tclThreadJoin.c.
















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-







/*
 * Copyright © 2000 Scriptics Corporation
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclThreadJoin.c --
 *
 *	This file implements a platform independent emulation layer for the
 *	handling of joinable threads. The Windows platform uses this code to
 *	provide the functionality of joining threads.  This code is currently
 *	not necessary on Unix.
 *
 * Copyright © 2000 Scriptics Corporation
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#ifdef _WIN32

/*
Changes to generic/tclThreadStorage.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
















14
15
16
17
18
19
20
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

-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclThreadStorage.c --
 *
 *	This file implements platform independent thread storage operations to
 *	work around system limits on the number of thread-specific variables.
 *
 * Copyright © 2003-2004 Joe Mistachkin
 * Copyright © 2008 George Peter Staplin
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclThreadStorage.c --
 *
 *	This file implements platform independent thread storage operations to
 *	work around system limits on the number of thread-specific variables.
 */

#include "tclInt.h"

#if TCL_THREADS
#include <signal.h>

/*
 * IMPLEMENTATION NOTES:
44
45
46
47
48
49
50
51

52
53
54
55
56
57
58
55
56
57
58
59
60
61

62
63
64
65
66
67
68
69







-
+







} tsdGlobal = { NULL, 0, NULL };

/*
 * The type of the data held per thread in a system TSD.
 */

typedef struct {
    void **tablePtr;	/* The table of Tcl TSDs. */
    void **tablePtr;		/* The table of Tcl TSDs. */
    sig_atomic_t allocated;	/* The size of the table in the current
				 * thread. */
} TSDTable;

/*
 * The actual type of Tcl_ThreadDataKey.
 */
Changes to generic/tclThreadTest.c.

















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-
-







/*
 * Copyright © 1998 Sun Microsystems, Inc.
 * Copyright © 2006-2008 Joe Mistachkin.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclThreadTest.c --
 *
 *	This file implements the testthread command. Eventually this should be
 *	tclThreadCmd.c
 *	Some of this code is based on work done by Richard Hipp on behalf of
 *	Conservation Through Innovation, Limited, with their permission.
 *
 * Copyright © 1998 Sun Microsystems, Inc.
 * Copyright © 2006-2008 Joe Mistachkin.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef BUILD_tcl
#undef STATIC_BUILD
#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
Changes to generic/tclTimer.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
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+











-
+







/*
 * tclTimer.c --
 *
 *	This file provides timer event management facilities for Tcl,
 *	including the "after" command.
 *
 * Copyright © 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclTimer.c --
 *
 *	This file provides timer event management facilities for Tcl,
 *	including the "after" command.
 */

#include "tclInt.h"

/*
 * For each timer callback that's pending there is one record of the following
 * type. The normal handlers (created by Tcl_CreateTimerHandler) are chained
 * together in a list sorted by time (earliest event first).
 */

typedef struct TimerHandler {
    Tcl_Time time;		/* When timer is to fire. */
    Tcl_TimerProc *proc;	/* Function to call. */
    void *clientData;	/* Argument to pass to proc. */
    void *clientData;		/* Argument to pass to proc. */
    Tcl_TimerToken token;	/* Identifies handler so it can be deleted. */
    struct TimerHandler *nextPtr;
				/* Next event in queue, or NULL for end of
				 * queue. */
} TimerHandler;

/*
69
70
71
72
73
74
75
76

77
78
79
80
81
82
83
80
81
82
83
84
85
86

87
88
89
90
91
92
93
94







-
+







 * There is one of the following structures for each of the handlers declared
 * in a call to Tcl_DoWhenIdle. All of the currently-active handlers are
 * linked together into a list.
 */

typedef struct IdleHandler {
    Tcl_IdleProc *proc;		/* Function to call. */
    void *clientData;	/* Value to pass to proc. */
    void *clientData;		/* Value to pass to proc. */
    int generation;		/* Used to distinguish older handlers from
				 * recently-created ones. */
    struct IdleHandler *nextPtr;/* Next in list of active handlers. */
} IdleHandler;

/*
 * The timer and idle queues are per-thread because they are associated with
247
248
249
250
251
252
253
254

255
256
257
258
259
260
261
258
259
260
261
262
263
264

265
266
267
268
269
270
271
272







-
+







 */

Tcl_TimerToken
Tcl_CreateTimerHandler(
    int milliseconds,		/* How many milliseconds to wait before
				 * invoking proc. */
    Tcl_TimerProc *proc,	/* Function to invoke. */
    void *clientData)	/* Arbitrary data to pass to proc. */
    void *clientData)		/* Arbitrary data to pass to proc. */
{
    Tcl_Time time;

    /*
     * Compute when the event should fire.
     */

615
616
617
618
619
620
621
622

623
624
625
626
627
628
629
626
627
628
629
630
631
632

633
634
635
636
637
638
639
640







-
+







 *
 *--------------------------------------------------------------
 */

void
Tcl_DoWhenIdle(
    Tcl_IdleProc *proc,		/* Function to invoke. */
    void *clientData)	/* Arbitrary value to pass to proc. */
    void *clientData)		/* Arbitrary value to pass to proc. */
{
    IdleHandler *idlePtr;
    Tcl_Time blockTime;
    ThreadSpecificData *tsdPtr = InitTimer();

    idlePtr = (IdleHandler *)Tcl_Alloc(sizeof(IdleHandler));
    idlePtr->proc = proc;
659
660
661
662
663
664
665
666

667
668
669
670
671
672
673
670
671
672
673
674
675
676

677
678
679
680
681
682
683
684







-
+







 *
 *----------------------------------------------------------------------
 */

void
Tcl_CancelIdleCall(
    Tcl_IdleProc *proc,		/* Function that was previously registered. */
    void *clientData)	/* Arbitrary value to pass to proc. */
    void *clientData)		/* Arbitrary value to pass to proc. */
{
    IdleHandler *idlePtr, *prevPtr;
    IdleHandler *nextPtr;
    ThreadSpecificData *tsdPtr = InitTimer();

    for (prevPtr = NULL, idlePtr = tsdPtr->idleList; idlePtr != NULL;
	    prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) {
889
890
891
892
893
894
895
896

897
898
899

900
901
902
903
904
905
906
900
901
902
903
904
905
906

907
908
909

910
911
912
913
914
915
916
917







-
+


-
+







	    return TCL_ERROR;
	}
	if (objc == 3) {
	    commandPtr = objv[2];
	} else {
	    commandPtr = Tcl_ConcatObj(objc-2, objv+2);
	}
	command = TclGetStringFromObj(commandPtr, &length);
	command = Tcl_GetStringFromObj(commandPtr, &length);
	for (afterPtr = assocPtr->firstAfterPtr;  afterPtr != NULL;
		afterPtr = afterPtr->nextPtr) {
	    tempCommand = TclGetStringFromObj(afterPtr->commandPtr,
	    tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr,
		    &tempLength);
	    if ((length == tempLength)
		    && !memcmp(command, tempCommand, length)) {
		break;
	    }
	}
	if (afterPtr == NULL) {
961
962
963
964
965
966
967
968

969
970
971
972
973
974
975
972
973
974
975
976
977
978

979
980
981
982
983
984
985
986







-
+







	}
	afterPtr = GetAfterEvent(assocPtr, objv[2]);
	if (afterPtr == NULL) {
	    const char *eventStr = TclGetString(objv[2]);

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "event \"%s\" doesn't exist", eventStr));
	    Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, (void *)NULL);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "EVENT", eventStr, (void *)NULL);
	    return TCL_ERROR;
	} else {
	    Tcl_Obj *resultListPtr;

	    TclNewObj(resultListPtr);
	    Tcl_ListObjAppendElement(interp, resultListPtr,
		    afterPtr->commandPtr);
1145
1146
1147
1148
1149
1150
1151
1152

1153
1154
1155
1156
1157
1158
1159
1156
1157
1158
1159
1160
1161
1162

1163
1164
1165
1166
1167
1168
1169
1170







-
+







 *	bgerror fails then information about the error is output on stderr.
 *
 *----------------------------------------------------------------------
 */

static void
AfterProc(
    void *clientData)	/* Describes command to execute. */
    void *clientData)		/* Describes command to execute. */
{
    AfterInfo *afterPtr = (AfterInfo *)clientData;
    AfterAssocData *assocPtr = afterPtr->assocPtr;
    AfterInfo *prevPtr;
    int result;
    Tcl_Interp *interp;

1210
1211
1212
1213
1214
1215
1216
1217

1218
1219
1220
1221
1222
1223
1224
1221
1222
1223
1224
1225
1226
1227

1228
1229
1230
1231
1232
1233
1234
1235







-
+







 *	The memory associated with afterPtr is released.
 *
 *----------------------------------------------------------------------
 */

static void
FreeAfterPtr(
    AfterInfo *afterPtr)		/* Command to be deleted. */
    AfterInfo *afterPtr)	/* Command to be deleted. */
{
    AfterInfo *prevPtr;
    AfterAssocData *assocPtr = afterPtr->assocPtr;

    if (assocPtr->firstAfterPtr == afterPtr) {
	assocPtr->firstAfterPtr = afterPtr->nextPtr;
    } else {
1247
1248
1249
1250
1251
1252
1253
1254

1255
1256
1257
1258
1259
1260
1261
1258
1259
1260
1261
1262
1263
1264

1265
1266
1267
1268
1269
1270
1271
1272







-
+







 *	After commands are removed.
 *
 *----------------------------------------------------------------------
 */

static void
AfterCleanupProc(
    void *clientData,	/* Points to AfterAssocData for the
    void *clientData,		/* Points to AfterAssocData for the
				 * interpreter. */
    TCL_UNUSED(Tcl_Interp *))
{
    AfterAssocData *assocPtr = (AfterAssocData *)clientData;
    AfterInfo *afterPtr;

    while (assocPtr->firstAfterPtr != NULL) {
Changes to generic/tclTomMath.decls.












1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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
+
+
+
+
+
+
+
+
+
+
+
+









-
-
-
-







# Copyright © 2005 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.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# tclTomMath.decls --
#
#	This file contains the declarations for the functions in 'libtommath'
#	that are contained within the Tcl library.  This file is used to
#	generate the 'tclTomMathDecls.h' and 'tclStubInit.c' files.
#
# If you edit this file, advance the revision number (and the epoch
# if the new stubs are not backward compatible) in tclTomMathDecls.h
#
# Copyright © 2005 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.

library tcl

# Define the unsupported generic interfaces.

interface tclTomMath
scspec EXTERN
69
70
71
72
73
74
75




76
77
78
79
80
81
82
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94







+
+
+
+







}
declare 15 {
    mp_err MP_WUR TclBN_mp_div_2(const mp_int *a, mp_int *q)
}
declare 16 {
    mp_err MP_WUR TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q, mp_int *r)
}
# Removed in 9.0
#declare 17 {
#    mp_err TclBN_mp_div_3(const mp_int *a, mp_int *q, mp_digit *r)
#}
declare 18 {
    void TclBN_mp_exch(mp_int *a, mp_int *b)
}
declare 19 {
    mp_err MP_WUR TclBN_mp_expt_n(const mp_int *a, int b, mp_int *c)
}
declare 20 {
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
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







+
+
+
+
+
+
+
+









+
+
+
+
+
+
+
+
+
+
+
+
+









+
+
+
+
+
+
+
+



+
+
+
+







+
+
+
+
+


















+
+
+
+
+
+
+
+
+
+
+
+
+











+
+
+
+








}
declare 37 {
    void TclBN_mp_rshd(mp_int *a, int shift)
}
declare 38 {
    mp_err MP_WUR TclBN_mp_shrink(mp_int *a)
}
# Removed in 9.0
#declare 39 {
#    void TclBN_mp_set(mp_int *a, unsigned int b)
#}
# Removed in 9.0
#declare 40 {nostub {is private function in libtommath}} {
#    mp_err TclBN_mp_sqr(const mp_int *a, mp_int *b)
#}
declare 41 {
    mp_err MP_WUR TclBN_mp_sqrt(const mp_int *a, mp_int *b)
}
declare 42 {
    mp_err MP_WUR TclBN_mp_sub(const mp_int *a, const mp_int *b, mp_int *c)
}
declare 43 {
    mp_err MP_WUR TclBN_mp_sub_d(const mp_int *a, mp_digit b, mp_int *c)
}
# Removed in 9.0
#declare 44 {
#    mp_err TclBN_mp_to_unsigned_bin(const mp_int *a, unsigned char *b)
#}
# Removed in 9.0
#declare 45 {
#    mp_err TclBN_mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b,
#	    unsigned long *outlen)
#}
# Removed in 9.0
#declare 46 {
#    mp_err TclBN_mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen)
#}
declare 47 {
    size_t MP_WUR TclBN_mp_ubin_size(const mp_int *a)
}
declare 48 {
    mp_err MP_WUR TclBN_mp_xor(const mp_int *a, const mp_int *b, mp_int *c)
}
declare 49 {
    void TclBN_mp_zero(mp_int *a)
}
# Removed in 9.0
#declare 61 {
#    mp_err TclBN_mp_init_ul(mp_int *a, unsigned long i)
#}
# Removed in 9.0
#declare 62 {
#    void TclBN_mp_set_ul(mp_int *a, unsigned long i)
#}
declare 63 {
    int MP_WUR TclBN_mp_cnt_lsb(const mp_int *a)
}
# Removed in 9.0
#declare 64 {
#    int TclBN_mp_init_l(mp_int *bignum, long initVal)
#}
declare 65 {
    int MP_WUR TclBN_mp_init_i64(mp_int *bignum, int64_t initVal)
}
declare 66 {
    int MP_WUR TclBN_mp_init_u64(mp_int *bignum, uint64_t initVal)
}

# Removed in 9.0
#declare 67 {
#    mp_err TclBN_mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast)
#}
# Added in libtommath 1.0.1
declare 68 {
    void TclBN_mp_set_u64(mp_int *a, uint64_t i)
}
declare 69 {
    uint64_t MP_WUR TclBN_mp_get_mag_u64(const mp_int *a)
}
declare 70 {
    void TclBN_mp_set_i64(mp_int *a, int64_t i)
}
declare 71 {
    mp_err MP_WUR TclBN_mp_unpack(mp_int *rop, size_t count, mp_order order, size_t size,
	    mp_endian endian, size_t nails, const void *op)
}
declare 72 {
    mp_err MP_WUR TclBN_mp_pack(void *rop, size_t maxcount, size_t *written, mp_order order,
	    size_t size, mp_endian endian, size_t nails, const mp_int *op)
}

# Added in libtommath 1.1.0
# No longer in use: replaced by mp_and()
#declare 73 {
#    int TclBN_mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c)
#}
# No longer in use: replaced by mp_or()
#declare 74 {
#    int TclBN_mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c)
#}
# No longer in use: replaced by mp_xor()
#declare 75 {
#    int TclBN_mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c)
#}
declare 76 {
    mp_err MP_WUR TclBN_mp_signed_rsh(const mp_int *a, int b, mp_int *c)
}
declare 77 {
    size_t MP_WUR TclBN_mp_pack_count(const mp_int *a, size_t nails, size_t size)
}

# Added in libtommath 1.2.0
declare 78 {
    int MP_WUR TclBN_mp_to_ubin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written)
}
# Removed in 9.0
#declare 79 {
#    mp_err MP_WUR TclBN_mp_div_ld(const mp_int *a, mp_digit b, mp_int *q, mp_digit *r)
#}
declare 80 {
    int MP_WUR TclBN_mp_to_radix(const mp_int *a, char *str, size_t maxlen, size_t *written, int radix)
}


# Local Variables:
# mode: tcl
# End:
Changes to generic/tclTomMath.h.









1
2
3
4
5
6
7
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
+
+
+
+
+
+
+
+
+







/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

#ifndef BN_TCL_H_
#define BN_TCL_H_

#include <stdint.h>
#if defined(TCL_NO_TOMMATH_H)
    typedef size_t mp_digit;
    typedef int mp_sign;
Changes to generic/tclTomMathDecls.h.
















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-







/*
 * Copyright (c) 2005 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 *----------------------------------------------------------------------
 *
 * tclTomMathDecls.h --
 *
 *	This file contains the declarations for the 'libtommath'
 *	functions that are exported by the Tcl library.
 *
 * Copyright (c) 2005 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.
 */

#ifndef _TCLTOMMATHDECLS
#define _TCLTOMMATHDECLS

#include "tcl.h"
#include <string.h>
Changes to generic/tclTomMathInt.h.








1
2
3
1
2
3
4
5
6
7
8
9
10
11
+
+
+
+
+
+
+
+



/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
#include "tclTomMath.h"
#include "tommath_class.h"
Changes to generic/tclTomMathInterface.c.
















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-







/*
 * Copyright © 2005 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 *----------------------------------------------------------------------
 *
 * tclTomMathInterface.c --
 *
 *	This file contains procedures that are used as a 'glue' layer between
 *	Tcl and libtommath.
 *
 * Copyright © 2005 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"
#include "tclTomMath.h"

MODULE_SCOPE const TclTomMathStubs tclTomMathStubs;

Changes to generic/tclTomMathStubLib.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
















14
15
16
17
18
19
20
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

-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclTomMathStubLib.c --
 *
 *	Stub object that will be statically linked into extensions that want
 *	to access Tcl.
 *
 * Copyright © 1998-1999 Scriptics Corporation.
 * Copyright © 1998 Paul Duffin.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclTomMathStubLib.c --
 *
 *	Stub object that will be statically linked into extensions that want
 *	to access Tcl.
 */

#include "tclInt.h"
#include "tclTomMath.h"

MODULE_SCOPE const TclTomMathStubs *tclTomMathStubsPtr;

const TclTomMathStubs *tclTomMathStubsPtr = NULL;

Changes to generic/tclTrace.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
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

-
-
-
-









+
+
+
+
+
+
+
+
+
+
+
+
+
+
+










-
+







/*
 * tclTrace.c --
 *
 *	This file contains code to handle most trace management.
 *
 * Copyright © 1987-1993 The Regents of the University of California.
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 * Copyright © 1998-2000 Scriptics Corporation.
 * Copyright © 2002 ActiveState Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclTrace.c --
 *
 *	This file contains code to handle most trace management.
 */

#include "tclInt.h"

/*
 * Structures used to hold information about variable traces:
 */

typedef struct {
    int flags;			/* Operations for which Tcl command is to be
				 * invoked. */
    Tcl_Size length;		/* Number of non-NUL chars. in command. */
    char command[TCLFLEXARRAY];		/* Space for Tcl command to invoke. Actual
    char command[TCLFLEXARRAY];	/* Space for Tcl command to invoke. Actual
				 * size will be as large as necessary to hold
				 * command. This field must be the last in the
				 * structure, so that it can be larger than 1
				 * byte. */
} TraceVarInfo;

typedef struct {
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
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







-
+











-
+








typedef struct {
    int flags;			/* Operations for which Tcl command is to be
				 * invoked. */
    Tcl_Size length;		/* Number of non-NUL chars. in command. */
    Tcl_Trace stepTrace;	/* Used for execution traces, when tracing
				 * inside the given command */
    Tcl_Size startLevel;		/* Used for bookkeeping with step execution
    Tcl_Size startLevel;	/* Used for bookkeeping with step execution
				 * traces, store the level at which the step
				 * trace was invoked */
    char *startCmd;		/* Used for bookkeeping with step execution
				 * traces, store the command name which
				 * invoked step trace */
    int curFlags;		/* Trace flags for the current command */
    int curCode;		/* Return code for the current command */
    size_t refCount;		/* Used to ensure this structure is not
				 * deleted too early. Keeps track of how many
				 * pieces of code have a pointer to this
				 * structure. */
    char command[TCLFLEXARRAY];		/* Space for Tcl command to invoke. Actual
    char command[TCLFLEXARRAY];	/* Space for Tcl command to invoke. Actual
				 * size will be as large as necessary to hold
				 * command. This field must be the last in the
				 * structure, so that it can be larger than 1
				 * byte. */
} TraceCommandInfo;

/*
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
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







-
+









-
-
+
+



-
-
+
+








/*
 * The following structure holds the client data for string-based
 * trace procs
 */

typedef struct {
    void *clientData;	/* Client data from Tcl_CreateTrace */
    void *clientData;		/* Client data from Tcl_CreateTrace */
    Tcl_CmdTraceProc *proc;	/* Trace function from Tcl_CreateTrace */
} StringTraceData;

/*
 * Convenience macros for iterating over the list of traces. Note that each of
 * these *must* be treated as a command, and *must* have a block following it.
 */

#define FOREACH_VAR_TRACE(interp, name, clientData) \
    (clientData) = NULL; \
    while (((clientData) = Tcl_VarTraceInfo2((interp), (name), NULL, \
    (clientData) = NULL;						\
    while (((clientData) = Tcl_VarTraceInfo2((interp), (name), NULL,	\
	    0, TraceVarProc, (clientData))) != NULL)

#define FOREACH_COMMAND_TRACE(interp, name, clientData) \
    (clientData) = NULL; \
    while (((clientData) = Tcl_CommandTraceInfo((interp), (name), 0, \
    (clientData) = NULL;						\
    while (((clientData) = Tcl_CommandTraceInfo((interp), (name), 0,	\
	    TraceCommandProc, (clientData))) != NULL)

/*
 *----------------------------------------------------------------------
 *
 * Tcl_TraceObjCmd --
 *
275
276
277
278
279
280
281
282
283



284
285
286
287
288
289
290
286
287
288
289
290
291
292


293
294
295
296
297
298
299
300
301
302







-
-
+
+
+







 *
 *----------------------------------------------------------------------
 */

static int
TraceExecutionObjCmd(
    Tcl_Interp *interp,		/* Current interpreter. */
    enum traceOptionsEnum optionIndex,		/* Add, info or remove */
    Tcl_Size objc,			/* Number of arguments. */
    enum traceOptionsEnum optionIndex,
				/* Add, info or remove */
    Tcl_Size objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *name, *command;
    Tcl_Size length;
    static const char *const opStrings[] = {
	"enter", "leave", "enterstep", "leavestep", NULL
    };
342
343
344
345
346
347
348
349

350
351
352
353
354
355
356
354
355
356
357
358
359
360

361
362
363
364
365
366
367
368







-
+







		flags |= TCL_TRACE_ENTER_DURING_EXEC;
		break;
	    case TRACE_EXEC_LEAVE_STEP:
		flags |= TCL_TRACE_LEAVE_DURING_EXEC;
		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &length);
	command = Tcl_GetStringFromObj(objv[5], &length);
	if (optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)Tcl_Alloc(
		    offsetof(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;
379
380
381
382
383
384
385
386

387
388
389
390
391
392
393
391
392
393
394
395
396
397

398
399
400
401
402
403
404
405







-
+







	    void *clientData;

	    /*
	     * First ensure the name given is valid.
	     */

	    name = TclGetString(objv[3]);
	    if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {
	    if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
		return TCL_ERROR;
	    }

	    FOREACH_COMMAND_TRACE(interp, name, clientData) {
		TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;

		/*
522
523
524
525
526
527
528
529
530



531
532
533
534
535
536
537
534
535
536
537
538
539
540


541
542
543
544
545
546
547
548
549
550







-
-
+
+
+







 *
 *----------------------------------------------------------------------
 */

static int
TraceCommandObjCmd(
    Tcl_Interp *interp,		/* Current interpreter. */
    enum traceOptionsEnum optionIndex,		/* Add, info or remove */
    Tcl_Size objc,			/* Number of arguments. */
    enum traceOptionsEnum optionIndex,
				/* Add, info or remove */
    Tcl_Size objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *name, *command;
    Tcl_Size length;
    static const char *const opStrings[] = { "delete", "rename", NULL };
    enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME } index;

579
580
581
582
583
584
585
586

587
588
589
590
591
592
593
592
593
594
595
596
597
598

599
600
601
602
603
604
605
606







-
+







		break;
	    case TRACE_CMD_DELETE:
		flags |= TCL_TRACE_DELETE;
		break;
	    }
	}

	command = TclGetStringFromObj(objv[5], &length);
	command = Tcl_GetStringFromObj(objv[5], &length);
	if (optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)Tcl_Alloc(
		    offsetof(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;
612
613
614
615
616
617
618
619

620
621
622
623
624
625
626
625
626
627
628
629
630
631

632
633
634
635
636
637
638
639







-
+







	    void *clientData;

	    /*
	     * First ensure the name given is valid.
	     */

	    name = TclGetString(objv[3]);
	    if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {
	    if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
		return TCL_ERROR;
	    }

	    FOREACH_COMMAND_TRACE(interp, name, clientData) {
		TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;

		if ((tcmdPtr->length == length) && (tcmdPtr->flags == flags)
716
717
718
719
720
721
722
723
724



725
726
727
728
729
730
731
729
730
731
732
733
734
735


736
737
738
739
740
741
742
743
744
745







-
-
+
+
+







 *
 *----------------------------------------------------------------------
 */

static int
TraceVariableObjCmd(
    Tcl_Interp *interp,		/* Current interpreter. */
    enum traceOptionsEnum optionIndex,		/* Add, info or remove */
    Tcl_Size objc,			/* Number of arguments. */
    enum traceOptionsEnum optionIndex,
				/* Add, info or remove */
    Tcl_Size objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *name, *command;
    Tcl_Size length;
    void *clientData;
    static const char *const opStrings[] = {
	"array", "read", "unset", "write", NULL
783
784
785
786
787
788
789
790

791
792
793
794
795
796
797
797
798
799
800
801
802
803

804
805
806
807
808
809
810
811







-
+







		flags |= TCL_TRACE_UNSETS;
		break;
	    case TRACE_VAR_WRITE:
		flags |= TCL_TRACE_WRITES;
		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &length);
	command = Tcl_GetStringFromObj(objv[5], &length);
	if (optionIndex == TRACE_ADD) {
	    CombinedTraceVarInfo *ctvarPtr = (CombinedTraceVarInfo *)Tcl_Alloc(
		    offsetof(CombinedTraceVarInfo, traceCmdInfo.command)
		    + 1 + length);

	    ctvarPtr->traceCmdInfo.flags = flags;
	    ctvarPtr->traceCmdInfo.length = length;
977
978
979
980
981
982
983
984

985
986
987
988
989
990
991
991
992
993
994
995
996
997

998
999
1000
1001
1002
1003
1004
1005







-
+







				 * traced. */
    const char *cmdName,	/* Name of command. */
    int flags,			/* OR-ed collection of bits, including any of
				 * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any
				 * of the TRACE_*_EXEC flags */
    Tcl_CommandTraceProc *proc,	/* Function to call when specified ops are
				 * invoked upon cmdName. */
    void *clientData)	/* Arbitrary argument to pass to proc. */
    void *clientData)		/* Arbitrary argument to pass to proc. */
{
    Command *cmdPtr;
    CommandTrace *tracePtr;

    cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,
	    TCL_LEAVE_ERR_MSG);
    if (cmdPtr == NULL) {
1040
1041
1042
1043
1044
1045
1046
1047

1048
1049
1050
1051
1052
1053
1054
1054
1055
1056
1057
1058
1059
1060

1061
1062
1063
1064
1065
1066
1067
1068







-
+







Tcl_UntraceCommand(
    Tcl_Interp *interp,		/* Interpreter containing command. */
    const char *cmdName,	/* Name of command. */
    int flags,			/* OR-ed collection of bits, including any of
				 * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any
				 * of the TRACE_*_EXEC flags */
    Tcl_CommandTraceProc *proc,	/* Function assocated with trace. */
    void *clientData)	/* Arbitrary argument to pass to proc. */
    void *clientData)		/* Arbitrary argument to pass to proc. */
{
    CommandTrace *tracePtr;
    CommandTrace *prevPtr;
    Command *cmdPtr;
    Interp *iPtr = (Interp *)interp;
    ActiveCommandTrace *activePtr;
    int hasExecTraces = 0;
1145
1146
1147
1148
1149
1150
1151
1152

1153
1154
1155
1156
1157
1158
1159
1159
1160
1161
1162
1163
1164
1165

1166
1167
1168
1169
1170
1171
1172
1173







-
+







 *	Depends on the command associated with the trace.
 *
 *----------------------------------------------------------------------
 */

static void
TraceCommandProc(
    void *clientData,	/* Information about the command trace. */
    void *clientData,		/* Information about the command trace. */
    Tcl_Interp *interp,		/* Interpreter containing command. */
    const char *oldName,	/* Name of command being changed. */
    const char *newName,	/* New name of command. Empty string or NULL
				 * means command is being deleted (renamed to
				 * ""). */
    int flags)			/* OR-ed bits giving operation and other
				 * information. */
1290
1291
1292
1293
1294
1295
1296
1297

1298
1299
1300
1301
1302
1303
1304
1304
1305
1306
1307
1308
1309
1310

1311
1312
1313
1314
1315
1316
1317
1318







-
+







    Tcl_Interp *interp,		/* The current interpreter. */
    const char *command,	/* Pointer to beginning of the current command
				 * string. */
    TCL_UNUSED(Tcl_Size) /*numChars*/,
    Command *cmdPtr,		/* Points to command's Command struct. */
    int code,			/* The current result code. */
    int traceFlags,		/* Current tracing situation. */
    Tcl_Size objc,			/* Number of arguments for the command. */
    Tcl_Size objc,		/* Number of arguments for the command. */
    Tcl_Obj *const objv[])	/* Pointers to Tcl_Obj of each argument. */
{
    Interp *iPtr = (Interp *) interp;
    CommandTrace *tracePtr, *lastTracePtr;
    ActiveCommandTrace active;
    Tcl_Size curLevel;
    int traceCode = TCL_OK;
1396
1397
1398
1399
1400
1401
1402
1403

1404
1405
1406
1407
1408
1409
1410
1410
1411
1412
1413
1414
1415
1416

1417
1418
1419
1420
1421
1422
1423
1424







-
+







    const char *command,	/* Pointer to beginning of the current command
				 * string. */
    Tcl_Size numChars,		/* The number of characters in 'command' which
				 * are part of the command string. */
    Command *cmdPtr,		/* Points to command's Command struct. */
    int code,			/* The current result code. */
    int traceFlags,		/* Current tracing situation. */
    Tcl_Size objc,			/* Number of arguments for the command. */
    Tcl_Size objc,		/* Number of arguments for the command. */
    Tcl_Obj *const objv[])	/* Pointers to Tcl_Obj of each argument. */
{
    Interp *iPtr = (Interp *) interp;
    Trace *tracePtr, *lastTracePtr;
    ActiveInterpTrace active;
    Tcl_Size curLevel;
    int traceCode = TCL_OK;
1534
1535
1536
1537
1538
1539
1540
1541

1542
1543
1544
1545
1546
1547
1548
1548
1549
1550
1551
1552
1553
1554

1555
1556
1557
1558
1559
1560
1561
1562







-
+







 *
 *----------------------------------------------------------------------
 */

static int
CallTraceFunction(
    Tcl_Interp *interp,		/* The current interpreter. */
    Trace *tracePtr,	/* Describes the trace function to call. */
    Trace *tracePtr,		/* Describes the trace function to call. */
    Command *cmdPtr,		/* Points to command's Command struct. */
    const char *command,	/* Points to the first character of the
				 * command's source before substitutions. */
    Tcl_Size numChars,		/* The number of characters in the command's
				 * source. */
    Tcl_Size objc,		/* Number of arguments for the command. */
    Tcl_Obj *const objv[])	/* Pointers to Tcl_Obj of each argument. */
1829
1830
1831
1832
1833
1834
1835
1836

1837
1838
1839
1840
1841
1842
1843
1843
1844
1845
1846
1847
1848
1849

1850
1851
1852
1853
1854
1855
1856
1857







-
+







 *	Depends on the command associated with the trace.
 *
 *----------------------------------------------------------------------
 */

static char *
TraceVarProc(
    void *clientData,	/* Information about the variable trace. */
    void *clientData,		/* Information about the variable trace. */
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *name1,		/* Name of variable or array. */
    const char *name2,		/* Name of element within array; NULL means
				 * scalar variable is being referenced. */
    int flags)			/* OR-ed bits giving operation and other
				 * information. */
{
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
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







-
+


-
+















-
+


-
+







    }
    Tcl_Free(info);
}

Tcl_Trace
Tcl_CreateObjTrace(
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Size level,			/* Maximum nesting level */
    Tcl_Size level,		/* Maximum nesting level */
    int flags,			/* Flags, see above */
    Tcl_CmdObjTraceProc *proc,	/* Trace callback */
    void *clientData,	/* Client data for the callback */
    void *clientData,		/* Client data for the callback */
    Tcl_CmdObjTraceDeleteProc *delProc)
				/* Function to call when trace is deleted */
{
    TraceWrapperInfo *info = (TraceWrapperInfo *)Tcl_Alloc(sizeof(TraceWrapperInfo));
    info->proc = proc;
    info->delProc = delProc;
    info->clientData = clientData;
    return Tcl_CreateObjTrace2(interp, level, flags,
	    (proc ? traceWrapperProc : NULL),
	    info, traceWrapperDelProc);
}

Tcl_Trace
Tcl_CreateObjTrace2(
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Size level,			/* Maximum nesting level */
    Tcl_Size level,		/* Maximum nesting level */
    int flags,			/* Flags, see above */
    Tcl_CmdObjTraceProc2 *proc,	/* Trace callback */
    void *clientData,	/* Client data for the callback */
    void *clientData,		/* Client data for the callback */
    Tcl_CmdObjTraceDeleteProc *delProc)
				/* Function to call when trace is deleted */
{
    Trace *tracePtr;
    Interp *iPtr = (Interp *) interp;

    /*
2120
2121
2122
2123
2124
2125
2126
2127

2128
2129
2130
2131

2132
2133
2134
2135
2136
2137
2138
2134
2135
2136
2137
2138
2139
2140

2141
2142
2143
2144

2145
2146
2147
2148
2149
2150
2151
2152







-
+



-
+







 *
 *----------------------------------------------------------------------
 */

Tcl_Trace
Tcl_CreateTrace(
    Tcl_Interp *interp,		/* Interpreter in which to create trace. */
    Tcl_Size level,			/* Only call proc for commands at nesting
    Tcl_Size level,		/* Only call proc for commands at nesting
				 * level<=argument level (1=>top level). */
    Tcl_CmdTraceProc *proc,	/* Function to call before executing each
				 * command. */
    void *clientData)	/* Arbitrary value word to pass to proc. */
    void *clientData)		/* Arbitrary value word to pass to proc. */
{
    StringTraceData *data = (StringTraceData *)Tcl_Alloc(sizeof(StringTraceData));

    data->clientData = clientData;
    data->proc = proc;
    return Tcl_CreateObjTrace2(interp, level, 0, StringTraceProc,
	    data, StringTraceDeleteProc);
2430
2431
2432
2433
2434
2435
2436
2437

2438
2439
2440
2441
2442
2443
2444
2444
2445
2446
2447
2448
2449
2450

2451
2452
2453
2454
2455
2456
2457
2458







-
+







 *
 *----------------------------------------------------------------------
 */

int
TclObjCallVarTraces(
    Interp *iPtr,		/* Interpreter containing variable. */
    Var *arrayPtr,	/* Pointer to array variable that contains the
    Var *arrayPtr,		/* Pointer to array variable that contains the
				 * variable, or NULL if the variable isn't an
				 * element of an array. */
    Var *varPtr,		/* Variable whose traces are to be invoked. */
    Tcl_Obj *part1Ptr,
    Tcl_Obj *part2Ptr,		/* Variable's two-part name. */
    int flags,			/* Flags passed to trace functions: indicates
				 * what's happening to variable, plus maybe
2464
2465
2466
2467
2468
2469
2470
2471

2472
2473
2474
2475
2476
2477
2478
2478
2479
2480
2481
2482
2483
2484

2485
2486
2487
2488
2489
2490
2491
2492







-
+







    return TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags,
	    leaveErrMsg);
}

int
TclCallVarTraces(
    Interp *iPtr,		/* Interpreter containing variable. */
    Var *arrayPtr,	/* Pointer to array variable that contains the
    Var *arrayPtr,		/* Pointer to array variable that contains the
				 * variable, or NULL if the variable isn't an
				 * element of an array. */
    Var *varPtr,		/* Variable whose traces are to be invoked. */
    const char *part1,
    const char *part2,		/* Variable's two-part name. */
    int flags,			/* Flags passed to trace functions: indicates
				 * what's happening to variable, plus maybe
2687
2688
2689
2690
2691
2692
2693
2694

2695
2696
2697
2698
2699
2700
2701
2701
2702
2703
2704
2705
2706
2707

2708
2709
2710
2711
2712
2713
2714
2715







-
+







		TclVarErrMsg((Tcl_Interp *) iPtr, part1, element, verb, result);
	    }
	    iPtr->flags &= ~(ERR_ALREADY_LOGGED);
	    Tcl_DiscardInterpState(state);
	} else {
	    Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state);
	}
	DisposeTraceResult(disposeFlags,result);
	DisposeTraceResult(disposeFlags, result);
    } else if (state) {
	if (code == TCL_OK) {
	    code = Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state);
	} else {
	    Tcl_DiscardInterpState(state);
	}
    }
2772
2773
2774
2775
2776
2777
2778
2779

2780
2781
2782
2783
2784
2785
2786
2786
2787
2788
2789
2790
2791
2792

2793
2794
2795
2796
2797
2798
2799
2800







-
+







				 * trace applies to scalar variable or array
				 * as-a-whole. */
    int flags,			/* OR-ed collection of bits describing current
				 * trace, including any of TCL_TRACE_READS,
				 * TCL_TRACE_WRITES, TCL_TRACE_UNSETS,
				 * TCL_GLOBAL_ONLY, and TCL_NAMESPACE_ONLY. */
    Tcl_VarTraceProc *proc,	/* Function associated with trace. */
    void *clientData)	/* Arbitrary argument to pass to proc. */
    void *clientData)		/* Arbitrary argument to pass to proc. */
{
    VarTrace *tracePtr;
    VarTrace *prevPtr, *nextPtr;
    Var *varPtr, *arrayPtr;
    Interp *iPtr = (Interp *) interp;
    ActiveVarTrace *activePtr;
    int flagMask, allFlags = 0;
2975
2976
2977
2978
2979
2980
2981
2982

2983
2984
2985
2986
2987
2988
2989
2989
2990
2991
2992
2993
2994
2995

2996
2997
2998
2999
3000
3001
3002
3003







-
+







				 * as-a-whole. */
    int flags,			/* OR-ed collection of bits, including any of
				 * TCL_TRACE_READS, TCL_TRACE_WRITES,
				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and
				 * TCL_NAMESPACE_ONLY. */
    Tcl_VarTraceProc *proc,	/* Function to call when specified ops are
				 * invoked upon varName. */
    void *clientData)	/* Arbitrary argument to pass to proc. */
    void *clientData)		/* Arbitrary argument to pass to proc. */
{
    VarTrace *tracePtr;
    int result;

    tracePtr = (VarTrace *)Tcl_Alloc(sizeof(VarTrace));
    tracePtr->traceProc = proc;
    tracePtr->clientData = clientData;
Changes to generic/tclUniData.c.














1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-







/*
 * Copyright © 1998 Scriptics Corporation.
 * All rights reserved.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclUniData.c --
 *
 *	Declarations of Unicode character information tables.  This file is
 *	automatically generated by the tools/uniParse.tcl script.  Do not
 *	modify this file by hand.
 *
 * Copyright © 1998 Scriptics Corporation.
 * All rights reserved.
 */

/*
 * A 16-bit Unicode character is split into two parts in order to index
 * into the following tables.  The lower OFFSET_BITS comprise an offset
 * into a page of characters.  The upper bits comprise the page number.
 */
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
202
203
204
205
206
207
208

209
210
211
212
213
214
215







-







    9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
    9856, 9856, 9856, 9856, 9856, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 9888, 1344, 1344, 9920, 3296, 9952, 9984, 10016,
    1344, 1344, 10048, 10080, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 10112, 10144, 1344, 10176, 1344, 10208, 10240, 10272,
    10304, 10336, 10368, 1344, 1344, 1344, 10400, 10432, 64, 10464, 10496,
    10528, 4736, 10560, 10592
#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
    ,10624, 10656, 10688, 3296, 1344, 1344, 1344, 10720, 10752, 10784,
    10816, 10848, 10880, 10912, 8032, 10944, 3296, 3296, 3296, 3296, 9216,
    1344, 10976, 11008, 1344, 11040, 11072, 11104, 11136, 1344, 11168,
    3296, 11200, 11232, 11264, 1344, 11296, 11328, 11360, 11392, 1344,
    11424, 1344, 11456, 11488, 11520, 1344, 11552, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 7776, 4704, 11584, 11616, 11648, 3296,
    3296, 11680, 11712, 11744, 11776, 4736, 11808, 3296, 11840, 11872,
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
575
576
577
578
579
580
581

582
583
584
585
586
587
588







-







    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 15968
#endif /* TCL_UTF_MAX > 3 */
};

/*
 * The groupMap is indexed by combining the alternate page number with
 * the page offset and returns a group number that identifies a unique
 * set of character attributes.
 */
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1185
1186
1187
1188
1189
1190
1191

1192
1193
1194
1195
1196
1197
1198







-







    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 94, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 94, 94, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15,
    15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15,
    0, 0, 0, 4, 4, 7, 11, 14, 4, 4, 0, 14, 7, 7, 7, 7, 14, 14, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 14, 14, 0, 0
#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
    ,15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1688
1689
1690
1691
1692
1693
1694

1695
1696
1697
1698
1699
1700
1701







-







    14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15
#endif /* TCL_UTF_MAX > 3 */
};

/*
 * Each group represents a unique set of character attributes.  The attributes
 * are encoded into a 32-bit value as follows:
 *
 * Bits 0-4	Character category: see the constants listed below.
1729
1730
1731
1732
1733
1734
1735
1736
1737

1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1736
1737
1738
1739
1740
1741
1742


1743



1744
1745
1746
1747
1748
1749
1750







-
-
+
-
-
-







    2762882, -2759615, -2751679, -2760383, -2760127, -2768575, 1859714,
    -9044927, -10823615, -12158, -10830783, -10833599, -10832575,
    -10830015, -10817983, -10824127, -10818751, 237633, -12223, -10830527,
    -9058239, -10839743, -10895551, 237698, 9949314, 18, 17, 10305,
    10370, 10049, 10114, 8769, 8834
};

#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
#   define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= 0x323C0)
# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= 0x323C0)
#else
#   define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1F0000) != 0)
#endif

/*
 * The following constants are used to determine the category of a
 * Unicode character.
 */

enum {
1788
1789
1790
1791
1792
1793
1794
1795
1796

1797
1798
1799
1791
1792
1793
1794
1795
1796
1797


1798










-
-
+
-
-
-
#define GetDelta(info) ((info) >> 8)

/*
 * This macro extracts the information about a character from the
 * Unicode character tables.
 */

#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
#   define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0x1FFFFF) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
# define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0x1FFFFF) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
#else
#   define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0xFFFF) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
#endif
Changes to generic/tclUtf.c.
1
2
3
4
5
6
7
8
9
10
11















12
13
14
15
16
17
18
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

-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclUtf.c --
 *
 *	Routines for manipulating UTF-8 strings.
 *
 * Copyright © 1997-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclUtf.c --
 *
 *	Routines for manipulating UTF-8 strings.
 */

#include "tclInt.h"

/*
 * Include the static character classification tables and macros.
 */

#include "tclUniData.c"
128
129
130
131
132
133
134
135

136
137
138
139
140
141
142
139
140
141
142
143
144
145

146
147
148
149
150
151
152
153







-
+







 *
 *	Given a pointer to a two-byte prefix of a well-formed UTF-8 byte
 *	sequence (a lead byte followed by a trail byte) this routine
 *	examines those two bytes to determine whether the sequence is
 *	invalid in UTF-8.  This might be because it is an overlong
 *	encoding, or because it encodes something out of the proper range.
 *
 *	Given a pointer to the bytes \xF8 or \xFC , this routine will
 *	Given a pointer to the bytes \xF8 or \xFC, this routine will
 *	try to read beyond the end of the "bounds" table.  Callers must
 *	prevent this.
 *
 *	Given a pointer to something else (an ASCII byte, a trail byte,
 *	or another byte	that can never begin a valid byte sequence such
 *	as \xF5) this routine returns false.  That makes the routine poorly
 *	named, as it does not detect and report all invalid sequences.
157
158
159
160
161
162
163
164


165
166
167
168
169
170
171
168
169
170
171
172
173
174

175
176
177
178
179
180
181
182
183







-
+
+







    0x80, 0xBF, 0x80, 0xBF, 0x80, 0xBF, /* (\xE4 - \xEC) -- all valid */
    0x90, 0xBF,	/* \xF0\x80 through \xF0\x8F are invalid prefixes */
    0x80, 0x8F  /* \xF4\x90 and higher are invalid prefixes */
};

static int
Invalid(
    const char *src)	/* Points to lead byte of a UTF-8 byte sequence */
    const char *src)		/* Points to lead byte of a UTF-8 byte
				 * sequence. */
{
    unsigned char byte = UCHAR(*src);
    int index;

    if ((byte & 0xC3) == 0xC0) {
	/* Only lead bytes 0xC0, 0xE0, 0xF0, 0xF4 need examination */
	index = (byte - 0xC0) >> 1;
224
225
226
227
228
229
230

231
232



233
234
235
236
237
238
239
236
237
238
239
240
241
242
243


244
245
246
247
248
249
250
251
252
253







+
-
-
+
+
+







    if (ch >= 0) {
	if (ch <= 0x7FF) {
	    buf[1] = (char) (0x80 | (0x3F & ch));
	    buf[0] = (char) (0xC0 | (ch >> 6));
	    return 2;
	}
	if (ch <= 0xFFFF) {
	    if (
	    if ((flags & TCL_COMBINE) &&
		    ((ch & 0xF800) == 0xD800)) {
		(flags & TCL_COMBINE) &&
		((ch & 0xF800) == 0xD800)) {

		if (ch & 0x0400) {
		    /* Low surrogate */
		    if (    (0x80 == (0xC0 & buf[0]))
			    && (0 == (0xCF & buf[1]))) {
			/* Previous Tcl_UniChar was a high surrogate, so combine */
			buf[2]  = (char) (0x80 | (0x3F & ch));
			buf[1] |= (char) (0x80 | (0x0F & (ch >> 6)));
494
495
496
497
498
499
500

501

502
503
504
505
506
507
508
508
509
510
511
512
513
514
515

516
517
518
519
520
521
522
523







+
-
+







	}

	/*
	 * A three-byte-character lead-byte not followed by two trail-bytes
	 * represents itself.
	 */
    } else if (byte < 0xF5) {
	if (((src[1] & 0xC0) == 0x80)
	if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) {
		&& ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) {
	    /*
	     * Four-byte-character lead byte followed by three trail bytes.
	     */
	    *chPtr = (((byte & 0x07) << 18) | ((src[1] & 0x3F) << 12)
		    | ((src[2] & 0x3F) << 6) | (src[3] & 0x3F));
	    if ((unsigned)(*chPtr - 0x10000) <= 0xFFFFF) {
		return 4;
517
518
519
520
521
522
523
524
525
526




527
528
529
530
531
532
533
532
533
534
535
536
537
538



539
540
541
542
543
544
545
546
547
548
549







-
-
-
+
+
+
+








    *chPtr = byte;
    return 1;
}

Tcl_Size
Tcl_UtfToChar16(
    const char *src,	/* The UTF-8 string. */
    unsigned short *chPtr)/* Filled with the Tcl_UniChar represented by
				 * the UTF-8 string. This could be a surrogate too. */
    const char *src,		/* The UTF-8 string. */
    unsigned short *chPtr)	/* Filled with the Tcl_UniChar represented by
				 * the UTF-8 string. This could be a surrogate
				 * too. */
{
    unsigned short byte;

    /*
     * Unroll 1 to 4 byte UTF-8 sequences.
     */

795
796
797
798
799
800
801
802
803
804



805
806
807
808
809
810
811
811
812
813
814
815
816
817



818
819
820
821
822
823
824
825
826
827







-
-
-
+
+
+







 *	None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Size
Tcl_NumUtfChars(
    const char *src,	/* The UTF-8 string to measure. */
    Tcl_Size length)	/* The length of the string in bytes, or
			 * negative value for strlen(src). */
    const char *src,		/* The UTF-8 string to measure. */
    Tcl_Size length)		/* The length of the string in bytes, or
				 * negative value for strlen(src). */
{
    Tcl_UniChar ch = 0;
    Tcl_Size i = 0;

    if (length < 0) {
	/* string is NUL-terminated, so TclUtfToUniChar calls are safe. */
	while (*src != '\0') {
847
848
849
850
851
852
853
854
855
856



857
858
859
860
861
862
863
863
864
865
866
867
868
869



870
871
872
873
874
875
876
877
878
879







-
-
-
+
+
+







	}
    }
    return i;
}

Tcl_Size
TclNumUtfChars(
    const char *src,	/* The UTF-8 string to measure. */
    Tcl_Size length)	/* The length of the string in bytes, or
			 * negative for strlen(src). */
    const char *src,		/* The UTF-8 string to measure. */
    Tcl_Size length)		/* The length of the string in bytes, or
				 * negative for strlen(src). */
{
    unsigned short ch = 0;
    Tcl_Size i = 0;

    if (length < 0) {
	/* string is NUL-terminated, so TclUtfToUniChar calls are safe. */
	while (*src != '\0') {
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
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







-
-
+
+




















-
-
+
+












-
-
+
+











-
-
+
+







 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_UniCharAtIndex(
    const char *src,	/* The UTF-8 string to dereference. */
    Tcl_Size index)	/* The position of the desired character. */
    const char *src,		/* The UTF-8 string to dereference. */
    Tcl_Size index)		/* The position of the desired character. */
{
    Tcl_UniChar ch = 0;
    int i = 0;

    if (index < 0) {
	return -1;
    }
    while (index--) {
	i = TclUtfToUniChar(src, &ch);
	src += i;
    }
    TclUtfToUniChar(src, &i);
    return i;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UtfAtIndex --
 *
 *	Returns a pointer to the specified character (not byte) position in
 *	the UTF-8 string.
 *	Returns a pointer to the specified character (not byte) position in the
 *	UTF-8 string. 
 *
 * Results:
 *	As above.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

const char *
Tcl_UtfAtIndex(
    const char *src,	/* The UTF-8 string. */
    Tcl_Size index)	/* The position of the desired character. */
    const char *src,		/* The UTF-8 string. */
    Tcl_Size index)		/* The position of the desired character. */
{
    Tcl_UniChar ch = 0;

    while (index-- > 0) {
	src += TclUtfToUniChar(src, &ch);
    }
    return src;
}

const char *
TclUtfAtIndex(
    const char *src,	/* The UTF-8 string. */
    Tcl_Size index)	/* The position of the desired character. */
    const char *src,		/* The UTF-8 string. */
    Tcl_Size index)		/* The position of the desired character. */
{
    unsigned short ch = 0;
    Tcl_Size len = 0;

    if (index > 0) {
	while (index--) {
	    src += (len = Tcl_UtfToChar16(src, &ch));
1484
1485
1486
1487
1488
1489
1490
1491

1492
1493
1494
1495
1496
1497
1498
1500
1501
1502
1503
1504
1505
1506

1507
1508
1509
1510
1511
1512
1513
1514







-
+







 *----------------------------------------------------------------------
 */

int
TclpUtfNcmp2(
    const void *csPtr,		/* UTF string to compare to ct. */
    const void *ctPtr,		/* UTF string cs is compared to. */
    size_t numBytes)	/* Number of *bytes* to compare. */
    size_t numBytes)		/* Number of *bytes* to compare. */
{
    const char *cs = (const char *)csPtr;
    const char *ct = (const char *)ctPtr;
    /*
     * We can't simply call 'memcmp(cs, ct, numBytes);' because we need to
     * check for Tcl's \xC0\x80 non-utf-8 null encoding. Otherwise utf-8 lexes
     * fine in the strcmp manner.
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
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







-
-
+
+














-
+












-
-
+
+






-
-
-
-
+
+
+
+













-
+







}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UtfNcmp --
 *
 *	Compare at most numChars chars (not bytes) of string cs to string ct. Both cs
 *	and ct are assumed to be at least numChars chars long.
 *	Compare at most numChars chars (not bytes) of string cs to string ct.
 *	Both cs and ct are assumed to be at least numChars chars long.
 *
 * Results:
 *	Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclUtfNcmp(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct,		/* UTF string cs is compared to. */
    size_t numChars)	/* Number of UTF-16 chars to compare. */
    size_t numChars)		/* Number of UTF-16 chars to compare. */
{
    unsigned short ch1 = 0, ch2 = 0;

    /*
     * Cannot use 'memcmp(cs, ct, n);' as byte representation of \u0000 (the
     * pair of bytes 0xC0,0x80) is larger than byte representation of \u0001
     * (the byte 0x01.)
     */

    while (numChars-- > 0) {
	/*
	 * n must be interpreted as chars, not bytes. This should be called
	 * only when both strings are of at least n UTF-16 chars long (no need for \0
	 * check)
	 * only when both strings are of at least n UTF-16 chars long (no
	 * need for \0 check)
	 */

	cs += Tcl_UtfToChar16(cs, &ch1);
	ct += Tcl_UtfToChar16(ct, &ch2);
	if (ch1 != ch2) {
	    /* Surrogates always report higher than non-surrogates */
	    if (((ch1 & 0xFC00) == 0xD800)) {
	    if ((ch2 & 0xFC00) != 0xD800) {
		return ch1;
	    }
	    if ((ch1 & 0xFC00) == 0xD800) {
		if ((ch2 & 0xFC00) != 0xD800) {
		    return ch1;
		}
	    } else if ((ch2 & 0xFC00) == 0xD800) {
		return -ch2;
	    }
	    return (ch1 - ch2);
	}
    }
    return 0;
}

int
Tcl_UtfNcmp(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct,		/* UTF string cs is compared to. */
    size_t numChars)	/* Number of chars to compare. */
    size_t numChars)		/* Number of chars to compare. */
{
    Tcl_UniChar ch1 = 0, ch2 = 0;

    /*
     * Cannot use 'memcmp(cs, ct, n);' as byte representation of \u0000 (the
     * pair of bytes 0xC0,0x80) is larger than byte representation of \u0001
     * (the byte 0x01.)
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
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







-
-
-
+
+
+














-
+













-
-
-
-
+
+
+
+

















-
+







}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UtfNcasecmp --
 *
 *	Compare at most numChars chars (not bytes) of string cs to string ct case
 *	insensitive. Both cs and ct are assumed to be at least numChars UTF
 *	chars long.
 *	Compare at most numChars chars (not bytes) of string cs to string ct
 *	case insensitive. Both cs and ct are assumed to be at least numChars
 *	UTF-16 chars long.
 *
 * Results:
 *	Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclUtfNcasecmp(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct,		/* UTF string cs is compared to. */
    size_t numChars)	/* Number of UTF-16 chars to compare. */
    size_t numChars)		/* Number of UTF-16 chars to compare. */
{
    unsigned short ch1 = 0, ch2 = 0;

    while (numChars-- > 0) {
	/*
	 * n must be interpreted as UTF-16 chars, not bytes.
	 * This should be called only when both strings are of
	 * at least n UTF-16 chars long (no need for \0 check)
	 */
	cs += Tcl_UtfToChar16(cs, &ch1);
	ct += Tcl_UtfToChar16(ct, &ch2);
	if (ch1 != ch2) {
	    /* Surrogates always report higher than non-surrogates */
	    if (((ch1 & 0xFC00) == 0xD800)) {
	    if ((ch2 & 0xFC00) != 0xD800) {
		return ch1;
	    }
	    if ((ch1 & 0xFC00) == 0xD800) {
		if ((ch2 & 0xFC00) != 0xD800) {
		    return ch1;
		}
	    } else if ((ch2 & 0xFC00) == 0xD800) {
		return -ch2;
	    }
	    ch1 = Tcl_UniCharToLower(ch1);
	    ch2 = Tcl_UniCharToLower(ch2);
	    if (ch1 != ch2) {
		return (ch1 - ch2);
	    }
	}
    }
    return 0;
}

int
Tcl_UtfNcasecmp(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct,		/* UTF string cs is compared to. */
    size_t numChars)	/* Number of chars to compare. */
    size_t numChars)		/* Number of chars to compare. */
{
    Tcl_UniChar ch1 = 0, ch2 = 0;

    while (numChars-- > 0) {
	/*
	 * n must be interpreted as chars, not bytes.
	 * This should be called only when both strings are of
1903
1904
1905
1906
1907
1908
1909
1910

1911
1912
1913
1914
1915
1916
1917
1919
1920
1921
1922
1923
1924
1925

1926
1927
1928
1929
1930
1931
1932
1933







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_UniCharLen(
    const int *uniStr)	/* Unicode string to find length of. */
    const int *uniStr)		/* Unicode string to find length of. */
{
    Tcl_Size len = 0;

    while (*uniStr != '\0') {
	len++;
	uniStr++;
    }
1935
1936
1937
1938
1939
1940
1941
1942

1943
1944
1945
1946
1947
1948
1949
1951
1952
1953
1954
1955
1956
1957

1958
1959
1960
1961
1962
1963
1964
1965







-
+







 *----------------------------------------------------------------------
 */

int
TclUniCharNcmp(
    const Tcl_UniChar *ucs,	/* Unicode string to compare to uct. */
    const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
    size_t numChars)	/* Number of chars to compare. */
    size_t numChars)		/* Number of chars to compare. */
{
#if defined(WORDS_BIGENDIAN)
    /*
     * We are definitely on a big-endian machine; memcmp() is safe
     */

    return memcmp(ucs, uct, numChars*sizeof(Tcl_UniChar));
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
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







-
-
+
+















-
+







}

/*
 *----------------------------------------------------------------------
 *
 * TclUniCharNcasecmp --
 *
 *	Compare at most numChars chars (not bytes) of string ucs to string uct case
 *	insensitive. Both ucs and uct are assumed to be at least numChars
 *	Compare at most numChars chars (not bytes) of string ucs to string uct
 *	case insensitive. Both ucs and uct are assumed to be at least numChars
 *	chars long.
 *
 * Results:
 *	Return <0 if ucs < uct, 0 if ucs == uct, or >0 if ucs > uct.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclUniCharNcasecmp(
    const Tcl_UniChar *ucs,	/* Unicode string to compare to uct. */
    const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
    size_t numChars)	/* Number of chars to compare. */
    size_t numChars)		/* Number of chars to compare. */
{
    for ( ; numChars != 0; numChars--, ucs++, uct++) {
	if (*ucs != *uct) {
	    Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs);
	    Tcl_UniChar lct = Tcl_UniCharToLower(*uct);

	    if (lcs != lct) {
Changes to generic/tclUtil.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
















15
16
17
18
19
20
21
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

-
-
-
-
-








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclUtil.c --
 *
 *	This file contains utility functions that are used by many Tcl
 *	commands.
 *
 * Copyright © 1987-1993 The Regents of the University of California.
 * Copyright © 1994-1998 Sun Microsystems, Inc.
 * Copyright © 2001 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclUtil.c --
 *
 *	This file contains utility functions that are used by many Tcl
 *	commands.
 */

#include <assert.h>
#include "tclInt.h"
#include "tclParse.h"
#include "tclStringTrim.h"
#include "tclTomMath.h"
#include <math.h>

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
131
132
133
134
135
136
137





138
139
140
141
142



143






144
145
146
147
148
149
150
151







-
-
-
-
-
+
+
+
+
+
-
-
-
+
-
-
-
-
-
-
+







 * for it. This is a caching internalrep, keeping the result of a parse
 * around. This type is only created from a pre-existing string, so an
 * updateStringProc will never be called and need not exist. The type
 * is unregistered, so has no need of a setFromAnyProc either.
 */

static const Tcl_ObjType endOffsetType = {
    "end-offset",			/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    NULL,				/* updateStringProc */
    NULL,				/* setFromAnyProc */
    "end-offset",		/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    NULL,			/* updateStringProc */
    NULL,			/* setFromAnyProc */
    TCL_OBJTYPE_V1(TclLengthOne)
};

	0
Tcl_Size
TclLengthOne(
    TCL_UNUSED(Tcl_Obj *))
{
    return 1;
}
};

/*
 *	*	STRING REPRESENTATION OF LISTS	*	*	*
 *
 * The next several routines implement the conversions of strings to and from
 * Tcl lists. To understand their operation, the rules of parsing and
 * generating the string representation of lists must be known.  Here we
820
821
822
823
824
825
826












827
828
829
830
831
832
833
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







+
+
+
+
+
+
+
+
+
+
+
+







	    src++;
	    count--;
	}
    }
    *dst = 0;
    return newCount;
}


int
TclLengthOne(
    TCL_UNUSED(Tcl_Interp *)	/* Used to report errors if not NULL. */ 
    ,TCL_UNUSED(Tcl_Obj *)	/* List object whose #elements to return. */
    ,Tcl_Size *lenPtr)	/* The resulting length is stored here. */

{
	*lenPtr = 1;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SplitList --
 *
 *	Splits a list up into its constituent fields.
942
943
944
945
946
947
948
949
950
951



952
953
954
955
956
957
958
958
959
960
961
962
963
964



965
966
967
968
969
970
971
972
973
974







-
-
-
+
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_ScanElement(
    const char *src,	/* String to convert to list element. */
    int *flagPtr)	/* Where to store information to guide
			 * Tcl_ConvertCountedElement. */
    const char *src,		/* String to convert to list element. */
    int *flagPtr)		/* Where to store information to guide
				 * Tcl_ConvertCountedElement. */
{
    return Tcl_ScanCountedElement(src, TCL_INDEX_NONE, flagPtr);
}

/*
 *----------------------------------------------------------------------
 *
1032
1033
1034
1035
1036
1037
1038
1039

1040
1041
1042
1043
1044
1045
1046
1048
1049
1050
1051
1052
1053
1054

1055
1056
1057
1058
1059
1060
1061
1062







-
+







    int forbidNone = 0;		/* Do not permit CONVERT_NONE mode. Something
				 * needs protection or escape. */
    int requireEscape = 0;	/* Force use of CONVERT_ESCAPE mode.  For some
				 * reason bare or brace-quoted form fails. */
    Tcl_Size extra = 0;		/* Count of number of extra bytes needed for
				 * formatted element, assuming we use escape
				 * sequences in formatting. */
    Tcl_Size bytesNeeded;		/* Buffer length computed to complete the
    Tcl_Size bytesNeeded;	/* Buffer length computed to complete the
				 * element formatting in the selected mode. */
#if COMPAT
    int preferEscape = 0;	/* Use preferences to track whether to use */
    int preferBrace = 0;	/* CONVERT_MASK mode. */
    int braceCount = 0;		/* Count of all braces '{' '}' seen. */
#endif /* COMPAT */

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
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







-
-
-
+
+
+

-
+

-
-
-
-
+
+
+
+

-
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
+
+
+
+

-
+

-
-
-
-
-
+
+
+
+
+

-
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
+

-
-
-
-
+
+
+
+







	forbidNone = 1;
#if COMPAT
	preferBrace = 1;
#endif /* COMPAT */
    }

    while (length) {
      if (CHAR_TYPE(*p) != TYPE_NORMAL) {
	switch (*p) {
	case '{':	/* TYPE_BRACE */
	if (CHAR_TYPE(*p) != TYPE_NORMAL) {
	    switch (*p) {
	    case '{':	/* TYPE_BRACE */
#if COMPAT
	    braceCount++;
		braceCount++;
#endif /* COMPAT */
	    extra++;				/* Escape '{' => '\{' */
	    nestingLevel++;
	    break;
	case '}':	/* TYPE_BRACE */
		extra++;	/* Escape '{' => '\{' */
		nestingLevel++;
		break;
	    case '}':	/* TYPE_BRACE */
#if COMPAT
	    braceCount++;
		braceCount++;
#endif /* COMPAT */
	    extra++;				/* Escape '}' => '\}' */
	    if (nestingLevel-- < 1) {
		/*
		 * Unbalanced braces!  Cannot format with brace quoting.
		 */
		extra++;	/* Escape '}' => '\}' */
		if (nestingLevel-- < 1) {
		    /*
		     * Unbalanced braces!  Cannot format with brace quoting.
		     */

		requireEscape = 1;
	    }
	    break;
	case ']':	/* TYPE_CLOSE_BRACK */
	case '"':	/* TYPE_SPACE */
		    requireEscape = 1;
		}
		break;
	    case ']':	/* TYPE_CLOSE_BRACK */
	    case '"':	/* TYPE_SPACE */
#if COMPAT
	    forbidNone = 1;
	    extra++;		/* Escapes all just prepend a backslash */
	    preferEscape = 1;
	    break;
		forbidNone = 1;
		extra++;	/* Escapes all just prepend a backslash */
		preferEscape = 1;
		break;
#else
	    /* FLOW THROUGH */
		/* FLOW THROUGH */
#endif /* COMPAT */
	case '[':	/* TYPE_SUBS */
	case '$':	/* TYPE_SUBS */
	case ';':	/* TYPE_COMMAND_END */
	    forbidNone = 1;
	    extra++;		/* Escape sequences all one byte longer. */
	    case '[':	/* TYPE_SUBS */
	    case '$':	/* TYPE_SUBS */
	    case ';':	/* TYPE_COMMAND_END */
		forbidNone = 1;
		extra++;	/* Escape sequences all one byte longer. */
#if COMPAT
	    preferBrace = 1;
		preferBrace = 1;
#endif /* COMPAT */
	    break;
	case '\\':	/* TYPE_SUBS */
	    extra++;				/* Escape '\' => '\\' */
	    if ((length == 1) || ((length == TCL_INDEX_NONE) && (p[1] == '\0'))) {
		/*
		 * Final backslash. Cannot format with brace quoting.
		 */
		break;
	    case '\\':	/* TYPE_SUBS */
		extra++;	/* Escape '\' => '\\' */
		if ((length == 1) || ((length == TCL_INDEX_NONE) && (p[1] == '\0'))) {
		    /*
		     * Final backslash. Cannot format with brace quoting.
		     */

		requireEscape = 1;
		break;
	    }
	    if (p[1] == '\n') {
		extra++;	/* Escape newline => '\n', one byte longer */
		    requireEscape = 1;
		    break;
		}
		if (p[1] == '\n') {
		    extra++;	/* Escape newline => '\n', one byte longer */

		/*
		 * Backslash newline sequence.  Brace quoting not permitted.
		 */
		    /*
		     * Backslash newline sequence.  Brace quoting not permitted.
		     */

		requireEscape = 1;
		length -= (length > 0);
		p++;
		break;
	    }
	    if ((p[1] == '{') || (p[1] == '}') || (p[1] == '\\')) {
		extra++;	/* Escape sequences all one byte longer. */
		length -= (length > 0);
		p++;
	    }
	    forbidNone = 1;
		    requireEscape = 1;
		    length -= (length > 0);
		    p++;
		    break;
		}
		if ((p[1] == '{') || (p[1] == '}') || (p[1] == '\\')) {
		    extra++;	/* Escape sequences all one byte longer. */
		    length -= (length > 0);
		    p++;
		}
		forbidNone = 1;
#if COMPAT
	    preferBrace = 1;
		preferBrace = 1;
#endif /* COMPAT */
	    break;
	case '\0':	/* TYPE_SUBS */
	    if (length == TCL_INDEX_NONE) {
		goto endOfString;
	    }
	    /* TODO: Panic on improper encoding? */
	    break;
	default:
	    if (TclIsSpaceProcM(*p)) {
		forbidNone = 1;
		extra++;	/* Escape sequences all one byte longer. */
		break;
	    case '\0':	/* TYPE_SUBS */
		if (length == TCL_INDEX_NONE) {
		    goto endOfString;
		}
		/* TODO: Panic on improper encoding? */
		break;
	    default:
		if (TclIsSpaceProcM(*p)) {
		    forbidNone = 1;
		    extra++;	/* Escape sequences all one byte longer. */
#if COMPAT
		preferBrace = 1;
		    preferBrace = 1;
#endif
	    }
	    break;
	}
      }
		}
		break;
	    }
	}
	length -= (length > 0);
	p++;
    }

  endOfString:
    if (nestingLevel > 0) {
	/*
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328



1329
1330
1331
1332
1333
1334
1335
1335
1336
1337
1338
1339
1340
1341



1342
1343
1344
1345
1346
1347
1348
1349
1350
1351







-
-
-
+
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_ConvertElement(
    const char *src,	/* Source information for list element. */
    char *dst,		/* Place to put list-ified element. */
    int flags)		/* Flags produced by Tcl_ScanElement. */
    const char *src,		/* Source information for list element. */
    char *dst,			/* Place to put list-ified element. */
    int flags)			/* Flags produced by Tcl_ScanElement. */
{
    return Tcl_ConvertCountedElement(src, TCL_INDEX_NONE, dst, flags);
}

/*
 *----------------------------------------------------------------------
 *
1349
1350
1351
1352
1353
1354
1355
1356

1357
1358
1359
1360
1361
1362
1363
1365
1366
1367
1368
1369
1370
1371

1372
1373
1374
1375
1376
1377
1378
1379







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_ConvertCountedElement(
    const char *src,	/* Source information for list element. */
    const char *src,		/* Source information for list element. */
    Tcl_Size length,		/* Number of bytes in src, or TCL_INDEX_NONE. */
    char *dst,			/* Place to put list-ified element. */
    int flags)			/* Flags produced by Tcl_ScanElement. */
{
    Tcl_Size numBytes = TclConvertElement(src, length, dst, flags);
    dst[numBytes] = '\0';
    return numBytes;
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
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







-
+



















-
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
TclConvertElement(
    const char *src,	/* Source information for list element. */
    const char *src,		/* Source information for list element. */
    Tcl_Size length,		/* Number of bytes in src, or TCL_INDEX_NONE. */
    char *dst,			/* Place to put list-ified element. */
    int flags)			/* Flags produced by Tcl_ScanElement. */
{
    int conversion = flags & CONVERT_MASK;
    char *p = dst;

    /*
     * Let the caller demand we use escape sequences rather than braces.
     */

    if ((flags & TCL_DONT_USE_BRACES) && (conversion & CONVERT_BRACE)) {
	conversion = CONVERT_ESCAPE;
    }

    /*
     * No matter what the caller demands, empty string must be braced!
     */

    if ((src == NULL) || (length == 0) || (*src == '\0' && length == TCL_INDEX_NONE)) {
    if ((src == NULL) || (length == 0)
	    || (*src == '\0' && length == TCL_INDEX_NONE)) {
	p[0] = '{';
	p[1] = '}';
	return 2;
    }

    /*
     * Escape leading hash as needed and requested.
1563
1564
1565
1566
1567
1568
1569
1570

1571
1572
1573
1574
1575
1576
1577
1580
1581
1582
1583
1584
1585
1586

1587
1588
1589
1590
1591
1592
1593
1594







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_Merge(
    Tcl_Size argc,			/* How many strings to merge. */
    Tcl_Size argc,		/* How many strings to merge. */
    const char *const *argv)	/* Array of string values. */
{
#define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;
    Tcl_Size i;
    size_t bytesNeeded = 0;
    char *result, *dst;
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654








1655
1656
1657
1658
1659
1660
1661
1657
1658
1659
1660
1661
1662
1663








1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678







-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
TclTrimRight(
    const char *bytes,	/* String to be trimmed... */
    Tcl_Size numBytes,	/* ...and its length in bytes */
			/* Calls to TclUtfToUniChar() in this routine
			 * rely on (bytes[numBytes] == '\0'). */
    const char *trim,	/* String of trim characters... */
    Tcl_Size numTrim)	/* ...and its length in bytes */
			/* Calls to TclUtfToUniChar() in this routine
			 * rely on (trim[numTrim] == '\0'). */
    const char *bytes,		/* String to be trimmed... */
    Tcl_Size numBytes,		/* ...and its length in bytes */
				/* Calls to TclUtfToUniChar() in this routine
				 * rely on (bytes[numBytes] == '\0'). */
    const char *trim,		/* String of trim characters... */
    Tcl_Size numTrim)		/* ...and its length in bytes */
				/* Calls to TclUtfToUniChar() in this routine
				 * rely on (trim[numTrim] == '\0'). */
{
    const char *pp, *p = bytes + numBytes;
    int ch1, ch2;

    /* Empty strings -> nothing to do */
    if ((numBytes == 0) || (numTrim == 0)) {
	return 0;
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733








1734
1735
1736
1737
1738
1739
1740
1736
1737
1738
1739
1740
1741
1742








1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757







-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
TclTrimLeft(
    const char *bytes,	/* String to be trimmed... */
    Tcl_Size numBytes,	/* ...and its length in bytes */
			/* Calls to TclUtfToUniChar() in this routine
			 * rely on (bytes[numBytes] == '\0'). */
    const char *trim,	/* String of trim characters... */
    Tcl_Size numTrim)	/* ...and its length in bytes */
			/* Calls to TclUtfToUniChar() in this routine
			 * rely on (trim[numTrim] == '\0'). */
    const char *bytes,		/* String to be trimmed... */
    Tcl_Size numBytes,		/* ...and its length in bytes */
				/* Calls to TclUtfToUniChar() in this routine
				 * rely on (bytes[numBytes] == '\0'). */
    const char *trim,		/* String of trim characters... */
    Tcl_Size numTrim)		/* ...and its length in bytes */
				/* Calls to TclUtfToUniChar() in this routine
				 * rely on (trim[numTrim] == '\0'). */
{
    const char *p = bytes;
    int ch1, ch2;

    /* Empty strings -> nothing to do */
    if ((numBytes == 0) || (numTrim == 0)) {
	return 0;
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807








1808
1809
1810
1811
1812
1813
1814
1810
1811
1812
1813
1814
1815
1816








1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831







-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
TclTrim(
    const char *bytes,	/* String to be trimmed... */
    Tcl_Size numBytes,	/* ...and its length in bytes */
			/* Calls in this routine
			 * rely on (bytes[numBytes] == '\0'). */
    const char *trim,	/* String of trim characters... */
    Tcl_Size numTrim,	/* ...and its length in bytes */
			/* Calls in this routine
			 * rely on (trim[numTrim] == '\0'). */
    const char *bytes,		/* String to be trimmed... */
    Tcl_Size numBytes,		/* ...and its length in bytes */
				/* Calls in this routine
				 * rely on (bytes[numBytes] == '\0'). */
    const char *trim,		/* String of trim characters... */
    Tcl_Size numTrim,		/* ...and its length in bytes */
				/* Calls in this routine
				 * rely on (trim[numTrim] == '\0'). */
    Tcl_Size *trimRightPtr)	/* Offset from the end of the string. */
{
    Tcl_Size trimLeft = 0, trimRight = 0;

    /* Empty strings -> nothing to do */
    if ((numBytes > 0) && (numTrim > 0)) {

1855
1856
1857
1858
1859
1860
1861
1862

1863
1864
1865
1866
1867
1868
1869
1872
1873
1874
1875
1876
1877
1878

1879
1880
1881
1882
1883
1884
1885
1886







-
+







 */

/* The whitespace characters trimmed during [concat] operations */
#define CONCAT_WS_SIZE (sizeof(CONCAT_TRIM_SET "") - 1)

char *
Tcl_Concat(
    Tcl_Size argc,			/* Number of strings to concatenate. */
    Tcl_Size argc,		/* Number of strings to concatenate. */
    const char *const *argv)	/* Array of strings to concatenate. */
{
    Tcl_Size i, needSpace = 0, bytesNeeded = 0;
    char *result, *p;

    /*
     * Dispose of the empty result corner case first to simplify later code.
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
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







-
-
+
+


-
+








-
-
+
+


















-
+
+
+
+
+

















-
+



















-
+







     * is only valid when the lists are in canonical form.
     */

    for (i = 0;  i < objc;  i++) {
	Tcl_Size length;

	objPtr = objv[i];
	if (TclListObjIsCanonical(objPtr) ||
		TclObjTypeHasProc(objPtr, indexProc)) {
	if (TclListObjIsCanonical(objPtr)
	    || TclObjectHasInterface(objPtr,list,index)) {
	    continue;
	}
	(void)TclGetStringFromObj(objPtr, &length);
	(void)Tcl_GetStringFromObj(objPtr, &length);
	if (length > 0) {
	    break;
	}
    }
    if (i == objc) {
	resPtr = NULL;
	for (i = 0;  i < objc;  i++) {
	    objPtr = objv[i];
	    if (!TclListObjIsCanonical(objPtr) &&
		    !TclObjTypeHasProc(objPtr, indexProc)) {
	    if (!TclListObjIsCanonical(objPtr)
		&& !TclObjectHasInterface(objPtr, list, index)) {
		continue;
	    }
	    if (resPtr) {
		Tcl_Obj *elemPtr = NULL;

		Tcl_ListObjIndex(NULL, objPtr, 0, &elemPtr);
		if (elemPtr == NULL) {
		    continue;
		}
		if (TclGetString(elemPtr)[0] == '#' || TCL_OK
			!= Tcl_ListObjAppendList(NULL, resPtr, objPtr)) {
		    /* Abandon ship! */
		    Tcl_DecrRefCount(resPtr);
		    Tcl_BounceRefCount(elemPtr); // could be an abstract list element
		    goto slow;
		}
		Tcl_BounceRefCount(elemPtr); // could be an an abstract list element
	    } else {
		resPtr = TclListObjCopy(NULL, objPtr);
		resPtr = TclDuplicatePureObj(
		    NULL, objPtr, tclListTypePtr);
		if (!resPtr) {
		    return NULL;
		}
	    }
	}
	if (!resPtr) {
	    TclNewObj(resPtr);
	}
	return resPtr;
    }

  slow:
    /*
     * Something cannot be determined to be safe, so build the concatenation
     * the slow way, using the string representations.
     *
     * First try to preallocate the size required.
     */

    for (i = 0;  i < objc;  i++) {
	element = TclGetStringFromObj(objv[i], &elemLength);
	element = Tcl_GetStringFromObj(objv[i], &elemLength);
	if (bytesNeeded > (TCL_SIZE_MAX - elemLength)) {
	    break; /* Overflow. Do not preallocate. See comment below. */
	}
	bytesNeeded += elemLength;
    }

    /*
     * Does not matter if this fails, will simply try later to build up the
     * string with each Append reallocating as needed with the usual string
     * append algorithm.  When that fails it will report the error.
     */

    TclNewObj(resPtr);
    (void) Tcl_AttemptSetObjLength(resPtr, bytesNeeded + objc - 1);
    Tcl_SetObjLength(resPtr, 0);

    for (i = 0;  i < objc;  i++) {
	Tcl_Size triml, trimr;

	element = TclGetStringFromObj(objv[i], &elemLength);
	element = Tcl_GetStringFromObj(objv[i], &elemLength);

	/* Trim away the leading/trailing whitespace. */
	triml = TclTrim(element, elemLength, CONCAT_TRIM_SET,
		CONCAT_WS_SIZE, &trimr);
	element += triml;
	elemLength -= triml + trimr;

2333
2334
2335
2336
2337
2338
2339
2340

2341
2342
2343
2344

2345
2346
2347
2348
2349
2350
2351
2354
2355
2356
2357
2358
2359
2360

2361
2362
2363
2364

2365
2366
2367
2368
2369
2370
2371
2372







-
+



-
+







 *
 *----------------------------------------------------------------------
 */

int
TclByteArrayMatch(
    const unsigned char *string,/* String. */
    Tcl_Size strLen,			/* Length of String */
    Tcl_Size strLen,		/* Length of String */
    const unsigned char *pattern,
				/* Pattern, which may contain special
				 * characters. */
    Tcl_Size ptnLen,			/* Length of Pattern */
    Tcl_Size ptnLen,		/* Length of Pattern */
    TCL_UNUSED(int) /*flags*/)
{
    const unsigned char *stringEnd, *patternEnd;
    unsigned char p;

    stringEnd = string + strLen;
    patternEnd = pattern + ptnLen;
2664
2665
2666
2667
2668
2669
2670
2671

2672
2673
2674
2675
2676
2677
2678
2685
2686
2687
2688
2689
2690
2691

2692
2693
2694
2695
2696
2697
2698
2699







-
+








char *
TclDStringAppendObj(
    Tcl_DString *dsPtr,
    Tcl_Obj *objPtr)
{
    Tcl_Size length;
    const char *bytes = TclGetStringFromObj(objPtr, &length);
    const char *bytes = Tcl_GetStringFromObj(objPtr, &length);

    return Tcl_DStringAppend(dsPtr, bytes, length);
}

char *
TclDStringAppendDString(
    Tcl_DString *dsPtr,
2724
2725
2726
2727
2728
2729
2730

2731
2732
2733
2734
2735
2736
2737
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759







+







	 * We don't need a space, maybe because there's some already there.
	 * Checking whether we might be appending a first element is a bit
	 * more involved.
	 *
	 * Backtrack over all whitespace.
	 */
	while ((--dst >= dsPtr->string) && TclIsSpaceProcM(*dst)) {
	    // empty body
	}

	/* Call again without whitespace to confound things. */
	quoteHash = !TclNeedSpace(dsPtr->string, dst+1);
    }
    if (!quoteHash) {
	flags |= TCL_DONT_QUOTE_HASH;
2805
2806
2807
2808
2809
2810
2811
2812

2813
2814
2815
2816
2817
2818
2819
2827
2828
2829
2830
2831
2832
2833

2834
2835
2836
2837
2838
2839
2840
2841







-
+







 *
 *----------------------------------------------------------------------
 */

void
Tcl_DStringSetLength(
    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
    Tcl_Size length)			/* New length for dynamic string. */
    Tcl_Size length)		/* New length for dynamic string. */
{
    Tcl_Size newsize;

    if (length < 0) {
	length = 0;
    }
    if (length >= dsPtr->spaceAvl) {
3238
3239
3240
3241
3242
3243
3244

3245
3246
3247
3248
3249
3250
3251
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274







+







	end = Tcl_UtfPrev(end, start);
    }

     *
     */

    while ((--end >= start) && (*end == '{')) {
	// empty body
    }
    if (end < start) {
	return 0;
    }

    /*
     * (c) the trailing character of the string is already a list-element
3294
3295
3296
3297
3298
3299
3300
3301

3302
3303
3304
3305
3306
3307
3308
3317
3318
3319
3320
3321
3322
3323

3324
3325
3326
3327
3328
3329
3330
3331







-
+







 *----------------------------------------------------------------------
 */

Tcl_Size
TclFormatInt(
    char *buffer,		/* Points to the storage into which the
				 * formatted characters are written. */
    Tcl_WideInt n)			/* The integer to format. */
    Tcl_WideInt n)		/* The integer to format. */
{
    Tcl_WideUInt intVal;
    int i = 0, numFormatted, j;
    static const char digits[] = "0123456789";

    /*
     * Generate the characters of the result backwards in the buffer.
3356
3357
3358
3359
3360
3361
3362
3363

3364
3365
3366
3367


3368
3369
3370
3371
3372
3373
3374
3379
3380
3381
3382
3383
3384
3385

3386
3387
3388


3389
3390
3391
3392
3393
3394
3395
3396
3397







-
+


-
-
+
+







 *	The type of *objPtr may change.
 *
 *----------------------------------------------------------------------
 */

static int
GetWideForIndex(
    Tcl_Interp *interp,         /* Interpreter to use for error reporting. If
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
				 * NULL, then no error message is left after
				 * errors. */
    Tcl_Obj *objPtr,            /* Points to the value to be parsed */
    Tcl_WideInt endValue,       /* The value to be stored at *widePtr if
    Tcl_Obj *objPtr,		/* Points to the value to be parsed */
    Tcl_WideInt endValue,	/* The value to be stored at *widePtr if
				 * objPtr holds "end".
				 * NOTE: this value may be TCL_INDEX_NONE. */
    Tcl_WideInt *widePtr)       /* Location filled in with a wide integer
				 * representing an index. */
{
    int numType;
    void *cd;
3405
3406
3407
3408
3409
3410
3411
3412

3413
3414
3415
3416
3417
3418
3419
3428
3429
3430
3431
3432
3433
3434

3435
3436
3437
3438
3439
3440
3441
3442







-
+







 *	integer([+-]integer)? or end([+-]integer)?.
 *
 *	If the computed index lies within the valid range of Tcl indices
 *	(0..TCL_SIZE_MAX) it is returned. Higher values are returned as
 *	TCL_SIZE_MAX. Negative values are returned as TCL_INDEX_NONE (-1).
 *
 *	Callers should pass reasonable values for endValue - one in the
 *      valid index range or TCL_INDEX_NONE (-1), for example for an empty
 *	valid index range or TCL_INDEX_NONE (-1), for example for an empty
 *	list.
 *
 * Results:
 *	TCL_OK
 *
 *	    The index is stored at the address given by by 'indexPtr'.
 *
3476
3477
3478
3479
3480
3481
3482
3483

3484
3485
3486
3487
3488
3489
3490
3499
3500
3501
3502
3503
3504
3505

3506
3507
3508
3509
3510
3511
3512
3513







-
+







 *	WIDE_MIN:   Index value TCL_INDEX_NONE (or -1)
 *	WIDE_MIN+1: Index value n, for any n < -1  (usually same effect as -1)
 *	-$n:        Index "end-[expr {$n-1}]"
 *	-2:         Index "end-1"
 *	-1:         Index "end"
 *	0:          Index "0"
 *	WIDE_MAX-1: Index "end+n", for any n > 1. Distinguish from end+1 for
 *                  commands like lset.
 *	            commands like lset.
 *	WIDE_MAX:   Index "end+1"
 *
 * Results:
 *	Tcl return code.
 *
 * Side effects:
 *	May store a Tcl_ObjType.
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
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







-
+








-
-

-
-
-
-
+
+
+














-
-
+
+







    Tcl_ObjInternalRep *irPtr;
    Tcl_WideInt offset = -1;	/* Offset in the "end-offset" expression - 1 */
    void *cd;

    while ((irPtr = TclFetchInternalRep(objPtr, &endOffsetType)) == NULL) {
	Tcl_ObjInternalRep ir;
	Tcl_Size length;
	const char *bytes = TclGetStringFromObj(objPtr, &length);
	const char *bytes = Tcl_GetStringFromObj(objPtr, &length);

	if (*bytes != 'e') {
	    int numType;
	    const char *opPtr;
	    int t1 = 0, t2 = 0;

	    /* Value doesn't start with "e" */

	    /* If we reach here, the string rep of objPtr exists. */

	    /*
	     * The valid index syntax does not include any value that is
	     * a list of more than one element. This is necessary so that
	     * lists of index values can be reliably distinguished from any
	     * single index value.
	     * So that lists of index values can be reliably distinguished from
	     * any single index value, the valid index syntax does not include
	     * any value that is a list of more than one element.
	     */

	    /*
	     * Quick scan to see if multi-value list is even possible.
	     * This relies on TclGetString() returning a NUL-terminated string.
	     */
	    if ((TclMaxListLength(bytes, TCL_INDEX_NONE, NULL) > 1)
		    /* If it's possible, do the full list parse. */
		    && (TCL_OK == TclListObjLength(NULL, objPtr, &length))
		    && (length > 1)) {
		goto parseError;
	    }

	    /* Passed the list screen, so parse for index arithmetic expression */
	    if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, NULL, TCL_INDEX_NONE, &opPtr,
		    TCL_PARSE_INTEGER_ONLY)) {
	    if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, NULL,
		    TCL_INDEX_NONE, &opPtr, TCL_PARSE_INTEGER_ONLY)) {
		Tcl_WideInt w1=0, w2=0;

		/* value starts with valid integer... */

		if ((*opPtr == '-') || (*opPtr == '+')) {
		    /* ... value continues with [-+] ... */

3636
3637
3638
3639
3640
3641
3642

3643
3644
3645
3646
3647
3648
3649
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670







+







	    goto parseError;
	}

	if ((length < 3) || (length == 4) || (strncmp(bytes, "end", 3) != 0)) {
	    /* Doesn't start with "end" */
	    goto parseError;
	}

	if (length > 4) {
	    int t;

	    /* Parse for the "end-..." or "end+..." formats */

	    if ((bytes[3] != '-') && (bytes[3] != '+')) {
		/* No operator where we need one */
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
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







-
-
-
-
+
+
+
+

-
+



-
+

-
-
-
-
+
+
+
+



-
-
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
-
+
+


-
-
+
+






-
-
-
-
-
+
+
+
+
+







    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclIndexEncode --
 *      IMPORTANT: function only encodes indices in the range that fits within
 *      an "int" type. Do NOT change this as the byte code compiler and engine
 *      which call this function cannot handle wider index types. Indices
 *      outside the range will result in the function returning an error.
 *	IMPORTANT: function only encodes indices in the range that fits within
 *	an "int" type. Do NOT change this as the byte code compiler and engine
 *	which call this function cannot handle wider index types. Indices
 *	outside the range will result in the function returning an error.
 *
 *      Parse objPtr to determine if it is an index value. Two cases
 *	Parse objPtr to determine if it is an index value. Two cases
 *	are possible.  The value objPtr might be parsed as an absolute
 *	index value in the Tcl_Size range.  Note that this includes
 *	index values that are integers as presented and it includes index
 *      arithmetic expressions.
 *	arithmetic expressions.
 *
 *      The largest string supported in Tcl 8 has byte length TCL_SIZE_MAX.
 *      This means the largest supported character length is also TCL_SIZE_MAX,
 *      and the index of the last character in a string of length TCL_SIZE_MAX
 *      is TCL_SIZE_MAX-1. Thus the absolute index values that can be
 *	The largest string supported in Tcl 8 has byte length TCL_SIZE_MAX.
 *	This means the largest supported character length is also TCL_SIZE_MAX,
 *	and the index of the last character in a string of length TCL_SIZE_MAX
 *	is TCL_SIZE_MAX-1. Thus the absolute index values that can be
 *	directly meaningful as an index into either a list or a string are
 *	integer values in the range 0 to TCL_SIZE_MAX - 1.
 *
 *      This function however can only handle integer indices in the range
 *      0 : INT_MAX-1.
 *	This function however can only handle integer indices in the range
 *	0 : INT_MAX-1.
 *
 *      Any absolute index value parsed outside that range is encoded
 *      using the before and after values passed in by the
 *      caller as the encoding to use for indices that are either
 *      less than or greater than the usable index range. TCL_INDEX_NONE
 *      is available as a good choice for most callers to use for
 *      after. Likewise, the value TCL_INDEX_NONE is good for
 *      most callers to use for before.  Other values are possible
 *      when the caller knows it is helpful in producing its own behavior
 *      for indices before and after the indexed item.
 *	Any absolute index value parsed outside that range is encoded
 *	using the before and after values passed in by the
 *	caller as the encoding to use for indices that are either
 *	less than or greater than the usable index range. TCL_INDEX_NONE
 *	is available as a good choice for most callers to use for
 *	after. Likewise, the value TCL_INDEX_NONE is good for
 *	most callers to use for before.  Other values are possible
 *	when the caller knows it is helpful in producing its own behavior
 *	for indices before and after the indexed item.
 *
 *      A token can also be parsed as an end-relative index expression.
 *      All end-relative expressions that indicate an index larger
 *      than end (end+2, end--5) point beyond the end of the indexed
 *      collection, and can be encoded as after.  The end-relative
 *      expressions that indicate an index less than or equal to end
 *      are encoded relative to the value TCL_INDEX_END (-2).  The
 *      index "end" is encoded as -2, down to the index "end-0x7FFFFFFE"
 *      which is encoded as INT_MIN. Since the largest index into a
 *      string possible in Tcl 8 is 0x7FFFFFFE, the interpretation of
 *      "end-0x7FFFFFFE" for that largest string would be 0.  Thus,
 *      if the tokens "end-0x7FFFFFFF" or "end+-0x80000000" are parsed,
 *      they can be encoded with the before value.
 *	A token can also be parsed as an end-relative index expression.
 *	All end-relative expressions that indicate an index larger
 *	than end (end+2, end--5) point beyond the end of the indexed
 *	collection, and can be encoded as after.  The end-relative
 *	expressions that indicate an index less than or equal to end
 *	are encoded relative to the value TCL_INDEX_END (-2).  The
 *	index "end" is encoded as -2, down to the index "end-0x7FFFFFFE"
 *	which is encoded as INT_MIN. Since the largest index into a
 *	string possible in Tcl 8 is 0x7FFFFFFE, the interpretation of
 *	"end-0x7FFFFFFE" for that largest string would be 0.  Thus,
 *	if the tokens "end-0x7FFFFFFF" or "end+-0x80000000" are parsed,
 *	they can be encoded with the before value.
 *
 * Returns:
 *      TCL_OK if parsing succeeded, and TCL_ERROR if it failed or the
 *      index does not fit in an int type.
 *	TCL_OK if parsing succeeded, and TCL_ERROR if it failed or the
 *	index does not fit in an int type.
 *
 * Side effects:
 *      When TCL_OK is returned, the encoded index value is written
 *      to *indexPtr.
 *	When TCL_OK is returned, the encoded index value is written
 *	to *indexPtr.
 *
 *----------------------------------------------------------------------
 */

int
TclIndexEncode(
    Tcl_Interp *interp,	/* For error reporting, may be NULL */
    Tcl_Obj *objPtr,	/* Index value to parse */
    int before,		/* Value to return for index before beginning */
    int after,		/* Value to return for index after end */
    int *indexPtr)	/* Where to write the encoded answer, not NULL */
    Tcl_Interp *interp,		/* For error reporting, may be NULL */
    Tcl_Obj *objPtr,		/* Index value to parse */
    int before,			/* Value to return for index before beginning */
    int after,			/* Value to return for index after end */
    int *indexPtr)		/* Where to write the encoded answer, not NULL */
{
    Tcl_WideInt wide;
    int idx;
    const Tcl_WideInt ENDVALUE = 2 * (Tcl_WideInt) INT_MAX;

    assert(ENDVALUE < WIDE_MAX);
    if (TCL_OK != GetWideForIndex(interp, objPtr, ENDVALUE, &wide)) {
3913
3914
3915
3916
3917
3918
3919
3920
3921




3922
3923
3924
3925
3926
3927
3928
3934
3935
3936
3937
3938
3939
3940


3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951







-
-
+
+
+
+







	}
    }
    *indexPtr = idx;
    return TCL_OK;

rangeerror:
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("index \"%s\" out of range", TclGetString(objPtr)));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE", (char *)NULL);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("index \"%s\" out of range"
	    , TclGetString(objPtr)));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE"
	    , (char *)NULL);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
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
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
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
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







-
-
+
+










+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


















-
-
+
+







 *	The decoded index value.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
TclIndexDecode(
    int encoded,	/* Value to decode */
    Tcl_Size endValue)	/* Meaning of "end" to use, > TCL_INDEX_END */
    int encoded,		/* Value to decode */
    Tcl_Size endValue)		/* Meaning of "end" to use, > TCL_INDEX_END */
{
    if (encoded > TCL_INDEX_END) {
	return encoded;
    }
    endValue += encoded - TCL_INDEX_END;
    if (endValue >= 0) {
	return endValue;
    }
    return TCL_INDEX_NONE;
}

int TclIndexIsFromEnd(Tcl_Size index) {
    return index <= 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TclIndexLast --
 *
 *	Determine the last index for an array of length "length", where -1 means N is
 *	not bounded.
 *
 *----------------------------------------------------------------------
 */
Tcl_Size
TclIndexLast (Tcl_Size length) {
    return Tcl_LengthIsFinite(length) ? length - 1 : TCL_INDEX_NONE;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LengthIsFinite --
 *
 *	True if length is Finite.
 *
 *----------------------------------------------------------------------
 */
int
Tcl_LengthIsFinite(Tcl_Size length) {
    return length != TCL_LENGTH_NONE;
}


/*
 *------------------------------------------------------------------------
 *
 * TclIndexInvalidError --
 *
 *    Generates an error message including the invalid index.
 *
 * Results:
 *    Always return TCL_ERROR.
 *
 * Side effects:
 *    If interp is not-NULL, an error message is stored in it.
 *
 *------------------------------------------------------------------------
 */
int
TclIndexInvalidError (
    Tcl_Interp *interp,   /* May be NULL */
    const char *idxType,  /* The descriptive string for idx. Defaults to "index" */
    Tcl_Size idx)         /* Invalid index value */
{
    if (interp) {
	Tcl_SetObjResult(interp,
			 Tcl_ObjPrintf("Invalid %s value %" TCL_SIZE_MODIFIER "d.",
				       idxType ? idxType : "index",
				       idx));
    }
    return TCL_ERROR; /* Always */
}


/*
 *------------------------------------------------------------------------
 *
 * TclCommandWordLimitErrpr --
 *
 *    Generates an error message limit on number of command words exceeded.
 *
 * Results:
 *    Always return TCL_ERROR.
 *
 * Side effects:
 *    If interp is not-NULL, an error message is stored in it.
 *
 *------------------------------------------------------------------------
 */
int
TclCommandWordLimitError(
    Tcl_Interp *interp,   /* May be NULL */
    Tcl_Size count)       /* If <= 0, "unknown" */
    Tcl_Interp *interp,		/* May be NULL */
    Tcl_Size count)		/* If <= 0, "unknown" */
{
    if (interp) {
	if (count > 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "Number of words (%" TCL_SIZE_MODIFIER
		    "d) in command exceeds limit %" TCL_SIZE_MODIFIER "d.",
		    count, (Tcl_Size)INT_MAX));
4033
4034
4035
4036
4037
4038
4039
4040
4041


4042
4043
4044

4045
4046
4047
4048
4049
4050
4051
4121
4122
4123
4124
4125
4126
4127


4128
4129
4130
4131

4132
4133
4134
4135
4136
4137
4138
4139







-
-
+
+


-
+







 *----------------------------------------------------------------------
 */

static Tcl_HashTable *
GetThreadHash(
    Tcl_ThreadDataKey *keyPtr)
{
    Tcl_HashTable **tablePtrPtr =
	    (Tcl_HashTable **)Tcl_GetThreadData(keyPtr, sizeof(Tcl_HashTable *));
    Tcl_HashTable **tablePtrPtr = (Tcl_HashTable **)
	    Tcl_GetThreadData(keyPtr, sizeof(Tcl_HashTable *));

    if (NULL == *tablePtrPtr) {
	*tablePtrPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
	*tablePtrPtr = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_CreateThreadExitHandler(FreeThreadHash, *tablePtrPtr);
	Tcl_InitHashTable(*tablePtrPtr, TCL_ONE_WORD_KEYS);
    }
    return *tablePtrPtr;
}

/*
4235
4236
4237
4238
4239
4240
4241
4242

4243
4244
4245
4246
4247
4248
4249
4323
4324
4325
4326
4327
4328
4329

4330
4331
4332
4333
4334
4335
4336
4337







-
+







	/*
	 * If no thread has set the shared value, call the initializer.
	 */

	Tcl_MutexLock(&pgvPtr->mutex);
	if ((NULL == pgvPtr->value) && (pgvPtr->proc)) {
	    pgvPtr->epoch++;
	    pgvPtr->proc(&pgvPtr->value,&pgvPtr->numBytes,&pgvPtr->encoding);
	    pgvPtr->proc(&pgvPtr->value, &pgvPtr->numBytes, &pgvPtr->encoding);
	    if (pgvPtr->value == NULL) {
		Tcl_Panic("PGV Initializer did not initialize");
	    }
	    Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr);
	}

	/*
Changes to generic/tclVar.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
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

-
-
-
-
-
-
-
-










+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclVar.c --
 *
 *	This file contains routines that implement Tcl variables (both scalars
 *	and arrays).
 *
 *	The implementation of arrays is modelled after an initial
 *	implementation by Mark Diekhans and Karl Lehenbauer.
 *
 * Copyright © 1987-1994 The Regents of the University of California.
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 * Copyright © 1998-1999 Scriptics Corporation.
 * Copyright © 2001 Kevin B. Kenny. All rights reserved.
 * Copyright © 2007 Miguel Sofer
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclVar.c --
 *
 *	This file contains routines that implement Tcl variables (both scalars
 *	and arrays).
 *
 *	The implementation of arrays is modelled after an initial
 *	implementation by Mark Diekhans and Karl Lehenbauer.
 */

#include "tclInt.h"
#include "tclOOInt.h"

/*
 * Prototypes for the variable hash key methods.
 */

245
246
247
248
249
250
251
252

253
254
255
256
257
258
259
256
257
258
259
260
261
262

263
264
265
266
267
268
269
270







-
+







 *   twoPtrValue.ptr2:	pointer to the element name string (owned by this
 *			Tcl_Obj), or NULL if it is a scalar variable
 */

static const Tcl_ObjType localVarNameType = {
    "localVarName",
    FreeLocalVarName, DupLocalVarName, NULL, NULL,
    TCL_OBJTYPE_V0
    0
};

#define LocalSetInternalRep(objPtr, index, namePtr)			\
    do {								\
	Tcl_ObjInternalRep ir;						\
	Tcl_Obj *ptr = (namePtr);					\
	if (ptr) {Tcl_IncrRefCount(ptr);}				\
269
270
271
272
273
274
275
276

277
278
279
280
281
282
283
280
281
282
283
284
285
286

287
288
289
290
291
292
293
294







-
+







	(name) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL;	\
	(index) = irPtr ? PTR2INT(irPtr->twoPtrValue.ptr2) : TCL_INDEX_NONE; \
    } while (0)

static const Tcl_ObjType parsedVarNameType = {
    "parsedVarName",
    FreeParsedVarName, DupParsedVarName, NULL, NULL,
    TCL_OBJTYPE_V0
    0
};

#define ParsedSetInternalRep(objPtr, arrayPtr, elem)			\
    do {								\
	Tcl_ObjInternalRep ir;						\
	Tcl_Obj *ptr1 = (arrayPtr);					\
	Tcl_Obj *ptr2 = (elem);						\
340
341
342
343
344
345
346
347
348


349
350
351
352
353
354
355
351
352
353
354
355
356
357


358
359
360
361
362
363
364
365
366







-
-
+
+







static int
NotArrayError(
    Tcl_Interp *interp,
    Tcl_Obj *name)
{
    const char *nameStr = TclGetString(name);

    Tcl_SetObjResult(interp,
	    Tcl_ObjPrintf("\"%s\" isn't an array", nameStr));
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "\"%s\" isn't an array", nameStr));
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", nameStr, (char *)NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
600
601
602
603
604
605
606
607

608
609
610
611
612
613
614
611
612
613
614
615
616
617

618
619
620
621
622
623
624
625







-
+







    Var **arrayPtrPtr)		/* If the name refers to an element of an
				 * array, *arrayPtrPtr gets filled in with
				 * address of array variable. Otherwise this
				 * is set to NULL. */
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    Var *varPtr;	/* Points to the variable's in-frame Var
    Var *varPtr;		/* Points to the variable's in-frame Var
				 * structure. */
    const char *errMsg = NULL;
    int index, parsed = 0;

    Tcl_Size localIndex;
    Tcl_Obj *namePtr, *arrayPtr, *elem;

661
662
663
664
665
666
667
668

669
670
671
672
673
674
675
672
673
674
675
676
677
678

679
680
681
682
683
684
685
686







-
+








    if (!parsed) {
	/*
	 * part1Ptr is possibly an unparsed array element.
	 */

	Tcl_Size len;
	const char *part1 = TclGetStringFromObj(part1Ptr, &len);
	const char *part1 = Tcl_GetStringFromObj(part1Ptr, &len);

	if ((len > 1) && (part1[len - 1] == ')')) {
	    const char *part2 = strchr(part1, '(');

	    if (part2) {
		if (part2Ptr != NULL) {
		    if (flags & TCL_LEAVE_ERR_MSG) {
842
843
844
845
846
847
848
849
850
851



852
853
854
855
856
857
858
853
854
855
856
857
858
859



860
861
862
863
864
865
866
867
868
869







-
-
-
+
+
+







    TclVarHashTable *tablePtr;	/* Points to the hashtable, if any, in which
				 * to look up the variable. */
    Tcl_Var var;		/* Used to search for global names. */
    Var *varPtr;		/* Points to the Var structure returned for
				 * the variable. */
    Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr;
    ResolverScheme *resPtr;
    int isNew, result;
    Tcl_Size i, varLen;
    const char *varName = TclGetStringFromObj(varNamePtr, &varLen);
    int isNew ,result;
    Tcl_Size i ,varLen;
    const char *varName = Tcl_GetStringFromObj(varNamePtr, &varLen);

    varPtr = NULL;
    varNsPtr = NULL;		/* Set non-NULL if a nonlocal variable. */
    *indexPtr = -3;

    if (flags & TCL_GLOBAL_ONLY) {
	cxtNsPtr = iPtr->globalNsPtr;
979
980
981
982
983
984
985
986

987
988
989
990
991
992
993
990
991
992
993
994
995
996

997
998
999
1000
1001
1002
1003
1004







-
+







	    const char *localNameStr;
	    Tcl_Size localLen;

	    for (i=0 ; i<localCt ; i++, objPtrPtr++) {
		Tcl_Obj *objPtr = *objPtrPtr;

		if (objPtr) {
		    localNameStr = TclGetStringFromObj(objPtr, &localLen);
		    localNameStr = Tcl_GetStringFromObj(objPtr, &localLen);

		    if ((varLen == localLen) && (varName[0] == localNameStr[0])
			    && !memcmp(varName, localNameStr, varLen)) {
			*indexPtr = i;
			return (Var *) &varFramePtr->compiledLocals[i];
		    }
		}
1021
1022
1023
1024
1025
1026
1027
1028

1029
1030
1031
1032
1033
1034
1035
1032
1033
1034
1035
1036
1037
1038

1039
1040
1041
1042
1043
1044
1045
1046







-
+







 * TclLookupArrayElement --
 *
 *	This function is used to locate a variable which is in an array's
 *	hashtable given a pointer to the array's Var structure and the
 *	element's name.
 *
 * Results:
 *	The return value is a pointer to the variable structure , or NULL if
 *	The return value is a pointer to the variable structure, or NULL if
 *	the variable couldn't be found.
 *
 *	If arrayPtr points to a variable that isn't an array and createPart1
 *	is 1, the corresponding variable will be converted to an array.
 *	Otherwise, NULL is returned and an error message is left in the
 *	interp's result if TCL_LEAVE_ERR_MSG is set in flags.
 *
1486
1487
1488
1489
1490
1491
1492
1493

1494
1495
1496
1497
1498
1499
1500
1497
1498
1499
1500
1501
1502
1503

1504
1505
1506
1507
1508
1509
1510
1511







-
+







    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *varValueObj;

    if (objc == 2) {
	varValueObj = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG);
	varValueObj = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
	if (varValueObj == NULL) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, varValueObj);
	return TCL_OK;
    } else if (objc == 3) {
	varValueObj = Tcl_ObjSetVar2(interp, objv[1], NULL, objv[2],
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
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







-
+











-
+







    }

    /*
     * It's an error to try to set a constant.
     */
    if (TclIsVarConstant(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISCONST,index);
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISCONST, index);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "CONST", (void *)NULL);
	}
	goto earlyError;
    }

    /*
     * It's an error to try to set an array variable itself.
     */

    if (TclIsVarArray(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISARRAY,index);
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISARRAY, index);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", (char *)NULL);
	}
	goto earlyError;
    }

    TclVarFindHiddenArray(varPtr, arrayPtr);

2236
2237
2238
2239
2240
2241
2242
2243

2244
2245
2246
2247
2248
2249
2250
2247
2248
2249
2250
2251
2252
2253

2254
2255
2256
2257
2258
2259
2260
2261







-
+







    Tcl_Obj *varValuePtr;

    /*
     * It's an error to try to increment a constant.
     */
    if (TclIsVarConstant(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "incr", ISCONST,index);
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "incr", ISCONST, index);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "CONST", (void *)NULL);
	}
	return NULL;
    }

    if (TclIsVarInHash(varPtr)) {
	VarHashRefCount(varPtr)++;
2473
2474
2475
2476
2477
2478
2479
2480

2481
2482
2483
2484
2485
2486
2487
2484
2485
2486
2487
2488
2489
2490

2491
2492
2493
2494
2495
2496
2497
2498







-
+







    Var *initialArrayPtr = arrayPtr;

    /*
     * It's an error to try to unset a constant.
     */
    if (TclIsVarConstant(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset", ISCONST,index);
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset", ISCONST, index);
	    Tcl_SetErrorCode(interp, "TCL", "UNSET", "CONST", (void *)NULL);
	}
	return TCL_ERROR;
    }

    /*
     * Keep the variable alive until we're done with it. We used to
2625
2626
2627
2628
2629
2630
2631
2632
2633


2634
2635
2636
2637
2638
2639
2640
2641
2636
2637
2638
2639
2640
2641
2642


2643
2644

2645
2646
2647
2648
2649
2650
2651







-
-
+
+
-







		flags |= VAR_ARRAY_ELEMENT;
	    } else if (TclIsVarArrayElement(varPtr)) {
		part2Ptr = VarHashGetKey(varPtr);
	    }

	    dummyVar.flags &= ~VAR_TRACE_ACTIVE;
	    TclObjCallVarTraces(iPtr, arrayPtr, &dummyVar, part1Ptr, part2Ptr,
	      (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|VAR_ARRAY_ELEMENT))
			    | TCL_TRACE_UNSETS,
		(flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|VAR_ARRAY_ELEMENT))
		    | TCL_TRACE_UNSETS, /* leaveErrMsg */ 0, index);
		    /* leaveErrMsg */ 0, index);

	    /*
	     * The traces that we just called may have triggered a change in
	     * the set of traces. If so, reload the traces to manipulate.
	     */

	    tracePtr = NULL;
2809
2810
2811
2812
2813
2814
2815
2816

2817
2818
2819
2820
2821
2822
2823
2819
2820
2821
2822
2823
2824
2825

2826
2827
2828
2829
2830
2831
2832
2833







-
+








    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?");
	return TCL_ERROR;
    }

    if (objc == 2) {
	varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG);
	varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
	if (varValuePtr == NULL) {
	    return TCL_ERROR;
	}
    } else {
	varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
		"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
	if (varPtr == NULL) {
3131
3132
3133
3134
3135
3136
3137
3138

3139
3140
3141
3142
3143
3144
3145
3141
3142
3143
3144
3145
3146
3147

3148
3149
3150
3151
3152
3153
3154
3155







-
+







    ArrayPopulateSearch(interp, arrayNameObj, varPtr, searchPtr);

    /*
     * Make sure that these objects (which we need throughout the body of the
     * loop) don't vanish.
     */

    varListObj = TclListObjCopy(NULL, objv[1]);
    varListObj = TclDuplicatePureObj(interp, objv[1], tclListTypePtr);
    if (!varListObj) {
	return TCL_ERROR;
    }
    scriptObj = objv[3];
    Tcl_IncrRefCount(scriptObj);

    /*
4030
4031
4032
4033
4034
4035
4036
4037

4038
4039
4040
4041
4042
4043
4044
4040
4041
4042
4043
4044
4045
4046

4047
4048
4049
4050
4051
4052
4053
4054







-
+







    }

    /*
     * Install the contents of the dictionary or list into the array.
     */

    arrayElemObj = objv[2];
    if (TclHasInternalRep(arrayElemObj, &tclDictType) && arrayElemObj->bytes == NULL) {
    if (TclHasInternalRep(arrayElemObj, tclDictTypePtr) && arrayElemObj->bytes == NULL) {
	Tcl_Obj *keyPtr, *valuePtr;
	Tcl_DictSearch search;
	int done;
	Tcl_Size size;

	if (Tcl_DictObjSize(interp, arrayElemObj, &size) != TCL_OK) {
	    return TCL_ERROR;
4107
4108
4109
4110
4111
4112
4113
4114


4115
4116
4117
4118
4119
4120
4121
4117
4118
4119
4120
4121
4122
4123

4124
4125
4126
4127
4128
4129
4130
4131
4132







-
+
+








	/*
	 * We needn't worry about traces invalidating arrayPtr: should that be
	 * the case, TclPtrSetVarIdx will return NULL so that we break out of
	 * the loop and return an error.
	 */

	copyListObj = TclListObjCopy(NULL, arrayElemObj);
	copyListObj =
	    TclDuplicatePureObj(interp, arrayElemObj, tclListTypePtr);
	if (!copyListObj) {
	    return TCL_ERROR;
	}
	for (i=0 ; i<elemLen ; i+=2) {
	    Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
		    elemPtrs[i], TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);

4297
4298
4299
4300
4301
4302
4303
4304

4305
4306
4307
4308
4309
4310
4311
4308
4309
4310
4311
4312
4313
4314

4315
4316
4317
4318
4319
4320
4321
4322







-
+







    int objc,
    Tcl_Obj *const objv[])
{
    Var *varPtr, *varPtr2, *protectedVarPtr;
    Tcl_Obj *varNameObj, *patternObj, *nameObj;
    Tcl_HashSearch search;
    const char *pattern;
    int unsetFlags = 0;	/* Should this be TCL_LEAVE_ERR_MSG? */
    int unsetFlags = 0;		/* Should this be TCL_LEAVE_ERR_MSG? */
    int isArray;

    switch (objc) {
    case 2:
	varNameObj = objv[1];
	patternObj = NULL;
	break;
4522
4523
4524
4525
4526
4527
4528
4529
4530


4531
4532
4533
4534
4535
4536
4537
4533
4534
4535
4536
4537
4538
4539


4540
4541
4542
4543
4544
4545
4546
4547
4548







-
-
+
+







     * local variable in a procedure. If we allowed this, the local
     * variable in the shorter-lived procedure frame could go away leaving
     * the namespace var's reference invalid.
     */

    if (index < 0) {
	if (!(arrayPtr != NULL
		     ? (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr))
		     : (TclIsVarInHash(otherPtr) && TclGetVarNsPtr(otherPtr)))
		    ? (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr))
		    : (TclIsVarInHash(otherPtr) && TclGetVarNsPtr(otherPtr)))
		&& ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
			|| (varFramePtr == NULL)
			|| !HasLocalVars(varFramePtr)
			|| (strstr(TclGetString(myNamePtr), "::") != NULL))) {
	    Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
		    "bad variable name \"%s\": can't create namespace "
		    "variable that refers to procedure variable",
5606
5607
5608
5609
5610
5611
5612
5613

5614
5615
5616
5617
5618
5619
5620
5617
5618
5619
5620
5621
5622
5623

5624
5625
5626
5627
5628
5629
5630
5631







-
+







	     */

	    if (elPtr->flags & VAR_TRACED_UNSET) {
		Tcl_Obj *elNamePtr = VarHashGetKey(elPtr);

		elPtr->flags &= ~VAR_TRACE_ACTIVE;
		TclObjCallVarTraces(iPtr, NULL, elPtr, arrayNamePtr,
			elNamePtr, flags,/* leaveErrMsg */ 0, index);
			elNamePtr, flags, /* leaveErrMsg */ 0, index);
	    }
	    tPtr = Tcl_FindHashEntry(&iPtr->varTraces, elPtr);
	    tracePtr = (VarTrace *)Tcl_GetHashValue(tPtr);
	    while (tracePtr) {
		VarTrace *prevPtr = tracePtr;

		tracePtr = tracePtr->nextPtr;
Changes to generic/tclZipfs.c.
1
2
3
4
5
6
7
8
9
10
11
















12
13
14
15
16
17
18
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

-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclZipfs.c --
 *
 *	Implementation of the ZIP filesystem used in TIP 430
 *	Adapted from the implementation for AndroWish.
 *
 * Copyright © 2016-2017 Sean Woods <yoda@etoyoc.com>
 * Copyright © 2013-2015 Christian Werner <chw@ch-werner.de>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclZipfs.c --
 *
 *	Implementation of the ZIP filesystem used in TIP 430
 *	Adapted from the implementation for AndroWish.
 *
 * This file is distributed in two ways:
 *   generic/tclZipfs.c file in the TIP430-enabled Tcl cores.
 *   compat/tclZipfs.c file in the tclconfig (TEA) file system, for pre-tip430
 *	projects.
 *
 * Helpful docs:
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
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







-
+


-
+
+






-
-
+
+


-
+






-
+


-
+
+












-
-
-
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+





-
+


+
+
+
+
+
+
+
+
+
+



-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+
+
+

-
-
+
+
+
+

-
-
+
+
+
+
+
+
+
+







#include <dlfcn.h>
#endif

/*
 * Macros to report errors only if an interp is present.
 */

#define ZIPFS_ERROR(interp,errstr) \
#define ZIPFS_ERROR(interp, errstr) \
    do {								\
	if (interp) {							\
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(errstr, -1));	\
	    Tcl_SetObjResult(interp,					\
		    Tcl_NewStringObj(errstr, TCL_AUTO_LENGTH));		\
	}								\
    } while (0)
#define ZIPFS_MEM_ERROR(interp) \
    do {								\
	if (interp) {							\
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(			\
		    "out of memory", -1));				\
	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", (char *)NULL);		\
		    "out of memory", TCL_AUTO_LENGTH));			\
	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", (char *)NULL);	\
	}								\
    } while (0)
#define ZIPFS_POSIX_ERROR(interp,errstr) \
#define ZIPFS_POSIX_ERROR(interp, errstr) \
    do {								\
	if (interp) {							\
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(			\
		    "%s: %s", errstr, Tcl_PosixError(interp)));		\
	}								\
    } while (0)
#define ZIPFS_ERROR_CODE(interp,errcode) \
#define ZIPFS_ERROR_CODE(interp, errcode) \
    do {								\
	if (interp) {							\
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", errcode, (char *)NULL);	\
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", errcode,		\
		    (char *)NULL);					\
	}								\
    } while (0)

#ifdef HAVE_ZLIB
#include "zlib.h"
#include "crypt.h"
#include "zutil.h"
#include "crc32.h"

static const z_crc_t* crc32tab;

/*
** We are compiling as part of the core.
** TIP430 style zipfs prefix
*/
 * We are compiling as part of the core.
 * TIP430 style zipfs prefix
 */

#define ZIPFS_VOLUME	  "//zipfs:/"
#define ZIPFS_ROOTDIR_DEPTH 3 /* Number of / in root mount */
#define ZIPFS_VOLUME_LEN  9
#define ZIPFS_APP_MOUNT	  ZIPFS_VOLUME "app"
#define ZIPFS_ZIP_MOUNT	  ZIPFS_VOLUME "lib/tcl"
#define ZIPFS_FALLBACK_ENCODING "cp437"
#define ZIPFS_VOLUME		"//zipfs:/"
#define ZIPFS_ROOTDIR_DEPTH	3	/* Number of / in root mount */
#define ZIPFS_VOLUME_LEN	9
#define ZIPFS_APP_MOUNT		ZIPFS_VOLUME "app"
#define ZIPFS_ZIP_MOUNT		ZIPFS_VOLUME "lib/tcl"
#define ZIPFS_FALLBACK_ENCODING	"cp437"

/* What's the magic about 64 * 1024 * 1024 ? Is it where ZIP64 is needed? */
#define ZIPFS_MAX_DIR_SIZE	(64 * 1024 * 1024)
#define ZIPFS_PASSBUF_SIZE	264

/*
 * Various constants and offsets found in ZIP archive files
 */

#define ZIP_SIG_LEN			4
#define ZIP_SIG_LEN		4

/*
 * The ZIP format is based on a number of structures, logically a ZipCentral
 * that points to a list of CentralHeaders that in turn point to LocalHeaders
 * that point to the data. However, we don't write those structures out
 * explicitly because we firstly MUST read them all as little-endian data,
 * secondly they're structures that are packed very tightly, and thirdly they
 * have multiple blocks of data attached to them, which C supports poorly
 * (along with many other languages). So instead we have a collection of
 * offsets instead, all of which are relative to the signature field of each
 * structure (which is always first).
 *
 * Local header of ZIP archive member (at very beginning of each member).
 */

#define ZIP_LOCAL_HEADER_SIG		0x04034b50
#define ZIP_LOCAL_HEADER_SIG	0x04034b50
#define ZIP_LOCAL_HEADER_LEN		30
#define ZIP_LOCAL_SIG_OFFS		0
#define ZIP_LOCAL_VERSION_OFFS		4
#define ZIP_LOCAL_FLAGS_OFFS		6
#define ZIP_LOCAL_COMPMETH_OFFS		8
#define ZIP_LOCAL_MTIME_OFFS		10
#define ZIP_LOCAL_MDATE_OFFS		12
#define ZIP_LOCAL_CRC32_OFFS		14
#define ZIP_LOCAL_COMPLEN_OFFS		18
#define ZIP_LOCAL_UNCOMPLEN_OFFS	22
#define ZIP_LOCAL_PATHLEN_OFFS		26
#define ZIP_LOCAL_EXTRALEN_OFFS		28
enum ZipLocalHeaderOffsets {
    LOCAL_SIG = 0,		// LocalHeader.signature
    LOCAL_VERSION = 4,		// LocalHeader.version
    LOCAL_FLAGS = 6,		// LocalHeader.flags
    LOCAL_COMPMETH = 8,		// LocalHeader.compressionMethod
    LOCAL_MTIME = 10,		// LocalHeader.modifiedTime
    LOCAL_MDATE = 12,		// LocalHeader.modifiedDate
    LOCAL_CRC32 = 14,		// LocalHeader.crc32
    LOCAL_COMPLEN = 18,		// LocalHeader.compressedLength
    LOCAL_UNCOMPLEN = 22,	// LocalHeader.uncompressedLength
    LOCAL_PATHLEN = 26,		// LocalHeader.pathLength
    LOCAL_EXTRALEN = 28,	// LocalHeader.extraDataLength
    LOCAL_HEADER_LEN = 30	// sizeof(LocalHeader)
};

#define ZIP_LOCAL_FLAGS_UTF8		0x0800
#define ZIP_LOCAL_FLAGS_UTF8	0x0800

/*
 * Central header of ZIP archive member at end of ZIP file.
 */

#define ZIP_CENTRAL_HEADER_SIG		0x02014b50
#define ZIP_CENTRAL_HEADER_LEN		46
#define ZIP_CENTRAL_SIG_OFFS		0
#define ZIP_CENTRAL_VERSIONMADE_OFFS	4
#define ZIP_CENTRAL_VERSION_OFFS	6
#define ZIP_CENTRAL_FLAGS_OFFS		8
#define ZIP_CENTRAL_COMPMETH_OFFS	10
#define ZIP_CENTRAL_MTIME_OFFS		12
#define ZIP_CENTRAL_MDATE_OFFS		14
#define ZIP_CENTRAL_CRC32_OFFS		16
#define ZIP_CENTRAL_COMPLEN_OFFS	20
#define ZIP_CENTRAL_UNCOMPLEN_OFFS	24
#define ZIP_CENTRAL_PATHLEN_OFFS	28
#define ZIP_CENTRAL_EXTRALEN_OFFS	30
#define ZIP_CENTRAL_FCOMMENTLEN_OFFS	32
#define ZIP_CENTRAL_DISKFILE_OFFS	34
#define ZIP_CENTRAL_IATTR_OFFS		36
#define ZIP_CENTRAL_EATTR_OFFS		38
#define ZIP_CENTRAL_LOCALHDR_OFFS	42
#define ZIP_CENTRAL_HEADER_SIG	0x02014b50
enum ZipCentralHeaderOffsets {
    CENTRAL_SIG = 0,		// CentralHeader.signature
    CENTRAL_VERSIONMADE = 4,	// CentralHeader.versionMade
    CENTRAL_VERSION = 6,	// CentralHeader.version
    CENTRAL_FLAGS = 8,		// CentralHeader.flags
    CENTRAL_COMPMETH = 10,	// CentralHeader.compressionMethod
    CENTRAL_MTIME = 12,		// CentralHeader.modifiedTime
    CENTRAL_MDATE = 14,		// CentralHeader.modifiedDate
    CENTRAL_CRC32 = 16,		// CentralHeader.crc32
    CENTRAL_COMPLEN = 20,	// CentralHeader.compressedLength
    CENTRAL_UNCOMPLEN = 24,	// CentralHeader.uncompressedLength
    CENTRAL_PATHLEN = 28,	// CentralHeader.pathLength
    CENTRAL_EXTRALEN = 30,	// CentralHeader.extraDataLength
    CENTRAL_FCOMMENTLEN = 32,	// CentralHeader.commentLength
    CENTRAL_DISKFILE = 34,	// CentralHeader.diskFile
    CENTRAL_IATTR = 36,		// CentralHeader.interalAttributes
    CENTRAL_EATTR = 38,		// CentralHeader.externalAttributes
    CENTRAL_LOCALHDR = 42,	// CentralHeader.localHeader
    CENTRAL_HEADER_LEN = 46	// sizeof(CentralHeader)
};

/*
 * Central end signature at very end of ZIP file.
 */

#define ZIP_CENTRAL_END_SIG		0x06054b50
#define ZIP_CENTRAL_END_LEN		22
#define ZIP_CENTRAL_END_SIG_OFFS	0
#define ZIP_CENTRAL_DISKNO_OFFS		4
#define ZIP_CENTRAL_DISKDIR_OFFS	6
#define ZIP_CENTRAL_ENTS_OFFS		8
#define ZIP_CENTRAL_TOTALENTS_OFFS	10
#define ZIP_CENTRAL_DIRSIZE_OFFS	12
#define ZIP_CENTRAL_DIRSTART_OFFS	16
#define ZIP_CENTRAL_COMMENTLEN_OFFS	20
#define ZIP_CENTRAL_END_SIG	0x06054b50
enum ZipCentralSignatureOffsets {
    CENTRAL_END_SIG = 0,	// ZipCentral.endSignature
    CENTRAL_DISKNO = 4,		// ZipCentral.diskNumber
    CENTRAL_DISKDIR = 6,	// ZipCentral.diskDirectory
    CENTRAL_ENTS = 8,		// ZipCentral.diskEntries
    CENTRAL_TOTALENTS = 10,	// ZipCentral.totalEntries
    CENTRAL_DIRSIZE = 12,	// ZipCentral.directorySize
    CENTRAL_DIRSTART = 16,	// ZipCentral.directoryStart
    CENTRAL_COMMENTLEN = 20,	// ZipCentral.commentLength
    CENTRAL_END_LEN = 22	// sizeof(ZipCentral)
};

#define ZIP_MIN_VERSION			20
#define ZIP_COMPMETH_STORED		0
#define ZIP_COMPMETH_DEFLATED		8
#define ZIP_MIN_VERSION		20
enum ZipCompressionMethods {
    ZIP_COMPMETH_STORED = 0,
    ZIP_COMPMETH_DEFLATED = 8
};

#define ZIP_PASSWORD_END_SIG		0x5a5a4b50
#define ZIP_CRYPT_HDR_LEN		12
#define ZIP_PASSWORD_END_SIG	0x5a5a4b50
enum ZipCryptOffsets {
    ZIP_CRYPT_HDR_LEN = 12	// sizeof(ZipCrypt)
};

#define ZIP_MAX_FILE_SIZE		INT_MAX
#define DEFAULT_WRITE_MAX_SIZE		ZIP_MAX_FILE_SIZE
#define ZIP_MAX_FILE_SIZE	INT_MAX
#define DEFAULT_WRITE_MAX_SIZE	ZIP_MAX_FILE_SIZE

/*
 * The ZIP deflated compression method requires a raw zlib (de)compressor.
 * No header required; the ZIP format has its own.
 */
#define ZLIB_MODE_RAW		(-15)

/*
 * Mutex to protect localtime(3) when no reentrant version available.
 */

#if !defined(_WIN32) && !defined(HAVE_LOCALTIME_R) && TCL_THREADS
TCL_DECLARE_MUTEX(localtimeMutex)
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
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







-
-
+
+
+
















+
+













-
-
-




+
+
+
+
+
+







    unsigned char *data;	/* Memory mapped or malloc'ed file */
    size_t length;		/* Length of memory mapped file */
    void *ptrToFree;		/* Non-NULL if malloc'ed file */
    size_t numFiles;		/* Number of files in archive */
    size_t baseOffset;		/* Archive start */
    size_t passOffset;		/* Password start */
    size_t directoryOffset;	/* Archive directory start */
    size_t directorySize;       /* Size of archive directory */
    unsigned char passBuf[264]; /* Password buffer */
    size_t directorySize;	/* Size of archive directory */
    unsigned char passBuf[ZIPFS_PASSBUF_SIZE];
				/* Password buffer */
    size_t numOpen;		/* Number of open files on archive */
    struct ZipEntry *entries;	/* List of files in archive */
    struct ZipEntry *topEnts;	/* List of top-level dirs in archive */
    char *mountPoint;		/* Mount point name */
    Tcl_Size mountPointLen;	/* Length of mount point name */
#ifdef _WIN32
    HANDLE mountHandle;		/* Handle used for direct file access. */
#endif /* _WIN32 */
} ZipFile;

/*
 * In-core description of file contained in mounted ZIP archive.
 */

typedef struct ZipEntry {
    char *name;			/* The full pathname of the virtual file */
    Tcl_Size nameLen;		/* Length of name field. TCL_AUTO_LENGTH if not
				 * yet computed. */
    ZipFile *zipFilePtr;	/* The ZIP file holding this virtual file */
    size_t offset;		/* Data offset into memory mapped ZIP file */
    int numBytes;		/* Uncompressed size of the virtual file.
				 * -1 for zip64 */
    int numCompressedBytes;	/* Compressed size of the virtual file.
				 * -1 for zip64 */
    int compressMethod;		/* Compress method */
    int isDirectory;		/* 0 if file, 1 if directory, -1 if root */
    int depth;			/* Number of slashes in path. */
    int crc32;			/* CRC-32 as stored in ZIP */
    int timestamp;		/* Modification time */
    int isEncrypted;		/* True if data is encrypted */
    int flags;
#define ZE_F_CRC_COMPARED      0x0001  /* If 1, the CRC has been compared. */
#define ZE_F_CRC_CORRECT       0x0002  /* Only meaningful if ZE_F_CRC_COMPARED is 1 */
#define ZE_F_VOLUME            0x0004  /* Entry corresponds to //zipfs:/ */
    unsigned char *data;	/* File data if written */
    struct ZipEntry *next;	/* Next file in the same archive */
    struct ZipEntry *tnext;	/* Next top-level dir in archive */
} ZipEntry;

enum ZipEntryFlags {
    ZE_F_CRC_COMPARED = 1,	/* If 1, the CRC has been compared. */
    ZE_F_CRC_CORRECT = 2,	/* Only meaningful if ZE_F_CRC_COMPARED is 1 */
    ZE_F_VOLUME = 4		/* Entry corresponds to //zipfs:/ */
};

/*
 * File channel for file contained in mounted ZIP archive.
 *
 * Regarding data buffers:
 * For READ-ONLY files that are not encrypted and not compressed (zip STORE
 * method), ubuf points directly to the mapped zip file data in memory. No
255
256
257
258
259
260
261
262
263
264



265
266

267
268
269
270
271
272
273
304
305
306
307
308
309
310



311
312
313
314

315
316
317
318
319
320
321
322







-
-
-
+
+
+

-
+







typedef struct ZipChannel {
    ZipFile *zipFilePtr;	/* The ZIP file holding this channel */
    ZipEntry *zipEntryPtr;	/* Pointer back to virtual file */
    Tcl_Size maxWrite;		/* Maximum size for write */
    Tcl_Size numBytes;		/* Number of bytes of uncompressed data */
    Tcl_Size cursor;		/* Seek position for next read or write*/
    unsigned char *ubuf;	/* Pointer to the uncompressed data */
    unsigned char *ubufToFree;  /* NULL if ubuf points to memory that does not
				   need freeing. Else memory to free (ubuf
				   may point *inside* the block) */
    unsigned char *ubufToFree;	/* NULL if ubuf points to memory that does not
				 * need freeing. Else memory to free (ubuf
				 * may point *inside* the block) */
    Tcl_Size ubufSize;		/* Size of allocated ubufToFree */
    int iscompr;                /* True if data is compressed */
    int isCompressed;		/* True if data is compressed */
    int isDirectory;		/* Set to 1 if directory, or -1 if root */
    int isEncrypted;		/* True if data is encrypted */
    int mode;			/* O_WRITE, O_APPEND, O_TRUNC etc.*/
    unsigned long keys[3];	/* Key for decryption */
} ZipChannel;

static inline int
286
287
288
289
290
291
292
293

294
295
296
297
298
299
300
335
336
337
338
339
340
341

342
343
344
345
346
347
348
349







-
+







 * The "fileHash" component is the process-wide global table of all known ZIP
 * archive members in all mounted ZIP archives.
 *
 * The "zipHash" components is the process wide global table of all mounted
 * ZIP archive files.
 */

static struct {
static struct ZipFSGlobals {
    int initialized;		/* True when initialized */
    int lock;			/* RW lock, see below */
    int waiters;		/* RW lock, see below */
    int wrmax;			/* Maximum write size of a file; only written
				 * to from Tcl code in a trusted interpreter,
				 * so NOT protected by mutex. */
    char *fallbackEntryEncoding;/* The fallback encoding for ZIP entries when
327
328
329
330
331
332
333
334

335
336
337
338
339
340
341
376
377
378
379
380
381
382

383
384
385
386
387
388
389
390







-
+







static int		DescribeMounted(Tcl_Interp *interp,
			    const char *mountPoint);
static int		InitReadableChannel(Tcl_Interp *interp,
			    ZipChannel *info, ZipEntry *z);
static int		InitWritableChannel(Tcl_Interp *interp,
			    ZipChannel *info, ZipEntry *z, int trunc);
static int		ListMountPoints(Tcl_Interp *interp);
static int		ContainsMountPoint(const char *path, int pathLen);
static int		ContainsMountPoint(const char *path, Tcl_Size pathLen);
static void		CleanupMount(ZipFile *zf);
static Tcl_Obj *	ScriptLibrarySetup(const char *dirName);
static void		SerializeCentralDirectoryEntry(
			    const unsigned char *start,
			    const unsigned char *end, unsigned char *buf,
			    ZipEntry *z, size_t nameLength);
static void		SerializeCentralDirectorySuffix(
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
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







-
+
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+



-
-
-
-
-
-
-
-
-
-



-
+
-

-
+
-
-
+
-
-
+
-
-
+
-







			    unsigned char cryptHdr[ZIP_CRYPT_HDR_LEN]);
static int		DecodeCryptHeader(Tcl_Interp *interp, ZipEntry *z,
			    unsigned long keys[3],
			    unsigned char cryptHdr[ZIP_CRYPT_HDR_LEN]);
#if !defined(STATIC_BUILD)
static int		ZipfsAppHookFindTclInit(const char *archive);
#endif
static int		ZipFSPathInFilesystemProc(Tcl_Obj *pathPtr,
static Tcl_FSPathInFilesystemProc	ZipFSPathInFilesystemProc;
			    void **clientDataPtr);
static Tcl_Obj *	ZipFSFilesystemPathTypeProc(Tcl_Obj *pathPtr);
static Tcl_Obj *	ZipFSFilesystemSeparatorProc(Tcl_Obj *pathPtr);
static int		ZipFSStatProc(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
static int		ZipFSAccessProc(Tcl_Obj *pathPtr, int mode);
static Tcl_Channel	ZipFSOpenFileChannelProc(Tcl_Interp *interp,
static Tcl_FSFilesystemPathTypeProc	ZipFSFilesystemPathTypeProc;
static Tcl_FSFilesystemSeparatorProc	ZipFSFilesystemSeparatorProc;
static Tcl_FSStatProc			ZipFSStatProc;
static Tcl_FSAccessProc			ZipFSAccessProc;
static Tcl_FSOpenFileChannelProc	ZipFSOpenFileChannelProc;
			    Tcl_Obj *pathPtr, int mode, int permissions);
static int		ZipFSMatchInDirectoryProc(Tcl_Interp *interp,
			    Tcl_Obj *result, Tcl_Obj *pathPtr,
			    const char *pattern, Tcl_GlobTypeData *types);
static Tcl_FSMatchInDirectoryProc	ZipFSMatchInDirectoryProc;
static Tcl_FSListVolumesProc		ZipFSListVolumesProc;
static Tcl_FSFileAttrStringsProc	ZipFSFileAttrStringsProc;
static Tcl_FSFileAttrsGetProc		ZipFSFileAttrsGetProc;
static Tcl_FSFileAttrsSetProc		ZipFSFileAttrsSetProc;
static Tcl_FSLoadFileProc2		ZipFSLoadFile;
static void		ZipFSMatchMountPoints(Tcl_Obj *result,
			    Tcl_Obj *normPathPtr, const char *pattern,
			    Tcl_DString *prefix);
static Tcl_Obj *	ZipFSListVolumesProc(void);
static const char *const *ZipFSFileAttrStringsProc(Tcl_Obj *pathPtr,
			    Tcl_Obj **objPtrRef);
static int		ZipFSFileAttrsGetProc(Tcl_Interp *interp, int index,
			    Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef);
static int		ZipFSFileAttrsSetProc(Tcl_Interp *interp, int index,
			    Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
static int		ZipFSLoadFile(Tcl_Interp *interp, Tcl_Obj *path,
			    Tcl_LoadHandle *loadHandle,
			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
static int		ZipMapArchive(Tcl_Interp *interp, ZipFile *zf,
			    void *handle);
static void		ZipfsSetup(void);
static int		ZipChannelClose(void *instanceData,
static Tcl_DriverClose2Proc	ZipChannelClose;
			    Tcl_Interp *interp, int flags);
static Tcl_DriverGetHandleProc	ZipChannelGetFile;
static int		ZipChannelRead(void *instanceData, char *buf,
static Tcl_DriverInputProc	ZipChannelRead;
			    int toRead, int *errloc);
static long long	ZipChannelWideSeek(void *instanceData,
static Tcl_DriverWideSeekProc	ZipChannelWideSeek;
			    long long offset, int mode, int *errloc);
static void		ZipChannelWatchChannel(void *instanceData,
static Tcl_DriverWatchProc	ZipChannelWatchChannel;
			    int mask);
static int		ZipChannelWrite(void *instanceData,
static Tcl_DriverOutputProc	ZipChannelWrite;
			    const char *buf, int toWrite, int *errloc);

/*
 * Define the ZIP filesystem dispatch table.
 */

static const Tcl_Filesystem zipfsFilesystem = {
    "zipfs",
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
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+


-
-
+
+


-
+








-
+



-
-
+
+






-
+







    NULL,			/* Thread action function. */
    NULL,			/* Truncate function. */
};

/*
 *------------------------------------------------------------------------
 *
 * HasVolumePrefix --
 *
 *	Test to see if the given path is prefixed with our standard volume
 *	label.
 *
 * Results:
 *	A true value if the volume label is a prefix.
 *
 * Side effects:
 *	None.
 *
 *------------------------------------------------------------------------
 */
static inline int
HasVolumePrefix(
    const char *path)
{
    TCL_CT_ASSERT(sizeof(ZIPFS_VOLUME) == ZIPFS_VOLUME_LEN + 1);
    return !strncmp(ZIPFS_VOLUME, path, ZIPFS_VOLUME_LEN);
}

/*
 *------------------------------------------------------------------------
 *
 * ZipEntryNameLength --
 *
 *	Get the length of the name of a zip entry.
 *
 * Results:
 *	The length of the name.
 *
 * Side effects:
 *	Computes and caches the length of the name if it has not already been
 *	determined.
 *
 *------------------------------------------------------------------------
 */
static inline Tcl_Size
ZipEntryNameLength(
    ZipEntry *z)
{
    if (z->nameLen < 0) {
	z->nameLen = strlen(z->name);
    }
    return z->nameLen;
}

/*
 *------------------------------------------------------------------------
 *
 * TclIsZipfsPath --
 *
 *    Checks if the passed path has a zipfs volume prefix.
 *	Checks if the passed path has a zipfs volume prefix.
 *
 * Results:
 *    0 if not a zipfs path
 *    else the length of the zipfs volume prefix
 *	0 if not a zipfs path
 *	else the length of the zipfs volume prefix
 *
 * Side effects:
 *    None.
 *	None.
 *
 *------------------------------------------------------------------------
 */
int
TclIsZipfsPath(
    const char *path)
{
#ifdef _WIN32
    return strncmp(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN) ? 0 : ZIPFS_VOLUME_LEN;
    return HasVolumePrefix(path) ? ZIPFS_VOLUME_LEN : 0;
#else
    int i;
    for (i = 0; i < ZIPFS_VOLUME_LEN; ++i) {
	if (path[i] != ZIPFS_VOLUME[i] &&
		(path[i] != '\\' || ZIPFS_VOLUME[i] != '/')) {
	if (path[i] != ZIPFS_VOLUME[i]
		&& (path[i] != '\\' || ZIPFS_VOLUME[i] != '/')) {
	    return 0;
	}
    }
    return ZIPFS_VOLUME_LEN;
#endif
}


/*
 *-------------------------------------------------------------------------
 *
 * ZipReadInt, ZipReadShort, ZipWriteInt, ZipWriteShort --
 *
 *	Inline functions to read and write little-endian 16 and 32 bit
 *	integers from/to buffers representing parts of ZIP archives.
558
559
560
561
562
563
564
565

566
567
568
569
570
571
572
643
644
645
646
647
648
649

650
651
652
653
654
655
656
657







-
+







    if (ptr < bufferStart || ptr + 2 > bufferEnd) {
	Tcl_Panic("out of bounds write(2): start=%p, end=%p, ptr=%p",
		bufferStart, bufferEnd, ptr);
    }
    ptr[0] = value & 0xff;
    ptr[1] = (value >> 8) & 0xff;
}


/*
 *-------------------------------------------------------------------------
 *
 * ReadLock, WriteLock, Unlock --
 *
 *	POSIX like rwlock functions to support multiple readers and single
 *	writer on internal structs.
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
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







-
+


-
+


-
+




















+














-
+





-
+


-
+


-
-
+
+







}

/*
 *------------------------------------------------------------------------
 *
 * IsCryptHeaderValid --
 *
 *    Computes the validity of the encryption header CRC for a ZipEntry.
 *	Computes the validity of the encryption header CRC for a ZipEntry.
 *
 * Results:
 *    Returns 1 if the header is valid else 0.
 *	Returns 1 if the header is valid else 0.
 *
 * Side effects:
 *    None.
 *	None.
 *
 *------------------------------------------------------------------------
 */
static int
IsCryptHeaderValid(
    ZipEntry *z,
    unsigned char cryptHeader[ZIP_CRYPT_HDR_LEN])
{
    /*
     * There are multiple possibilities. The last one or two bytes of the
     * encryption header should match the last one or two bytes of the
     * CRC of the file. Or the last byte of the encryption header should
     * be the high order byte of the file time. Depending on the archiver
     * and version, any of the might be in used. We follow libzip in checking
     * only one byte against both the crc and the time. Note that by design
     * the check generates high number of false positives in any case.
     * Also, in case a check is passed when it should not, the final CRC
     * calculation will (should) catch it. Only difference is it will be
     * reported as a corruption error instead of incorrect password.
     */

    int dosTime = ToDosTime(z->timestamp);
    if (cryptHeader[11] == (unsigned char)(dosTime >> 8)) {
	/* Infozip style - Tested with test-password.zip */
	return 1;
    }
    /* DOS time did not match, may be CRC does */
    if (z->crc32) {
	/* Pkware style - Tested with test-password2.zip */
	return (cryptHeader[11] == (unsigned char)(z->crc32 >> 24));
    }

    /* No CRC, no way to verify. Assume valid */
    return 1;
}


/*
 *------------------------------------------------------------------------
 *
 * DecodeCryptHeader --
 *
 *    Decodes the crypt header and validates it.
 *	Decodes the crypt header and validates it.
 *
 * Results:
 *    TCL_OK on success, TCL_ERROR on failure.
 *	TCL_OK on success, TCL_ERROR on failure.
 *
 * Side effects:
 *    On success, keys[] are updated. On failure, an error message is
 *    left in interp if not NULL.
 *	On success, keys[] are updated. On failure, an error message is
 *	left in interp if not NULL.
 *
 *------------------------------------------------------------------------
 */
static int
DecodeCryptHeader(
    Tcl_Interp *interp,
    ZipEntry *z,
841
842
843
844
845
846
847
848

849
850
851
852
853
854
855
927
928
929
930
931
932
933

934
935
936
937
938
939
940
941







-
+







    if (!IsCryptHeaderValid(z, encheader)) {
	ZIPFS_ERROR(interp, "invalid password");
	ZIPFS_ERROR_CODE(interp, "PASSWORD");
	return TCL_ERROR;
    }
    return TCL_OK;
}


/*
 *-------------------------------------------------------------------------
 *
 * DecodeZipEntryText --
 *
 *	Given a sequence of bytes from an entry in a ZIP central directory,
 *	convert that into a Tcl string. This is complicated because we don't
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
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







-
-
-
+
+
+

-
-
+
+

-
-
+
+

-
+

-
-
+
+


-
-
+
+










-
-
-
+
+
+
-
-
-
+


-
+




+












-
+








+
+
+
+
+
+
+






-
-
+
+
+
+
+
+
+

+

-
+
-
-














-
+





-
-
-
-
-
+
+
+
+
+


-
+


-
+















-
-







+
-
+
+
+







-
+






-
+









-
+



-
-
+







}

/*
 *------------------------------------------------------------------------
 *
 * NormalizeMountPoint --
 *
 *    Converts the passed path into a normalized zipfs mount point
 *    of the form //zipfs:/some/path. On Windows any \ path separators
 *    are converted to /.
 *	Converts the passed path into a normalized zipfs mount point
 *	of the form //zipfs:/some/path. On Windows any \ path separators
 *	are converted to /.
 *
 *    Mount points with a volume will raise an error unless the volume is
 *    zipfs root. Thus D:/foo is not a valid mount point.
 *	Mount points with a volume will raise an error unless the volume is
 *	zipfs root. Thus D:/foo is not a valid mount point.
 *
 *    Relative paths and absolute paths without a volume are mapped under
 *    the zipfs root.
 *	Relative paths and absolute paths without a volume are mapped under
 *	the zipfs root.
 *
 *    The empty string is mapped to the zipfs root.
 *	The empty string is mapped to the zipfs root.
 *
 *    dsPtr is initialized by the function and must be cleared by caller
 *    on a successful return.
 *	dsPtr is initialized by the function and must be cleared by caller
 *	on a successful return.
 *
 * Results:
 *    TCL_OK on success with normalized mount path in dsPtr
 *    TCL_ERROR on fail with error message in interp if not NULL
 *	TCL_OK on success with normalized mount path in dsPtr
 *	TCL_ERROR on fail with error message in interp if not NULL
 *
 *------------------------------------------------------------------------
 */
static int
NormalizeMountPoint(
    Tcl_Interp *interp,
    const char *mountPath,
    Tcl_DString *dsPtr)		/* Must be initialized by caller! */
{
    const char *joiner[2];
    char *joinedPath;
    Tcl_Obj *unnormalizedObj;
    Tcl_Obj *normalizedObj;
    const char *joinedPath;
    Tcl_Obj *unnormalizedObj;	/* Before baseline normalization. */
    Tcl_Obj *normalizedObj;	/* After baseline normalization. */
    const char *normalizedPath;
    Tcl_Size normalizedLen;
    Tcl_DString dsJoin;
    Tcl_DString dsJoin;		/* Buffer. Lifetime for joinedPath. */

    /*
     * Several things need to happen here
     * Several things need to happen here:
     * - Absolute paths containing volumes (drive letter or UNC) raise error
     *   except of course if the volume is zipfs root
     * - \ -> / and // -> / conversions (except if UNC which is error)
     * - . and .. have to be dealt with
     *
     * The first is explicitly checked, the others are dealt with a
     * combination file join and normalize. Easier than doing it ourselves
     * and not performance sensitive anyways.
     */

    joiner[0] = ZIPFS_VOLUME;
    joiner[1] = mountPath;
    Tcl_DStringInit(&dsJoin);
    joinedPath = Tcl_JoinPath(2, joiner, &dsJoin);

    /* Now joinedPath has all \ -> / and // -> / (except UNC) converted. */

    if (!strncmp(ZIPFS_VOLUME, joinedPath, ZIPFS_VOLUME_LEN)) {
    if (HasVolumePrefix(joinedPath)) {
	unnormalizedObj = Tcl_DStringToObj(&dsJoin);
    } else {
	if (joinedPath[0] != '/' || joinedPath[1] == '/') {
	    /* mount path was D:/x, D:x or //unc */
	    goto invalidMountPath;
	}
	unnormalizedObj = Tcl_ObjPrintf(ZIPFS_VOLUME "%s", joinedPath + 1);
    }
    Tcl_DStringFree(&dsJoin);

    /*
     * Now unnormalizedObj is the name in the volume... but still needs to be
     * cleaned up and the result transferred to the caller's buffer.
     */

    Tcl_IncrRefCount(unnormalizedObj);
    normalizedObj = Tcl_FSGetNormalizedPath(interp, unnormalizedObj);
    if (normalizedObj == NULL) {
	Tcl_DecrRefCount(unnormalizedObj);
	goto errorReturn;
    }
    Tcl_IncrRefCount(normalizedObj); /* BEFORE DecrRefCount on unnormalizedObj */
    Tcl_DecrRefCount(unnormalizedObj);
    TclDStringAppendObj(dsPtr, normalizedObj);

    /*
     * Careful! The normalized and unnormalized objects may be the same,
     * or the normalized one might be something cached inside Tcl's path
     * management guts.
     */

    Tcl_IncrRefCount(normalizedObj); /* BEFORE DecrRefCount on unnormalizedObj */
    /* normalizedObj owned by Tcl!! Do NOT DecrRef without an IncrRef */
    normalizedPath = TclGetStringFromObj(normalizedObj, &normalizedLen);
    Tcl_DecrRefCount(unnormalizedObj);
    Tcl_DStringFree(&dsJoin);
    Tcl_DStringAppend(dsPtr, normalizedPath, normalizedLen);
    Tcl_DecrRefCount(normalizedObj);
    return TCL_OK;

invalidMountPath:
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"Invalid mount path \"%s\"", mountPath));
	ZIPFS_ERROR_CODE(interp, "MOUNT_PATH");
    }

errorReturn:
    Tcl_DStringFree(&dsJoin);
    return TCL_ERROR;
}


/*
 *------------------------------------------------------------------------
 *
 * MapPathToZipfs --
 *
 *    Maps a path as stored in a zip archive to its normalized location
 *    under a given zipfs mount point. Relative paths and Unix style
 *    absolute paths go directly under the mount point. Volume relative
 *    paths and absolute paths that have a volume (drive or UNC) are
 *    stripped of the volume before joining the mount point.
 *	Maps a path as stored in a zip archive to its normalized location
 *	under a given zipfs mount point. Relative paths and Unix style
 *	absolute paths go directly under the mount point. Volume relative
 *	paths and absolute paths that have a volume (drive or UNC) are
 *	stripped of the volume before joining the mount point.
 *
 * Results:
 *    Pointer to normalized path.
 *	Pointer to normalized path.
 *
 * Side effects:
 *    Stores mapped path in dsPtr.
 *	Stores mapped path in dsPtr.
 *
 *------------------------------------------------------------------------
 */
static char *
MapPathToZipfs(
    Tcl_Interp *interp,
    const char *mountPath,	/* Must be fully normalized */
    const char *path,		/* Archive content path to map */
    Tcl_DString *dsPtr)		/* Must be initialized and cleared
				 * by caller */
{
    const char *joiner[2];
    char *joinedPath;
    Tcl_Obj *unnormalizedObj;
    Tcl_Obj *normalizedObj;
    const char *normalizedPath;
    Tcl_Size normalizedLen;
    Tcl_DString dsJoin;

    assert(TclIsZipfsPath(mountPath));

    joiner[0] = mountPath;
    joiner[1] = path;
#ifndef _WIN32
    /*
    /* On Unix C:/foo/bat is not treated as absolute by JoinPath so check ourself */
     * On Unix C:/foo/bat is not treated as absolute by JoinPath so check
     * ourself.
     */
    if (path[0] && path[1] == ':') {
	joiner[1] += 2;
    }
#endif
    Tcl_DStringInit(&dsJoin);
    joinedPath = Tcl_JoinPath(2, joiner, &dsJoin);

    if (strncmp(ZIPFS_VOLUME, joinedPath, ZIPFS_VOLUME_LEN)) {
    if (!HasVolumePrefix(joinedPath)) {
	/* path was not relative. Strip off the volume (e.g. UNC) */
	Tcl_Size numParts;
	const char **partsPtr;
	Tcl_SplitPath(path, &numParts, &partsPtr);
	Tcl_DStringFree(&dsJoin);
	partsPtr[0] = mountPath;
	(void)Tcl_JoinPath(numParts, partsPtr, &dsJoin);
	(void) Tcl_JoinPath(numParts, partsPtr, &dsJoin);
	Tcl_Free(partsPtr);
    }
    unnormalizedObj = Tcl_DStringToObj(&dsJoin); /* Also resets dsJoin */
    Tcl_IncrRefCount(unnormalizedObj);
    normalizedObj = Tcl_FSGetNormalizedPath(interp, unnormalizedObj);
    if (normalizedObj == NULL) {
	/* Should not happen but continue... */
	normalizedObj = unnormalizedObj;
    }
    Tcl_IncrRefCount(normalizedObj); /* BEFORE DecrRefCount on unnormalizedObj */
    Tcl_IncrRefCount(normalizedObj); // BEFORE DecrRefCount on unnormalizedObj
    Tcl_DecrRefCount(unnormalizedObj);

    /* normalizedObj owned by Tcl!! Do NOT DecrRef without an IncrRef */
    normalizedPath = TclGetStringFromObj(normalizedObj, &normalizedLen);
    Tcl_DStringAppend(dsPtr, normalizedPath, normalizedLen);
    TclDStringAppendObj(dsPtr, normalizedObj);
    Tcl_DecrRefCount(normalizedObj);
    return Tcl_DStringValue(dsPtr);
}

/*
 *-------------------------------------------------------------------------
 *
1158
1159
1160
1161
1162
1163
1164

1165
1166
1167
1168
1169
1170
1171
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268







+








/*
 *-------------------------------------------------------------------------
 *
 * ZipFSLookupZip --
 *
 *	This function gets the structure for a mounted ZIP archive.
 *	The read lock must be held by the caller.
 *
 * Results:
 *	Returns a pointer to the structure, or NULL if the file is ZIP file is
 *	unknown/not mounted.
 *
 * Side effects:
 *	None.
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
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







-
-
-
-
+
+
+
+

-
+


-
-
+
+


-
+






-
+







}

/*
 *------------------------------------------------------------------------
 *
 * ContainsMountPoint --
 *
 *    Check if there is a mount point anywhere under the specified path.
 *    Although the function will work for any path, for efficiency reasons
 *    it should be called only after checking ZipFSLookup does not find
 *    the path.
 *	Check if there is a mount point anywhere under the specified path.
 *	Although the function will work for any path, for efficiency reasons
 *	it should be called only after checking ZipFSLookup does not find
 *	the path.
 *
 *    Caller must hold read lock before calling.
 *	Caller must hold read lock before calling.
 *
 * Results:
 *    1 - there is at least one mount point under the path
 *    0 - otherwise
 *	1 - there is at least one mount point under the path
 *	0 - otherwise
 *
 * Side effects:
 *    None.
 *	None.
 *
 *------------------------------------------------------------------------
 */
static int
ContainsMountPoint(
    const char *path,
    int pathLen)
    Tcl_Size pathLen)
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;

    if (ZipFS.zipHash.numEntries == 0) {
	return 0;
    }
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
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







-
-
-
-
+
+
+
+
+



-
-
-
-
-
+
+
+
+
+






-
+







	     * Enumerate the contents of the ZIP; it's mounted on the root.
	     * TODO - a holdover from androwish? Tcl does not allow mounting
	     * outside of the //zipfs:/ area.
	     */
	    ZipEntry *z;

	    for (z = zf->topEnts; z; z = z->tnext) {
		int lenz = (int) strlen(z->name);
		if ((lenz >= pathLen) &&
			(z->name[pathLen] == '/' || z->name[pathLen] == '\0') &&
			(strncmp(z->name, path, pathLen) == 0)) {
		Tcl_Size lenz = ZipEntryNameLength(z);
		if ((lenz >= pathLen)
			&& (z->name[pathLen] == '/' ||
			    z->name[pathLen] == '\0')
			&& !strncmp(z->name, path, pathLen)) {
		    return 1;
		}
	    }
	} else if ((zf->mountPointLen >= pathLen) &&
		 (zf->mountPoint[pathLen] == '/' ||
		  zf->mountPoint[pathLen] == '\0' ||
		  pathLen == ZIPFS_VOLUME_LEN) &&
		 (strncmp(zf->mountPoint, path, pathLen) == 0)) {
	} else if ((zf->mountPointLen >= pathLen)
		&& (zf->mountPoint[pathLen] == '/' ||
		    zf->mountPoint[pathLen] == '\0' ||
		    pathLen == ZIPFS_VOLUME_LEN)
		&& !strncmp(zf->mountPoint, path, pathLen)) {
	    /* Matched standard mount */
	    return 1;
	}
    }
    return 0;
}


/*
 *-------------------------------------------------------------------------
 *
 * AllocateZipFile, AllocateZipEntry, AllocateZipChannel --
 *
 *	Allocates the memory for a datastructure. Always ensures that it is
 *	zeroed out for safety.
1295
1296
1297
1298
1299
1300
1301

1302
1303
1304
1305
1306
1307
1308
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407







+







}

static inline ZipEntry *
AllocateZipEntry(void)
{
    ZipEntry *z = (ZipEntry *) Tcl_Alloc(sizeof(ZipEntry));
    memset(z, 0, sizeof(ZipEntry));
    z->nameLen = TCL_AUTO_LENGTH;
    return z;
}

static inline ZipChannel *
AllocateZipChannel(
    Tcl_Interp *interp)
{
1387
1388
1389
1390
1391
1392
1393
1394

1395
1396
1397
1398
1399



1400
1401
1402
1403
1404
1405
1406
1486
1487
1488
1489
1490
1491
1492

1493
1494
1495



1496
1497
1498
1499
1500
1501
1502
1503
1504
1505







-
+


-
-
-
+
+
+







 *
 *	This function takes a memory mapped zip file and indexes the contents.
 *	When "needZip" is zero an embedded ZIP archive in an executable file
 *	is accepted. Note that we do not support ZIP64.
 *
 * Results:
 *	TCL_OK on success, TCL_ERROR otherwise with an error message placed
 *	into the given "interp" if it is not NULL.
 *	into the given interp if it is not NULL.
 *
 * Side effects:
 *      The given ZipFile struct is filled with information about the ZIP
 *      archive file.  On error, ZipFSCloseArchive is called on zf but
 *      it is not freed.
 *	The given ZipFile struct is filled with information about the ZIP
 *	archive file. On error, ZipFSCloseArchive is called on zf but
 *	it is not freed.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSFindTOC(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
1414
1415
1416
1417
1418
1419
1420
1421

1422
1423
1424
1425
1426
1427
1428
1513
1514
1515
1516
1517
1518
1519

1520
1521
1522
1523
1524
1525
1526
1527







-
+








    /*
     * Scan backwards from the end of the file for the signature. This is
     * necessary because ZIP archives aren't the only things that get tagged
     * on the end of executables; digital signatures can also go there.
     */

    eocdPtr = zf->data + zf->length - ZIP_CENTRAL_END_LEN;
    eocdPtr = zf->data + zf->length - CENTRAL_END_LEN;
    while (eocdPtr >= start) {
	if (*eocdPtr == (ZIP_CENTRAL_END_SIG & 0xFF)) {
	    if (ZipReadInt(start, end, eocdPtr) == ZIP_CENTRAL_END_SIG) {
		break;
	    }
	    eocdPtr -= ZIP_SIG_LEN;
	} else {
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
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







-
+


-












-
+



















-
-
+
+
+





-
-
-
+
+
+
+
+

-
-
+
+







	if (!needZip) {
	    zf->baseOffset = zf->passOffset = zf->length;
	    return TCL_OK;
	}
	ZIPFS_ERROR(interp, "archive directory end signature not found");
	ZIPFS_ERROR_CODE(interp, "END_SIG");

  error:
    error:
	ZipFSCloseArchive(interp, zf);
	return TCL_ERROR;

    }

    /*
     * eocdPtr -> End of Central Directory (EOCD) record at this point.
     * Note this is not same as "end of Central Directory" :-) as EOCD
     * is a record/structure in the ZIP spec terminology
     */

    /*
     * How many files in the archive? If that's bogus, we're done here.
     */

    zf->numFiles = ZipReadShort(start, end, eocdPtr + ZIP_CENTRAL_ENTS_OFFS);
    zf->numFiles = ZipReadShort(start, end, eocdPtr + CENTRAL_ENTS);
    if (zf->numFiles == 0) {
	if (!needZip) {
	    zf->baseOffset = zf->passOffset = zf->length;
	    return TCL_OK;
	}
	ZIPFS_ERROR(interp, "empty archive");
	ZIPFS_ERROR_CODE(interp, "EMPTY");
	goto error;
    }

    /*
     * The Central Directory (CD) is a series of Central Directory File
     * Header (CDFH) records preceding the EOCD (but not necessarily
     * immediately preceding). cdirZipOffset is the offset into the
     * *archive* to the CD (first CDFH). The size of the CD is given by
     * cdirSize. NOTE: offset into archive does NOT mean offset into
     * (zf->data) as other data may precede the archive in the file.
     */
    ptrdiff_t eocdDataOffset = eocdPtr - zf->data;
    unsigned int cdirZipOffset = ZipReadInt(start, end, eocdPtr + ZIP_CENTRAL_DIRSTART_OFFS);
    unsigned int cdirSize = ZipReadInt(start, end, eocdPtr + ZIP_CENTRAL_DIRSIZE_OFFS);
    unsigned int cdirZipOffset = ZipReadInt(start, end,
	    eocdPtr + CENTRAL_DIRSTART);
    unsigned int cdirSize = ZipReadInt(start, end, eocdPtr + CENTRAL_DIRSIZE);

    /*
     * As computed above,
     *    eocdDataOffset < zf->length.
     * In addition, the following consistency checks must be met
     * (1) cdirZipOffset <= eocdDataOffset (to prevent under flow in computation of (2))
     * (2) cdirZipOffset + cdirSize <= eocdDataOffset. Else the CD will be overlapping
     * the EOCD. Note this automatically means cdirZipOffset+cdirSize < zf->length.
     * (1) cdirZipOffset <= eocdDataOffset (to prevent under flow in
     *     computation of (2))
     * (2) cdirZipOffset + cdirSize <= eocdDataOffset. Else the CD will be
     *     overlapping the EOCD. Note this automatically means
     *     cdirZipOffset+cdirSize < zf->length.
     */
    if (!(cdirZipOffset <= (size_t)eocdDataOffset &&
	    cdirSize <= eocdDataOffset - cdirZipOffset)) {
    if (!(cdirZipOffset <= (size_t)eocdDataOffset
	    && cdirSize <= eocdDataOffset - cdirZipOffset)) {
	if (!needZip) {
	    /* Simply point to end od data */
	    zf->directoryOffset = zf->baseOffset = zf->passOffset = zf->length;
	    return TCL_OK;
	}
	ZIPFS_ERROR(interp, "archive directory truncated");
	ZIPFS_ERROR_CODE(interp, "NO_DIR");
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
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







-
+



+
+
-
+




-
+




-
-
-
-
+
+
+
+

-
-
+
+







-
+
+

-
+
















-
-
+
+







    zf->passOffset = zf->baseOffset;
    zf->directoryOffset = cdirZipOffset + zf->baseOffset;
    zf->directorySize = cdirSize;

    /*
     * Read the central directory.
     */
    const unsigned char *const cdirStart = eocdPtr - cdirSize; /* Start of CD */
    const unsigned char *const cdirStart = eocdPtr - cdirSize; // Start of CD
    const unsigned char *dirEntry;
    minoff = zf->length;
    for (dirEntry = cdirStart, i = 0; i < zf->numFiles; i++) {
#define Get(typ, base, off) ZipRead##typ(start, end, (base) + (off))
	if ((dirEntry - cdirStart) + CENTRAL_HEADER_LEN
	if ((dirEntry-cdirStart) + ZIP_CENTRAL_HEADER_LEN > (ptrdiff_t)zf->directorySize) {
		> (ptrdiff_t) zf->directorySize) {
	    ZIPFS_ERROR(interp, "truncated directory");
	    ZIPFS_ERROR_CODE(interp, "TRUNC_DIR");
	    goto error;
	}
	if (ZipReadInt(start, end, dirEntry) != ZIP_CENTRAL_HEADER_SIG) {
	if (Get(Int, dirEntry, CENTRAL_SIG) != ZIP_CENTRAL_HEADER_SIG) {
	    ZIPFS_ERROR(interp, "wrong header signature");
	    ZIPFS_ERROR_CODE(interp, "HDR_SIG");
	    goto error;
	}
	int pathlen = ZipReadShort(start, end, dirEntry + ZIP_CENTRAL_PATHLEN_OFFS);
	int comlen = ZipReadShort(start, end, dirEntry + ZIP_CENTRAL_FCOMMENTLEN_OFFS);
	int extra = ZipReadShort(start, end, dirEntry + ZIP_CENTRAL_EXTRALEN_OFFS);
	size_t localhdr_off = ZipReadInt(start, end, dirEntry + ZIP_CENTRAL_LOCALHDR_OFFS);
	int pathlen = Get(Short, dirEntry, CENTRAL_PATHLEN);
	int comlen = Get(Short, dirEntry, CENTRAL_FCOMMENTLEN);
	int extra = Get(Short, dirEntry, CENTRAL_EXTRALEN);
	size_t localhdr_off = Get(Int, dirEntry, CENTRAL_LOCALHDR);
	const unsigned char *localP = zf->data + zf->baseOffset + localhdr_off;
	if (localP > (cdirStart - ZIP_LOCAL_HEADER_LEN) ||
		ZipReadInt(start, end, localP) != ZIP_LOCAL_HEADER_SIG) {
	if (localP > (cdirStart - LOCAL_HEADER_LEN) ||
		Get(Int, localP, LOCAL_SIG) != ZIP_LOCAL_HEADER_SIG) {
	    ZIPFS_ERROR(interp, "Failed to find local header");
	    ZIPFS_ERROR_CODE(interp, "LCL_HDR");
	    goto error;
	}
	if (localhdr_off < minoff) {
	    minoff = localhdr_off;
	}
	dirEntry += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN;
	dirEntry += pathlen + comlen + extra + CENTRAL_HEADER_LEN;
#undef Get
    }
    if ((dirEntry-cdirStart) < (ptrdiff_t) zf->directorySize) {
    if ((dirEntry - cdirStart) < (ptrdiff_t) zf->directorySize) {
	/* file count and dir size do not match */
	ZIPFS_ERROR(interp, "short file count");
	ZIPFS_ERROR_CODE(interp, "FILE_COUNT");
	goto error;
    }

    zf->passOffset = minoff + zf->baseOffset;

    /*
     * If there's also an encoded password, extract that too (but don't decode
     * yet).
     * TODO - is this even part of the ZIP "standard". The idea of storing
     * a password with the archive seems absurd, encoded or not.
     */

    unsigned char *q = zf->data + zf->passOffset;
    if ((zf->passOffset >= 6) && (start < q-4) &&
	    (ZipReadInt(start, end, q - 4) == ZIP_PASSWORD_END_SIG)) {
    if ((zf->passOffset >= 6) && (start < q - 4)
	    && (ZipReadInt(start, end, q - 4) == ZIP_PASSWORD_END_SIG)) {
	const unsigned char *passPtr;

	i = q[-5];
	passPtr = q - 5 - i;
	if (passPtr >= start && passPtr + i < end) {
	    zf->passBuf[0] = i;
	    memcpy(zf->passBuf + 1, passPtr, i);
1591
1592
1593
1594
1595
1596
1597
1598

1599
1600
1601
1602
1603
1604
1605
1695
1696
1697
1698
1699
1700
1701

1702
1703
1704
1705
1706
1707
1708
1709







-
+







 *	buffer. The ZIP archive header is verified and must be valid for the
 *	function to succeed. When "needZip" is zero an embedded ZIP archive in
 *	an executable file is accepted.
 *
 * Results:
 *	TCL_OK on success, TCL_ERROR otherwise with an error message placed
 *	into the given "interp" if it is not NULL. On error, ZipFSCloseArchive
 *      is called on zf but it is not freed.
 *	is called on zf but it is not freed.
 *
 * Side effects:
 *	ZIP archive is memory mapped or read into allocated memory, the given
 *	ZipFile struct is filled with information about the ZIP archive file.
 *
 *-------------------------------------------------------------------------
 */
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
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







-
-
-
-
+
+
+








-
+
+







	 */

	zf->length = Tcl_Seek(zf->chan, 0, SEEK_END);
	if (zf->length == (size_t) TCL_INDEX_NONE) {
	    ZIPFS_POSIX_ERROR(interp, "seek error");
	    goto error;
	}
	/* What's the magic about 64 * 1024 * 1024 ? */
	if ((zf->length <= ZIP_CENTRAL_END_LEN) ||
		(zf->length - ZIP_CENTRAL_END_LEN) >
			(64 * 1024 * 1024 - ZIP_CENTRAL_END_LEN)) {
	if ((zf->length <= CENTRAL_END_LEN) ||
		(zf->length - CENTRAL_END_LEN) >
			(ZIPFS_MAX_DIR_SIZE - CENTRAL_END_LEN)) {
	    ZIPFS_ERROR(interp, "illegal file size");
	    ZIPFS_ERROR_CODE(interp, "FILE_SIZE");
	    goto error;
	}
	if (Tcl_Seek(zf->chan, 0, SEEK_SET) == -1) {
	    ZIPFS_POSIX_ERROR(interp, "seek error");
	    goto error;
	}
	zf->ptrToFree = zf->data = (unsigned char *) Tcl_AttemptAlloc(zf->length);
	zf->ptrToFree = zf->data = (unsigned char *)
		Tcl_AttemptAlloc(zf->length);
	if (!zf->ptrToFree) {
	    ZIPFS_MEM_ERROR(interp);
	    goto error;
	}
	i = Tcl_Read(zf->chan, (char *) zf->data, zf->length);
	if (i != zf->length) {
	    ZIPFS_POSIX_ERROR(interp, "file read error");
1731
1732
1733
1734
1735
1736
1737
1738

1739
1740
1741
1742
1743
1744
1745
1835
1836
1837
1838
1839
1840
1841

1842
1843
1844
1845
1846
1847
1848
1849







-
+








    readSuccessful = GetFileSizeEx(hFile, (PLARGE_INTEGER) &zf->length) != 0;
    if (!readSuccessful) {
	Tcl_WinConvertError(GetLastError());
	ZIPFS_POSIX_ERROR(interp, "failed to retrieve file size");
	return TCL_ERROR;
    }
    if (zf->length < ZIP_CENTRAL_END_LEN) {
    if (zf->length < CENTRAL_END_LEN) {
	Tcl_SetErrno(EINVAL);
	ZIPFS_POSIX_ERROR(interp, "truncated file");
	return TCL_ERROR;
    }
    if (zf->length > TCL_SIZE_MAX) {
	Tcl_SetErrno(EFBIG);
	ZIPFS_POSIX_ERROR(interp, "zip archive too big");
1768
1769
1770
1771
1772
1773
1774
1775

1776
1777
1778
1779

1780
1781
1782
1783
1784
1785
1786
1872
1873
1874
1875
1876
1877
1878

1879
1880
1881
1882

1883
1884
1885
1886
1887
1888
1889
1890







-
+



-
+







    int fd = PTR2INT(handle);

    /*
     * Determine the file size.
     */

    zf->length = lseek(fd, 0, SEEK_END);
    if (zf->length == (size_t)-1) {
    if ((off_t)zf->length == (off_t)-1) {
	ZIPFS_POSIX_ERROR(interp, "failed to retrieve file size");
	return TCL_ERROR;
    }
    if (zf->length < ZIP_CENTRAL_END_LEN) {
    if (zf->length < CENTRAL_END_LEN) {
	Tcl_SetErrno(EINVAL);
	ZIPFS_POSIX_ERROR(interp, "truncated file");
	return TCL_ERROR;
    }
    lseek(fd, 0, SEEK_SET);

    zf->data = (unsigned char *)
1827
1828
1829
1830
1831
1832
1833
1834

1835
1836
1837
1838
1839
1840
1841
1931
1932
1933
1934
1935
1936
1937

1938
1939
1940
1941
1942
1943
1944
1945







-
+







 * ZipFSCatalogFilesystem --
 *
 *	This function generates the root node for a ZIPFS filesystem by
 *	reading the ZIP's central directory.
 *
 * Results:
 *	TCL_OK on success, TCL_ERROR otherwise with an error message placed
 *	into the given "interp" if it is not NULL. On error, frees zf!!
 *	into the given interp if it is not NULL. On error, frees zf!!
 *
 * Side effects:
 *	Will acquire and release the write lock.
 *
 *-------------------------------------------------------------------------
 */

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
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







+

-
-
-
+
+
+

-
+





-
+


-
+
-
-
+


-
+

-
-
+
+

-
+


-
-
-
+
+
+

















-
-
+
+






-
+
-
-
















-
+
-



-
-
-
+
+
+

-
-
-
+
+
-

-
-
-
+
+
+

-
-
-
+
+
-

+












-
+
+













-
+

-
+







    for (i = 0; i < zf->numFiles; i++) {
	const unsigned char *start = zf->data;
	const unsigned char *end = zf->data + zf->length;
	int extra, isdir = 0, dosTime, dosDate, nbcompr;
	size_t offs, pathlen, comlen;
	unsigned char *lq, *gq = NULL;
	char *fullpath, *path;
#define Get(typ, base, off) ZipRead##typ(start, end, (base) + (off))

	pathlen = ZipReadShort(start, end, q + ZIP_CENTRAL_PATHLEN_OFFS);
	comlen = ZipReadShort(start, end, q + ZIP_CENTRAL_FCOMMENTLEN_OFFS);
	extra = ZipReadShort(start, end, q + ZIP_CENTRAL_EXTRALEN_OFFS);
	pathlen = Get(Short, q, CENTRAL_PATHLEN);
	comlen = Get(Short, q, CENTRAL_FCOMMENTLEN);
	extra = Get(Short, q, CENTRAL_EXTRALEN);
	Tcl_DStringSetLength(&ds, 0);
	path = DecodeZipEntryText(q + ZIP_CENTRAL_HEADER_LEN, pathlen, &ds);
	path = DecodeZipEntryText(q + CENTRAL_HEADER_LEN, pathlen, &ds);
	if ((pathlen > 0) && (path[pathlen - 1] == '/')) {
	    Tcl_DStringSetLength(&ds, pathlen - 1);
	    path = Tcl_DStringValue(&ds);
	    isdir = 1;
	}
	if ((strcmp(path, ".") == 0) || (strcmp(path, "..") == 0)) {
	if (!strcmp(path, ".") || !strcmp(path, "..")) {
	    goto nextent;
	}
	lq = zf->data + zf->baseOffset
	lq = zf->data + zf->baseOffset + Get(Int, q, CENTRAL_LOCALHDR);
		+ ZipReadInt(start, end, q + ZIP_CENTRAL_LOCALHDR_OFFS);
	if ((lq < start) || (lq + ZIP_LOCAL_HEADER_LEN > end)) {
	if ((lq < start) || (lq + LOCAL_HEADER_LEN > end)) {
	    goto nextent;
	}
	nbcompr = ZipReadInt(start, end, lq + ZIP_LOCAL_COMPLEN_OFFS);
	nbcompr = Get(Int, lq, LOCAL_COMPLEN);
	if (!isdir && (nbcompr == 0)
		&& (ZipReadInt(start, end, lq + ZIP_LOCAL_UNCOMPLEN_OFFS) == 0)
		&& (ZipReadInt(start, end, lq + ZIP_LOCAL_CRC32_OFFS) == 0)) {
		&& (Get(Int, lq, LOCAL_UNCOMPLEN) == 0)
		&& (Get(Int, lq, LOCAL_CRC32) == 0)) {
	    gq = q;
	    nbcompr = ZipReadInt(start, end, gq + ZIP_CENTRAL_COMPLEN_OFFS);
	    nbcompr = Get(Int, gq, CENTRAL_COMPLEN);
	}
	offs = (lq - zf->data)
		+ ZIP_LOCAL_HEADER_LEN
		+ ZipReadShort(start, end, lq + ZIP_LOCAL_PATHLEN_OFFS)
		+ ZipReadShort(start, end, lq + ZIP_LOCAL_EXTRALEN_OFFS);
		+ LOCAL_HEADER_LEN
		+ Get(Short, lq, LOCAL_PATHLEN)
		+ Get(Short, lq, LOCAL_EXTRALEN);
	if (offs + nbcompr > zf->length) {
	    goto nextent;
	}

	if (!isdir && (mountPoint[0] == '\0') && !CountSlashes(path)) {
#ifdef ANDROID
	    /*
	     * When mounting the ZIP archive on the root directory try to
	     * remap top level regular files of the archive to
	     * /assets/.root/... since this directory should not be in a valid
	     * APK due to the leading dot in the file name component. This
	     * trick should make the files AndroidManifest.xml,
	     * resources.arsc, and classes.dex visible to Tcl.
	     */
	    Tcl_DString ds2;

	    Tcl_DStringInit(&ds2);
	    Tcl_DStringAppend(&ds2, "assets/.root/", -1);
	    Tcl_DStringAppend(&ds2, path, -1);
	    TclDStringAppendLiteral(&ds2, "assets/.root/");
	    Tcl_DStringAppend(&ds2, path, TCL_AUTO_LENGTH);
	    if (ZipFSLookup(Tcl_DStringValue(&ds2))) {
		/* should not happen but skip it anyway */
		Tcl_DStringFree(&ds2);
		goto nextent;
	    }
	    Tcl_DStringSetLength(&ds, 0);
	    Tcl_DStringAppend(&ds, Tcl_DStringValue(&ds2),
	    path = TclDStringAppendDString(&ds, &ds2);
		    Tcl_DStringLength(&ds2));
	    path = Tcl_DStringValue(&ds);
	    Tcl_DStringFree(&ds2);
#else /* !ANDROID */
	    /*
	     * Regular files skipped when mounting on root.
	     */
	    goto nextent;
#endif /* ANDROID */
	}

	Tcl_DStringSetLength(&fpBuf, 0);
	fullpath = MapPathToZipfs(interp, mountPoint, path, &fpBuf);
	z = AllocateZipEntry();
	z->depth = CountSlashes(fullpath);
	assert(z->depth >= ZIPFS_ROOTDIR_DEPTH);
	z->zipFilePtr = zf;
	z->isDirectory = isdir;
	z->isEncrypted =
	z->isEncrypted = (Get(Short, lq, LOCAL_FLAGS) & 1)
		(ZipReadShort(start, end, lq + ZIP_LOCAL_FLAGS_OFFS) & 1)
		&& (nbcompr > ZIP_CRYPT_HDR_LEN);
	z->offset = offs;
	if (gq) {
	    z->crc32 = ZipReadInt(start, end, gq + ZIP_CENTRAL_CRC32_OFFS);
	    dosDate = ZipReadShort(start, end, gq + ZIP_CENTRAL_MDATE_OFFS);
	    dosTime = ZipReadShort(start, end, gq + ZIP_CENTRAL_MTIME_OFFS);
	    z->crc32 = Get(Int, gq, CENTRAL_CRC32);
	    dosDate = Get(Short, gq, CENTRAL_MDATE);
	    dosTime = Get(Short, gq, CENTRAL_MTIME);
	    z->timestamp = DosTimeDate(dosDate, dosTime);
	    z->numBytes = ZipReadInt(start, end,
		    gq + ZIP_CENTRAL_UNCOMPLEN_OFFS);
	    z->compressMethod = ZipReadShort(start, end,
	    z->numBytes = Get(Int, gq, CENTRAL_UNCOMPLEN);
	    z->compressMethod = Get(Short, gq, CENTRAL_COMPMETH);
		    gq + ZIP_CENTRAL_COMPMETH_OFFS);
	} else {
	    z->crc32 = ZipReadInt(start, end, lq + ZIP_LOCAL_CRC32_OFFS);
	    dosDate = ZipReadShort(start, end, lq + ZIP_LOCAL_MDATE_OFFS);
	    dosTime = ZipReadShort(start, end, lq + ZIP_LOCAL_MTIME_OFFS);
	    z->crc32 = Get(Int, lq, LOCAL_CRC32);
	    dosDate = Get(Short, lq, LOCAL_MDATE);
	    dosTime = Get(Short, lq, LOCAL_MTIME);
	    z->timestamp = DosTimeDate(dosDate, dosTime);
	    z->numBytes = ZipReadInt(start, end,
		    lq + ZIP_LOCAL_UNCOMPLEN_OFFS);
	    z->compressMethod = ZipReadShort(start, end,
	    z->numBytes = Get(Int, lq, LOCAL_UNCOMPLEN);
	    z->compressMethod = Get(Short, lq, LOCAL_COMPMETH);
		    lq + ZIP_LOCAL_COMPMETH_OFFS);
	}
#undef Get
	z->numCompressedBytes = nbcompr;
	hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, fullpath, &isNew);
	if (!isNew) {
	    /* should not happen but skip it anyway */
	    Tcl_Free(z);
	    goto nextent;
	}

	Tcl_SetHashValue(hPtr, z);
	z->name = (char *) Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
	z->next = zf->entries;
	zf->entries = z;
	if (isdir && (mountPoint[0] == '\0') && (z->depth == ZIPFS_ROOTDIR_DEPTH)) {
	if (isdir && (mountPoint[0] == '\0')
		&& (z->depth == ZIPFS_ROOTDIR_DEPTH)) {
	    z->tnext = zf->topEnts;
	    zf->topEnts = z;
	}

	/*
	 * Make any directory nodes we need. ZIPs are not consistent about
	 * containing directory nodes.
	 */

	if (!z->isDirectory && (z->depth > ZIPFS_ROOTDIR_DEPTH)) {
	    char *dir, *endPtr;
	    ZipEntry *zd;

	    Tcl_DStringSetLength(&ds, strlen(z->name) + 8);
	    Tcl_DStringSetLength(&ds, ZipEntryNameLength(z) + 8);
	    Tcl_DStringSetLength(&ds, 0);
	    Tcl_DStringAppend(&ds, z->name, -1);
	    Tcl_DStringAppend(&ds, z->name, ZipEntryNameLength(z));
	    dir = Tcl_DStringValue(&ds);
	    for (endPtr = strrchr(dir, '/'); endPtr && (endPtr != dir);
		    endPtr = strrchr(dir, '/')) {
		Tcl_DStringSetLength(&ds, endPtr - dir);
		hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, dir, &isNew);
		if (!isNew) {
		    /*
2112
2113
2114
2115
2116
2117
2118
2119

2120
2121
2122
2123
2124
2125
2126
2211
2212
2213
2214
2215
2216
2217

2218
2219
2220
2221
2222
2223
2224
2225







-
+







		if ((mountPoint[0] == '\0') && (zd->depth == ZIPFS_ROOTDIR_DEPTH)) {
		    zd->tnext = zf->topEnts;
		    zf->topEnts = zd;
		}
	    }
	}
    nextent:
	q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN;
	q += pathlen + comlen + extra + CENTRAL_HEADER_LEN;
    }
    Unlock();
    Tcl_DStringFree(&fpBuf);
    Tcl_DStringFree(&ds);
    Tcl_FSMountsChanged(NULL);
    return TCL_OK;
}
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
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







-
+

-
+










-
-
+
+

-
+


-
+


-
+







    }

    TclNewObj(resultList);
    for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
	    hPtr = Tcl_NextHashEntry(&search)) {
	zf = (ZipFile *) Tcl_GetHashValue(hPtr);
	Tcl_ListObjAppendElement(NULL, resultList, Tcl_NewStringObj(
		zf->mountPoint, -1));
		zf->mountPoint, TCL_AUTO_LENGTH));
	Tcl_ListObjAppendElement(NULL, resultList, Tcl_NewStringObj(
		zf->name, -1));
		zf->name, TCL_AUTO_LENGTH));
    }
    Tcl_SetObjResult(interp, resultList);
    return TCL_OK;
}

/*
 *------------------------------------------------------------------------
 *
 * CleanupMount --
 *
 *    Releases all resources associated with a mounted archive. There
 *    must not be any open files in the archive.
 *	Releases all resources associated with a mounted archive. There
 *	must not be any open files in the archive.
 *
 *    Caller MUST be holding WriteLock() before calling this function.
 *	Caller MUST be holding WriteLock() before calling this function.
 *
 * Results:
 *    None.
 *	None.
 *
 * Side effects:
 *    Memory associated with the mounted archive is deallocated.
 *	Memory associated with the mounted archive is deallocated.
 *------------------------------------------------------------------------
 */
static void
CleanupMount(
    ZipFile *zf)		/* Mount point */
{
    ZipEntry *z, *znext;
2245
2246
2247
2248
2249
2250
2251
2252

2253
2254
2255
2256
2257
2258
2259
2344
2345
2346
2347
2348
2349
2350

2351
2352
2353
2354
2355
2356
2357
2358







-
+







	if (z->data) {
	    Tcl_Free(z->data);
	}
	Tcl_Free(z);
    }
    zf->entries = NULL;
}


/*
 *-------------------------------------------------------------------------
 *
 * DescribeMounted --
 *
 *	This procedure describes what is mounted at the given the mount point.
 *	The interpreter result is not updated if there is nothing mounted at
2274
2275
2276
2277
2278
2279
2280
2281


2282
2283
2284
2285
2286
2287
2288
2373
2374
2375
2376
2377
2378
2379

2380
2381
2382
2383
2384
2385
2386
2387
2388







-
+
+







    Tcl_Interp *interp,
    const char *mountPoint)
{
    if (interp) {
	ZipFile *zf = ZipFSLookupZip(mountPoint);

	if (zf) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(zf->name, -1));
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj(zf->name, TCL_AUTO_LENGTH));
	    return TCL_OK;
	}
    }
    return (interp ? TCL_OK : TCL_BREAK);
}

/*
2350
2351
2352
2353
2354
2355
2356
2357

2358
2359
2360
2361
2362
2363
2364
2450
2451
2452
2453
2454
2455
2456

2457
2458
2459
2460
2461
2462
2463
2464







-
+







	/* Have both a mount point and a file (name) to mount there. */

	Tcl_Obj *zipPathObj;
	Tcl_Obj *normZipPathObj;

	Unlock();

	zipPathObj = Tcl_NewStringObj(zipname, -1);
	zipPathObj = Tcl_NewStringObj(zipname, TCL_AUTO_LENGTH);
	Tcl_IncrRefCount(zipPathObj);
	normZipPathObj = Tcl_FSGetNormalizedPath(interp, zipPathObj);
	if (normZipPathObj == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not normalize zip filename \"%s\"", zipname));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NORMALIZE", (char *)NULL);
	    ret = TCL_ERROR;
2373
2374
2375
2376
2377
2378
2379
2380

2381
2382
2383
2384
2385
2386
2387
2473
2474
2475
2476
2477
2478
2479

2480
2481
2482
2483
2484
2485
2486
2487







-
+







		    ret = TCL_ERROR;
		} else {
		    ret = ZipFSOpenArchive(interp, normPath, 1, zf);
		    if (ret != TCL_OK) {
			Tcl_Free(zf);
		    } else {
			ret = ZipFSCatalogFilesystem(
			    interp, zf, mountPoint, passwd, normPath);
				interp, zf, mountPoint, passwd, normPath);
			/* Note zf is already freed on error! */
		    }
		}
	    }
	    Tcl_DecrRefCount(normZipPathObj);
	    if (ret == TCL_OK && interp) {
		Tcl_DStringResult(interp, &ds);
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
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







-


-
-
-
+
+
+












-
+









-
+







    }
    mountPoint = Tcl_DStringValue(&ds);

    Unlock();

    /*
     * Have both a mount point and data to mount there.
     * What's the magic about 64 * 1024 * 1024 ?
     */
    ret = TCL_ERROR;
    if ((datalen <= ZIP_CENTRAL_END_LEN) ||
	    (datalen - ZIP_CENTRAL_END_LEN) >
		    (64 * 1024 * 1024 - ZIP_CENTRAL_END_LEN)) {
    if ((datalen <= CENTRAL_END_LEN) ||
	    (datalen - CENTRAL_END_LEN) >
		    (ZIPFS_MAX_DIR_SIZE - CENTRAL_END_LEN)) {
	ZIPFS_ERROR(interp, "illegal file size");
	ZIPFS_ERROR_CODE(interp, "FILE_SIZE");
	goto done;
    }
    zf = AllocateZipFile(interp, strlen(mountPoint));
    if (zf == NULL) {
	goto done;
    }
    zf->isMemBuffer = 1;
    zf->length = datalen;

    if (copy) {
	zf->data = (unsigned char *)Tcl_AttemptAlloc(datalen);
	zf->data = (unsigned char *) Tcl_AttemptAlloc(datalen);
	if (zf->data == NULL) {
	    ZipFSCloseArchive(interp, zf);
	    Tcl_Free(zf);
	    ZIPFS_MEM_ERROR(interp);
	    goto done;
	}
	memcpy(zf->data, data, datalen);
	zf->ptrToFree = zf->data;
    } else {
	zf->data = (unsigned char *)data;
	zf->data = (unsigned char *) data;
	zf->ptrToFree = NULL;
    }
    ret = ZipFSFindTOC(interp, 1, zf);
    if (ret != TCL_OK) {
	Tcl_Free(zf);
    } else {
	/* Note ZipFSCatalogFilesystem will free zf on error */
2683
2684
2685
2686
2687
2688
2689

2690
2691
2692
2693

2694

2695
2696
2697
2698
2699
2700
2701
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794

2795
2796
2797
2798
2799
2800
2801
2802







+




+
-
+







static int
ZipFSRootObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *volume;
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "");
	return TCL_ERROR;
    }
    TclNewLiteralStringObj(volume, ZIPFS_VOLUME);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(ZIPFS_VOLUME, -1));
    Tcl_SetObjResult(interp, volume);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSUnmountObjCmd --
2726
2727
2728
2729
2730
2731
2732
2733

2734
2735
2736
2737
2738
2739
2740
2827
2828
2829
2830
2831
2832
2833

2834
2835
2836
2837
2838
2839
2840
2841







-
+







}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMkKeyObjCmd --
 *
 *	This procedure is invoked to process the [zipfs mkkey] command.  It
 *	This procedure is invoked to process the [zipfs mkkey] command. It
 *	produces a rotated password to be embedded into an image file.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
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
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







-
+







-
+









+
-
+










-
+







    Tcl_Obj *passObj;
    unsigned char *passBuf;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "password");
	return TCL_ERROR;
    }
    pw = TclGetStringFromObj(objv[1], &len);
    pw = Tcl_GetStringFromObj(objv[1], &len);
    if (len == 0) {
	return TCL_OK;
    }
    if (IsPasswordValid(interp, pw, len) != TCL_OK) {
	return TCL_ERROR;
    }

    passObj = Tcl_NewByteArrayObj(NULL, 264);
    passObj = Tcl_NewByteArrayObj(NULL, ZIPFS_PASSBUF_SIZE);
    passBuf = Tcl_GetBytesFromObj(NULL, passObj, (Tcl_Size *)NULL);
    while (len > 0) {
	int ch = pw[len - 1];

	passBuf[i++] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
	len--;
    }
    passBuf[i] = i;
    i++;
    ZipWriteInt(passBuf, passBuf + ZIPFS_PASSBUF_SIZE, passBuf + i,
    ZipWriteInt(passBuf, passBuf + 264, passBuf + i, ZIP_PASSWORD_END_SIG);
	    ZIP_PASSWORD_END_SIG);
    Tcl_SetByteArrayLength(passObj, i + 4);
    Tcl_SetObjResult(interp, passObj);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * RandomChar --
 *
 *	Worker for ZipAddFile().  Picks a random character (range: 0..255)
 *	Worker for ZipAddFile(). Picks a random character (range: 0..255)
 *	using Tcl's standard PRNG.
 *
 * Returns:
 *	Tcl result code. Updates chPtr with random character on success.
 *
 * Side effects:
 *	Advances the PRNG state. May reenter the Tcl interpreter if the user
2805
2806
2807
2808
2809
2810
2811
2812


2813
2814
2815
2816
2817
2818
2819
2907
2908
2909
2910
2911
2912
2913

2914
2915
2916
2917
2918
2919
2920
2921
2922







-
+
+







    Tcl_Interp *interp,
    int step,
    int *chPtr)
{
    double r;
    Tcl_Obj *ret;

    if (Tcl_EvalEx(interp, "::tcl::mathfunc::rand", TCL_INDEX_NONE, 0) != TCL_OK) {
    if (Tcl_EvalEx(interp, "::tcl::mathfunc::rand", TCL_INDEX_NONE,
	    0) != TCL_OK) {
	goto failed;
    }
    ret = Tcl_GetObjResult(interp);
    if (Tcl_GetDoubleFromObj(interp, ret, &r) != TCL_OK) {
	goto failed;
    }
    *chPtr = (int) (r * 256);
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
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







-
+
+





-
+











-
+







    }

    /*
     * Convert to encoded form. Note that we use strlen() here; if someone's
     * crazy enough to embed NULs in filenames, they deserve what they get!
     */

    if (Tcl_UtfToExternalDStringEx(interp, tclUtf8Encoding, zpathTcl, TCL_INDEX_NONE, 0, &zpathDs, NULL) != TCL_OK) {
    if (Tcl_UtfToExternalDStringEx(interp, tclUtf8Encoding, zpathTcl,
	    TCL_INDEX_NONE, 0, &zpathDs, NULL) != TCL_OK) {
	Tcl_DStringFree(&zpathDs);
	return TCL_ERROR;
    }
    zpathExt = Tcl_DStringValue(&zpathDs);
    zpathlen = strlen(zpathExt);
    if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) {
    if (zpathlen + CENTRAL_HEADER_LEN > bufsize) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"path too long for \"%s\"", TclGetString(pathObj)));
	ZIPFS_ERROR_CODE(interp, "PATH_LEN");
	Tcl_DStringFree(&zpathDs);
	return TCL_ERROR;
    }
    in = Tcl_FSOpenFileChannel(interp, pathObj, "rb", 0);
    if (!in) {
	Tcl_DStringFree(&zpathDs);
#ifdef _WIN32
	/* hopefully a directory */
	if (strcmp("permission denied", Tcl_PosixError(interp)) == 0) {
	if (!strcmp("permission denied", Tcl_PosixError(interp))) {
	    Tcl_Close(interp, in);
	    return TCL_OK;
	}
#endif /* _WIN32 */
	Tcl_Close(interp, in);
	return TCL_ERROR;
    } else {
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984



2985
2986
2987
2988
2989
2990
2991
3079
3080
3081
3082
3083
3084
3085



3086
3087
3088
3089
3090
3091
3092
3093
3094
3095







-
-
-
+
+
+







    headerStartOffset = Tcl_Tell(out);

    /*
     * Reserve space for the per-file header. Includes writing the file name
     * as we already know that.
     */

    memset(buf, '\0', ZIP_LOCAL_HEADER_LEN);
    memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpathExt, zpathlen);
    len = zpathlen + ZIP_LOCAL_HEADER_LEN;
    memset(buf, '\0', LOCAL_HEADER_LEN);
    memcpy(buf + LOCAL_HEADER_LEN, zpathExt, zpathlen);
    len = zpathlen + LOCAL_HEADER_LEN;
    if (Tcl_Write(out, buf, len) != len) {
    writeErrorWithChannelOpen:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"write error on \"%s\": %s",
		TclGetString(pathObj), Tcl_PosixError(interp)));
	Tcl_Close(interp, in);
	Tcl_DStringFree(&zpathDs);
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
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







-
+












-
+
+








    /*
     * Set up encryption if we were asked to.
     */

    if (passwd) {
	int i, ch, tmp;
	unsigned char kvbuf[2*ZIP_CRYPT_HDR_LEN];
	unsigned char kvbuf[2 * ZIP_CRYPT_HDR_LEN];

	init_keys(passwd, keys, crc32tab);
	for (i = 0; i < ZIP_CRYPT_HDR_LEN - 2; i++) {
	    if (RandomChar(interp, i, &ch) != TCL_OK) {
		Tcl_Close(interp, in);
		return TCL_ERROR;
	    }
	    kvbuf[i + ZIP_CRYPT_HDR_LEN] = UCHAR(zencode(keys, crc32tab, ch, tmp));
	}
	Tcl_ResetResult(interp);
	init_keys(passwd, keys, crc32tab);
	for (i = 0; i < ZIP_CRYPT_HDR_LEN - 2; i++) {
	    kvbuf[i] = UCHAR(zencode(keys, crc32tab, kvbuf[i + ZIP_CRYPT_HDR_LEN], tmp));
	    kvbuf[i] = UCHAR(zencode(keys, crc32tab,
		    kvbuf[i + ZIP_CRYPT_HDR_LEN], tmp));
	}
	kvbuf[i++] = UCHAR(zencode(keys, crc32tab, crc >> 16, tmp));
	kvbuf[i++] = UCHAR(zencode(keys, crc32tab, crc >> 24, tmp));
	len = Tcl_Write(out, (char *) kvbuf, ZIP_CRYPT_HDR_LEN);
	memset(kvbuf, 0, sizeof(kvbuf));
	if (len != ZIP_CRYPT_HDR_LEN) {
	    goto writeErrorWithChannelOpen;
3055
3056
3057
3058
3059
3060
3061
3062

3063
3064
3065
3066
3067
3068
3069
3160
3161
3162
3163
3164
3165
3166

3167
3168
3169
3170
3171
3172
3173
3174







-
+







     */

    compMeth = ZIP_COMPMETH_DEFLATED;
    memset(&stream, 0, sizeof(z_stream));
    stream.zalloc = Z_NULL;
    stream.zfree = Z_NULL;
    stream.opaque = Z_NULL;
    if (deflateInit2(&stream, 9, Z_DEFLATED, -15, 8,
    if (deflateInit2(&stream, 9, Z_DEFLATED, ZLIB_MODE_RAW, 8,
	    Z_DEFAULT_STRATEGY) != Z_OK) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"compression init error on \"%s\"", TclGetString(pathObj)));
	ZIPFS_ERROR_CODE(interp, "DEFLATE_INIT");
	Tcl_Close(interp, in);
	Tcl_DStringFree(&zpathDs);
	return TCL_ERROR;
3122
3123
3124
3125
3126
3127
3128
3129
3130

3131
3132
3133
3134
3135
3136
3137
3227
3228
3229
3230
3231
3232
3233


3234
3235
3236
3237
3238
3239
3240
3241







-
-
+







	 */

	if (Tcl_Seek(in, 0, SEEK_SET) != 0) {
	    goto seekErr;
	}
	if (Tcl_Seek(out, dataStartOffset, SEEK_SET) != dataStartOffset) {
	seekErr:
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "seek error: %s", Tcl_PosixError(interp)));
	    ZIPFS_POSIX_ERROR(interp, "seek error");
	    Tcl_Close(interp, in);
	    Tcl_DStringFree(&zpathDs);
	    return TCL_ERROR;
	}
	nbytecompr = (passwd ? ZIP_CRYPT_HDR_LEN : 0);
	while (1) {
	    len = Tcl_Read(in, buf, bufsize);
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
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







-
-
+


-
+


-
-
+






-
-
+







     */

    SerializeLocalEntryHeader(start, end, (unsigned char *) buf, z,
	    zpathlen, align);
    if (Tcl_Seek(out, headerStartOffset, SEEK_SET) != headerStartOffset) {
	Tcl_DeleteHashEntry(hPtr);
	Tcl_Free(z);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"seek error: %s", Tcl_PosixError(interp)));
	ZIPFS_POSIX_ERROR(interp, "seek error");
	return TCL_ERROR;
    }
    if (Tcl_Write(out, buf, ZIP_LOCAL_HEADER_LEN) != ZIP_LOCAL_HEADER_LEN) {
    if (Tcl_Write(out, buf, LOCAL_HEADER_LEN) != LOCAL_HEADER_LEN) {
	Tcl_DeleteHashEntry(hPtr);
	Tcl_Free(z);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"write error: %s", Tcl_PosixError(interp)));
	ZIPFS_POSIX_ERROR(interp, "write error");
	return TCL_ERROR;
    }
    Tcl_Flush(out);
    if (Tcl_Seek(out, dataEndOffset, SEEK_SET) != dataEndOffset) {
	Tcl_DeleteHashEntry(hPtr);
	Tcl_Free(z);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"seek error: %s", Tcl_PosixError(interp)));
	ZIPFS_POSIX_ERROR(interp, "seek error");
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
3239
3240
3241
3242
3243
3244
3245
3246

3247
3248
3249
3250
3251
3252
3253
3340
3341
3342
3343
3344
3345
3346

3347
3348
3349
3350
3351
3352
3353
3354







-
+







ZipFSFind(
    Tcl_Interp *interp,
    Tcl_Obj *dirRoot)
{
    Tcl_Obj *cmd[2];
    int result;

    cmd[0] = Tcl_NewStringObj("::tcl::zipfs::find", -1);
    TclNewLiteralStringObj(cmd[0], "::tcl::zipfs::find");
    cmd[1] = dirRoot;
    Tcl_IncrRefCount(cmd[0]);
    result = Tcl_EvalObjv(interp, 2, cmd, 0);
    Tcl_DecrRefCount(cmd[0]);
    if (result != TCL_OK) {
	return NULL;
    }
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
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







-
+








-
+

-
+







static inline const char *
ComputeNameInArchive(
    Tcl_Obj *pathObj,		/* The path to the origin file */
    Tcl_Obj *directNameObj,	/* User-specified name for use in the ZIP
				 * archive */
    const char *strip,		/* A prefix to strip; may be NULL if no
				 * stripping need be done. */
    Tcl_Size slen)			/* The length of the prefix; must be 0 if no
    Tcl_Size slen)		/* The length of the prefix; must be 0 if no
				 * stripping need be done. */
{
    const char *name;
    Tcl_Size len;

    if (directNameObj) {
	name = TclGetString(directNameObj);
    } else {
	name = TclGetStringFromObj(pathObj, &len);
	name = Tcl_GetStringFromObj(pathObj, &len);
	if (slen > 0) {
	    if ((len <= slen) || (strncmp(strip, name, slen) != 0)) {
	    if ((len <= slen) || strncmp(strip, name, slen)) {
		/*
		 * Guaranteed to be a NUL at the end, which will make this
		 * entry be skipped.
		 */

		return name + len;
	    }
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
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







-
-
+
+








-
+









-
+







				 * there's no password protection. */
{
    Tcl_Channel out;
    int count, ret = TCL_ERROR;
    Tcl_Size pwlen = 0, slen = 0, len, i = 0;
    Tcl_Size lobjc;
    long long directoryStartOffset;
    /* The overall file offset of the start of the
     * central directory. */
				/* The overall file offset of the start of the
				 * central directory. */
    long long suffixStartOffset;/* The overall file offset of the start of the
				 * suffix of the central directory (i.e.,
				 * where this data will be written). */
    Tcl_Obj **lobjv, *list = mappingList;
    ZipEntry *z;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_HashTable fileHash;
    char *strip = NULL, *pw = NULL, passBuf[264], buf[4096];
    char *strip = NULL, *pw = NULL, passBuf[ZIPFS_PASSBUF_SIZE], buf[4096];
    unsigned char *start = (unsigned char *) buf;
    unsigned char *end = start + sizeof(buf);

    /*
     * Caller has verified that the number of arguments is correct.
     */

    passBuf[0] = 0;
    if (passwordObj != NULL) {
	pw = TclGetStringFromObj(passwordObj, &pwlen);
	pw = Tcl_GetStringFromObj(passwordObj, &pwlen);
	if (IsPasswordValid(interp, pw, pwlen) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (pwlen == 0) {
	    pw = NULL;
	}
    }
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
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







-
+




















-
-
+







	 * Check for mounted image.
	 */

	WriteLock();
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
		hPtr = Tcl_NextHashEntry(&search)) {
	    zf = (ZipFile *) Tcl_GetHashValue(hPtr);
	    if (strcmp(zf->name, imgName) == 0) {
	    if (!strcmp(zf->name, imgName)) {
		isMounted = 1;
		zf->numOpen++;
		break;
	    }
	}
	Unlock();

	if (!isMounted) {
	    zf = &zf0;
	    memset(&zf0, 0, sizeof(ZipFile));
	}
	if (isMounted || ZipFSOpenArchive(interp, imgName, 0, zf) == TCL_OK) {
	    /*
	     * Copy everything up to the ZIP-related suffix.
	     */

	    if ((size_t) Tcl_Write(out, (char *) zf->data,
		    zf->passOffset) != zf->passOffset) {
		memset(passBuf, 0, sizeof(passBuf));
		Tcl_DecrRefCount(list);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"write error: %s", Tcl_PosixError(interp)));
		ZIPFS_POSIX_ERROR(interp, "write error");
		Tcl_Close(interp, out);
		if (zf == &zf0) {
		    ZipFSCloseArchive(interp, zf);
		} else {
		    WriteLock();
		    zf->numOpen--;
		    Unlock();
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
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







-
-
+














-
+







	 */

	len = strlen(passBuf);
	if (len > 0) {
	    i = Tcl_Write(out, passBuf, len);
	    if (i != len) {
		Tcl_DecrRefCount(list);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"write error: %s", Tcl_PosixError(interp)));
		ZIPFS_POSIX_ERROR(interp, "write error");
		Tcl_Close(interp, out);
		return TCL_ERROR;
	    }
	}
	memset(passBuf, 0, sizeof(passBuf));
	Tcl_Flush(out);
    }

    /*
     * Prepare the contents of the ZIP archive.
     */

    Tcl_InitHashTable(&fileHash, TCL_STRING_KEYS);
    if (mappingList == NULL && stripPrefix != NULL) {
	strip = TclGetStringFromObj(stripPrefix, &slen);
	strip = Tcl_GetStringFromObj(stripPrefix, &slen);
	if (!slen) {
	    strip = NULL;
	}
    }
    for (i = 0; i < lobjc; i += (mappingList ? 2 : 1)) {
	Tcl_Obj *pathObj = lobjv[i];
	const char *name = ComputeNameInArchive(pathObj,
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
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







-
+
+







-
+
-

-
-
+















-
+
-
-
+








	hPtr = Tcl_FindHashEntry(&fileHash, name);
	if (!hPtr) {
	    continue;
	}
	z = (ZipEntry *) Tcl_GetHashValue(hPtr);

	if (Tcl_UtfToExternalDStringEx(interp, tclUtf8Encoding, z->name, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	if (Tcl_UtfToExternalDStringEx(interp, tclUtf8Encoding, z->name,
		TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	    ret = TCL_ERROR;
	    goto done;
	}
	name = Tcl_DStringValue(&ds);
	len = Tcl_DStringLength(&ds);
	SerializeCentralDirectoryEntry(start, end, (unsigned char *) buf,
		z, len);
	if ((Tcl_Write(out, buf, ZIP_CENTRAL_HEADER_LEN)
	if ((Tcl_Write(out, buf, CENTRAL_HEADER_LEN) != CENTRAL_HEADER_LEN)
		!= ZIP_CENTRAL_HEADER_LEN)
		|| (Tcl_Write(out, name, len) != len)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "write error: %s", Tcl_PosixError(interp)));
	    ZIPFS_POSIX_ERROR(interp, "write error");
	    Tcl_DStringFree(&ds);
	    goto done;
	}
	Tcl_DStringFree(&ds);
	count++;
    }

    /*
     * Finalize the central directory.
     */

    Tcl_Flush(out);
    suffixStartOffset = Tcl_Tell(out);
    SerializeCentralDirectorySuffix(start, end, (unsigned char *) buf,
	    count, directoryStartOffset, suffixStartOffset);
    if (Tcl_Write(out, buf, ZIP_CENTRAL_END_LEN) != ZIP_CENTRAL_END_LEN) {
    if (Tcl_Write(out, buf, CENTRAL_END_LEN) != CENTRAL_END_LEN) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"write error: %s", Tcl_PosixError(interp)));
	ZIPFS_POSIX_ERROR(interp, "write error");
	goto done;
    }
    Tcl_Flush(out);
    ret = TCL_OK;

  done:
    if (ret == TCL_OK) {
3695
3696
3697
3698
3699
3700
3701
3702

3703
3704
3705
3706
3707
3708
3709
3710
3792
3793
3794
3795
3796
3797
3798

3799

3800
3801
3802
3803
3804
3805
3806







-
+
-







	    goto copyError;
	}
    }
    Tcl_Close(interp, in);
    return TCL_OK;

  copyError:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
    ZIPFS_POSIX_ERROR(interp, errMsg);
	    "%s: %s", errMsg, Tcl_PosixError(interp)));
    Tcl_Close(interp, in);
    return TCL_ERROR;
}

/*
 * ---------------------------------------------------------------------
 *
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
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







+
+









-
-
-
+
+
+
-
-
+
-
-
+
-
-
-
+
+
-
-
-
-
-
+
+
+
+










-
-
-
-
+
+
+
-
-
+
-
-
+
-
-
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
+















-
-
-
-
-
-
+
+
+
+
+
-
-
+
-
-
-
+
+

+
+







-
+







 *
 * Side effects:
 *	Both update their buffer arguments, but otherwise change nothing.
 *
 * ---------------------------------------------------------------------
 */

#define Set(typ, off, val) ZipWrite##typ(start, end, buf + (off), (val))

static void
SerializeLocalEntryHeader(
    const unsigned char *start,	/* The start of writable memory. */
    const unsigned char *end,	/* The end of writable memory. */
    unsigned char *buf,		/* Where to serialize to */
    ZipEntry *z,		/* The description of what to serialize. */
    int nameLength,		/* The length of the name. */
    int align)			/* The number of alignment bytes. */
{
    ZipWriteInt(start, end, buf + ZIP_LOCAL_SIG_OFFS, ZIP_LOCAL_HEADER_SIG);
    ZipWriteShort(start, end, buf + ZIP_LOCAL_VERSION_OFFS, ZIP_MIN_VERSION);
    ZipWriteShort(start, end, buf + ZIP_LOCAL_FLAGS_OFFS, z->isEncrypted + ZIP_LOCAL_FLAGS_UTF8);
    Set(Int,	LOCAL_SIG,	ZIP_LOCAL_HEADER_SIG);
    Set(Short,	LOCAL_VERSION,	ZIP_MIN_VERSION);
    Set(Short,	LOCAL_FLAGS,	z->isEncrypted | ZIP_LOCAL_FLAGS_UTF8);
    ZipWriteShort(start, end, buf + ZIP_LOCAL_COMPMETH_OFFS,
	    z->compressMethod);
    Set(Short,	LOCAL_COMPMETH, z->compressMethod);
    ZipWriteShort(start, end, buf + ZIP_LOCAL_MTIME_OFFS,
	    ToDosTime(z->timestamp));
    Set(Short,	LOCAL_MTIME,	ToDosTime(z->timestamp));
    ZipWriteShort(start, end, buf + ZIP_LOCAL_MDATE_OFFS,
	    ToDosDate(z->timestamp));
    ZipWriteInt(start, end, buf + ZIP_LOCAL_CRC32_OFFS, z->crc32);
    Set(Short,	LOCAL_MDATE,	ToDosDate(z->timestamp));
    Set(Int,	LOCAL_CRC32,	z->crc32);
    ZipWriteInt(start, end, buf + ZIP_LOCAL_COMPLEN_OFFS,
	    z->numCompressedBytes);
    ZipWriteInt(start, end, buf + ZIP_LOCAL_UNCOMPLEN_OFFS, z->numBytes);
    ZipWriteShort(start, end, buf + ZIP_LOCAL_PATHLEN_OFFS, nameLength);
    ZipWriteShort(start, end, buf + ZIP_LOCAL_EXTRALEN_OFFS, align);
    Set(Int,	LOCAL_COMPLEN,	z->numCompressedBytes);
    Set(Int,	LOCAL_UNCOMPLEN, z->numBytes);
    Set(Short,	LOCAL_PATHLEN,	nameLength);
    Set(Short,	LOCAL_EXTRALEN, align);
}

static void
SerializeCentralDirectoryEntry(
    const unsigned char *start,	/* The start of writable memory. */
    const unsigned char *end,	/* The end of writable memory. */
    unsigned char *buf,		/* Where to serialize to */
    ZipEntry *z,		/* The description of what to serialize. */
    size_t nameLength)		/* The length of the name. */
{
    ZipWriteInt(start, end, buf + ZIP_CENTRAL_SIG_OFFS,
	    ZIP_CENTRAL_HEADER_SIG);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_VERSIONMADE_OFFS,
	    ZIP_MIN_VERSION);
    Set(Int,	CENTRAL_SIG,		ZIP_CENTRAL_HEADER_SIG);
    Set(Short,	CENTRAL_VERSIONMADE,	ZIP_MIN_VERSION);
    Set(Short,	CENTRAL_VERSION,	ZIP_MIN_VERSION);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_VERSION_OFFS, ZIP_MIN_VERSION);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_FLAGS_OFFS, z->isEncrypted + ZIP_LOCAL_FLAGS_UTF8);
    Set(Short,	CENTRAL_FLAGS,		z->isEncrypted | ZIP_LOCAL_FLAGS_UTF8);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_COMPMETH_OFFS,
	    z->compressMethod);
    Set(Short,	CENTRAL_COMPMETH,	z->compressMethod);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_MTIME_OFFS,
	    ToDosTime(z->timestamp));
    Set(Short,	CENTRAL_MTIME,		ToDosTime(z->timestamp));
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_MDATE_OFFS,
	    ToDosDate(z->timestamp));
    ZipWriteInt(start, end, buf + ZIP_CENTRAL_CRC32_OFFS, z->crc32);
    Set(Short,	CENTRAL_MDATE,		ToDosDate(z->timestamp));
    Set(Int,	CENTRAL_CRC32,		z->crc32);
    ZipWriteInt(start, end, buf + ZIP_CENTRAL_COMPLEN_OFFS,
	    z->numCompressedBytes);
    ZipWriteInt(start, end, buf + ZIP_CENTRAL_UNCOMPLEN_OFFS, z->numBytes);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_PATHLEN_OFFS, nameLength);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_EXTRALEN_OFFS, 0);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_FCOMMENTLEN_OFFS, 0);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_DISKFILE_OFFS, 0);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_IATTR_OFFS, 0);
    ZipWriteInt(start, end, buf + ZIP_CENTRAL_EATTR_OFFS, 0);
    Set(Int,	CENTRAL_COMPLEN,	z->numCompressedBytes);
    Set(Int,	CENTRAL_UNCOMPLEN,	z->numBytes);
    Set(Short,	CENTRAL_PATHLEN,	nameLength);
    Set(Short,	CENTRAL_EXTRALEN,	0);
    Set(Short,	CENTRAL_FCOMMENTLEN,	0);
    Set(Short,	CENTRAL_DISKFILE,	0);
    Set(Short,	CENTRAL_IATTR,		0);
    Set(Int,	CENTRAL_EATTR,		0);
    ZipWriteInt(start, end, buf + ZIP_CENTRAL_LOCALHDR_OFFS,
	    z->offset);
    Set(Int,	CENTRAL_LOCALHDR,	z->offset);
}

static void
SerializeCentralDirectorySuffix(
    const unsigned char *start,	/* The start of writable memory. */
    const unsigned char *end,	/* The end of writable memory. */
    unsigned char *buf,		/* Where to serialize to */
    int entryCount,		/* The number of entries in the directory */
    long long directoryStartOffset,
				/* The overall file offset of the start of the
				 * central directory. */
    long long suffixStartOffset)/* The overall file offset of the start of the
				 * suffix of the central directory (i.e.,
				 * where this data will be written). */
{
    ZipWriteInt(start, end, buf + ZIP_CENTRAL_END_SIG_OFFS,
	    ZIP_CENTRAL_END_SIG);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_DISKNO_OFFS, 0);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_DISKDIR_OFFS, 0);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_ENTS_OFFS, entryCount);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_TOTALENTS_OFFS, entryCount);
    Set(Int,	CENTRAL_END_SIG,    ZIP_CENTRAL_END_SIG);
    Set(Short,	CENTRAL_DISKNO,     0);
    Set(Short,	CENTRAL_DISKDIR,    0);
    Set(Short,	CENTRAL_ENTS,       entryCount);
    Set(Short,	CENTRAL_TOTALENTS,  entryCount);
    ZipWriteInt(start, end, buf + ZIP_CENTRAL_DIRSIZE_OFFS,
	    suffixStartOffset - directoryStartOffset);
    Set(Int,	CENTRAL_DIRSIZE,    suffixStartOffset - directoryStartOffset);
    ZipWriteInt(start, end, buf + ZIP_CENTRAL_DIRSTART_OFFS,
	    directoryStartOffset);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_COMMENTLEN_OFFS, 0);
    Set(Int,	CENTRAL_DIRSTART,   directoryStartOffset);
    Set(Short,	CENTRAL_COMMENTLEN, 0);
}

#undef Set

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMkZipObjCmd, ZipFSLMkZipObjCmd --
 *
 *	These procedures are invoked to process the [zipfs mkzip] and [zipfs
 *	lmkzip] commands.  See description of ZipFSMkZipOrImg().
 *	lmkzip] commands. See description of ZipFSMkZipOrImg().
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See description of ZipFSMkZipOrImg().
 *
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994


3995
3996
3997
3998
3999
4000
4001
4070
4071
4072
4073
4074
4075
4076




4077
4078
4079
4080
4081
4082
4083
4084
4085







-
-
-
-
+
+







	mntPoint = ZIPFS_VOLUME;
    } else {
	if (NormalizeMountPoint(interp, Tcl_GetString(objv[1]), &dsMount) != TCL_OK) {
	    return TCL_ERROR;
	}
	mntPoint = Tcl_DStringValue(&dsMount);
    }
    (void)MapPathToZipfs(interp,
			 mntPoint,
			 Tcl_GetString(objv[objc - 1]),
			 &dsPath);
    (void) MapPathToZipfs(interp, mntPoint, Tcl_GetString(objv[objc - 1]),
	    &dsPath);
    Tcl_SetObjResult(interp, Tcl_DStringToObj(&dsPath));
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
4031
4032
4033
4034
4035
4036
4037
4038

4039
4040
4041
4042
4043
4044
4045
4046
4047
4115
4116
4117
4118
4119
4120
4121

4122
4123

4124
4125
4126
4127
4128
4129
4130







-
+

-








    filename = TclGetString(objv[1]);

    ReadLock();
    exists = ZipFSLookup(filename) != NULL;
    if (!exists) {
	/* An ancestor directory of a file ? */
	exists = ContainsMountPoint(filename, -1);
	exists = ContainsMountPoint(filename, TCL_AUTO_LENGTH);
    }

    Unlock();

    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(exists));
    return TCL_OK;
}

/*
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
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







-
+








-
-
-
-
+
+
+
-





-
+







    filename = TclGetString(objv[1]);
    ReadLock();
    z = ZipFSLookup(filename);
    if (z) {
	Tcl_Obj *result = Tcl_GetObjResult(interp);

	Tcl_ListObjAppendElement(interp, result,
		Tcl_NewStringObj(z->zipFilePtr->name, -1));
		Tcl_NewStringObj(z->zipFilePtr->name, TCL_AUTO_LENGTH));
	Tcl_ListObjAppendElement(interp, result,
		Tcl_NewWideIntObj(z->numBytes));
	Tcl_ListObjAppendElement(interp, result,
		Tcl_NewWideIntObj(z->numCompressedBytes));
	Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(z->offset));
	ret = TCL_OK;
    } else {
	Tcl_SetErrno(ENOENT);
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "path \"%s\" not found in any zipfs volume",
		    filename));
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"path \"%s\" not found in any zipfs volume",
		filename));
	}
	ret = TCL_ERROR;
    }
    Unlock();
    return ret;
}


/*
 *-------------------------------------------------------------------------
 *
 * ZipFSListObjCmd --
 *
 *	This procedure is invoked to process the [zipfs list] command.	 On
 *	success, it returns a Tcl list of files of the ZIP filesystem which
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
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







-
+









-
+








-
+







    if (pattern) {
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
		hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr);

	    if (Tcl_StringMatch(z->name, pattern)) {
		Tcl_ListObjAppendElement(interp, result,
			Tcl_NewStringObj(z->name, -1));
			Tcl_NewStringObj(z->name, TCL_AUTO_LENGTH));
	    }
	}
    } else if (regexp) {
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
		hPtr; hPtr = Tcl_NextHashEntry(&search)) {
	    ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr);

	    if (Tcl_RegExpExec(interp, regexp, z->name, z->name)) {
		Tcl_ListObjAppendElement(interp, result,
			Tcl_NewStringObj(z->name, -1));
			Tcl_NewStringObj(z->name, TCL_AUTO_LENGTH));
	    }
	}
    } else {
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
		hPtr; hPtr = Tcl_NextHashEntry(&search)) {
	    ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr);

	    Tcl_ListObjAppendElement(interp, result,
		    Tcl_NewStringObj(z->name, -1));
		    Tcl_NewStringObj(z->name, TCL_AUTO_LENGTH));
	}
    }
    Unlock();
    return TCL_OK;
}

/*
4226
4227
4228
4229
4230
4231
4232
4233

4234
4235
4236
4237
4238
4239
4240
4307
4308
4309
4310
4311
4312
4313

4314
4315
4316
4317
4318
4319
4320
4321







-
+







 */

/* Utility routine to centralize housekeeping */
static Tcl_Obj *
ScriptLibrarySetup(
    const char *dirName)
{
    Tcl_Obj *libDirObj = Tcl_NewStringObj(dirName, -1);
    Tcl_Obj *libDirObj = Tcl_NewStringObj(dirName, TCL_AUTO_LENGTH);
    Tcl_Obj *subDirObj, *searchPathObj;

    TclNewLiteralStringObj(subDirObj, "encoding");
    Tcl_IncrRefCount(subDirObj);
    TclNewObj(searchPathObj);
    Tcl_ListObjAppendElement(NULL, searchPathObj,
	    Tcl_FSJoinToPath(libDirObj, 1, &subDirObj));
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
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







+
-
+
-















-
+




-
+
+







+
-
+




+
-
+







	return ScriptLibrarySetup(zipfs_literal_tcl_library);
    }

    /*
     * Look for the library file system within the executable.
     */

    TclNewLiteralStringObj(vfsInitScript,
    vfsInitScript = Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl",
	    ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
	    -1);
    Tcl_IncrRefCount(vfsInitScript);
    found = Tcl_FSAccess(vfsInitScript, F_OK);
    Tcl_DecrRefCount(vfsInitScript);
    if (found == TCL_OK) {
	zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
	return ScriptLibrarySetup(zipfs_literal_tcl_library);
    }

    /*
     * Look for the library file system within the DLL/shared library.  Note
     * that we must mount the zip file and dll before releasing to search.
     */

#if !defined(STATIC_BUILD)
#if defined(_WIN32) || defined(__CYGWIN__)
    hModule = (HMODULE)TclWinGetTclInstance();
    hModule = (HMODULE) TclWinGetTclInstance();
    GetModuleFileNameW(hModule, wName, MAX_PATH);
#ifdef __CYGWIN__
    cygwin_conv_path(3, wName, dllName, sizeof(dllName));
#else
    WideCharToMultiByte(CP_UTF8, 0, wName, -1, dllName, sizeof(dllName), NULL, NULL);
    WideCharToMultiByte(CP_UTF8, 0, wName, -1, dllName, sizeof(dllName), NULL,
	    NULL);
#endif

    if (ZipfsAppHookFindTclInit(dllName) == TCL_OK) {
	return ScriptLibrarySetup(zipfs_literal_tcl_library);
    }
#elif !defined(NO_DLFCN_H)
    Dl_info dlinfo;
    if (dladdr((const void *) TclZipfs_TclLibrary, &dlinfo)
    if (dladdr((const void *)TclZipfs_TclLibrary, &dlinfo) && (dlinfo.dli_fname != NULL)
	    && (dlinfo.dli_fname != NULL)
	    && (ZipfsAppHookFindTclInit(dlinfo.dli_fname) == TCL_OK)) {
	return ScriptLibrarySetup(zipfs_literal_tcl_library);
    }
#else
    if (ZipfsAppHookFindTclInit(
    if (ZipfsAppHookFindTclInit(CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_DLLFILE) == TCL_OK) {
	    CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_DLLFILE) == TCL_OK) {
	return ScriptLibrarySetup(zipfs_literal_tcl_library);
    }
#endif /* _WIN32 */
#endif /* !defined(STATIC_BUILD) */

    /*
     * If anything set the cache (but subsequently failed) go with that
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407



4408
4409
4410
4411
4412
4413
4414
4482
4483
4484
4485
4486
4487
4488



4489
4490
4491
4492
4493
4494
4495
4496
4497
4498







-
-
-
+
+
+







    if (ZipChannelWritable(info)) {
	/*
	 * Copy channel data back into original file in archive.
	 */
	ZipEntry *z = info->zipEntryPtr;
	assert(info->ubufToFree && info->ubuf);
	unsigned char *newdata;
	newdata = (unsigned char *)Tcl_AttemptRealloc(
	    info->ubufToFree,
	    info->numBytes ? info->numBytes : 1); /* Bug [23dd83ce7c] */
	newdata = (unsigned char *) Tcl_AttemptRealloc(
		info->ubufToFree,
		info->numBytes ? info->numBytes : 1); /* Bug [23dd83ce7c] */
	if (newdata == NULL) {
	    /* Could not reallocate, keep existing buffer */
	    newdata = info->ubufToFree;
	}
	info->ubufToFree = NULL; /* Now newdata! */
	info->ubuf = NULL;
	info->ubufSize = 0;
4575
4576
4577
4578
4579
4580
4581
4582
4583


4584
4585
4586
4587
4588
4589
4590
4659
4660
4661
4662
4663
4664
4665


4666
4667
4668
4669
4670
4671
4672
4673
4674







-
-
+
+







	Tcl_Size needed = info->cursor + toWrite;
	/* Tack on a bit for future growth. */
	if (needed < (info->maxWrite - needed/2)) {
	    needed += needed / 2;
	} else {
	    needed = info->maxWrite;
	}
	unsigned char *newBuf =
	    (unsigned char *)Tcl_AttemptRealloc(info->ubufToFree, needed);
	unsigned char *newBuf = (unsigned char *)
		Tcl_AttemptRealloc(info->ubufToFree, needed);
	if (newBuf == NULL) {
	    *errloc = ENOMEM;
	    return -1;
	}
	info->ubufToFree = newBuf;
	info->ubuf = info->ubufToFree;
	info->ubufSize = needed;
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760

4761
4762
4763
4764
4765
4766
4767
4768
4769
4835
4836
4837
4838
4839
4840
4841



4842


4843
4844
4845
4846
4847
4848
4849







-
-
-
+
-
-








    int wr = (mode & (O_WRONLY | O_RDWR)) != 0;

    /* Check for unsupported modes. */

    if ((ZipFS.wrmax <= 0) && wr) {
	Tcl_SetErrno(EACCES);
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "writes not permitted: %s",
	ZIPFS_POSIX_ERROR(interp, "writes not permitted");
		    Tcl_PosixError(interp)));
	}
	return NULL;
    }

    if ((mode & (O_APPEND|O_TRUNC)) && !wr) {
	Tcl_SetErrno(EINVAL);
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808

4809
4810
4811
4812
4813
4814
4815
4816
4817
4879
4880
4881
4882
4883
4884
4885



4886


4887
4888
4889
4890
4891
4892
4893







-
-
-
+
-
-







	goto error;
    }

    /* Do we support opening the file that way? */

    if (wr && z->isDirectory) {
	Tcl_SetErrno(EISDIR);
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "unsupported file type: %s",
	ZIPFS_POSIX_ERROR(interp, "unsupported file type");
		    Tcl_PosixError(interp)));
	}
	goto error;
    }
    if ((z->compressMethod != ZIP_COMPMETH_STORED)
	    && (z->compressMethod != ZIP_COMPMETH_DEFLATED)) {
	ZIPFS_ERROR(interp, "unsupported compression method");
	ZIPFS_ERROR_CODE(interp, "COMP_METHOD");
	goto error;
4830
4831
4832
4833
4834
4835
4836
4837

4838
4839
4840
4841
4842
4843
4844
4906
4907
4908
4909
4910
4911
4912

4913
4914
4915
4916
4917
4918
4919
4920







-
+







	/* Read-only */
	flags |= TCL_READABLE;
    }

    if (z->isEncrypted) {
	if (z->numCompressedBytes < ZIP_CRYPT_HDR_LEN) {
	    ZIPFS_ERROR(interp,
			"decryption failed: truncated decryption header");
		    "decryption failed: truncated decryption header");
	    ZIPFS_ERROR_CODE(interp, "DECRYPT");
	    goto error;
	}
	if (z->zipFilePtr->passBuf[0] == 0) {
	    ZIPFS_ERROR(interp, "decryption failed - no password provided");
	    ZIPFS_ERROR_CODE(interp, "DECRYPT");
	    goto error;
4946
4947
4948
4949
4950
4951
4952
4953

4954
4955
4956
4957
4958
4959
4960
5022
5023
5024
5025
5026
5027
5028

5029
5030
5031
5032
5033
5034
5035
5036







-
+







     * Set up a writable channel.
     */

    info->mode = mode;
    info->maxWrite = ZipFS.wrmax;

    info->ubufSize = z->numBytes ? z->numBytes : 1;
    info->ubufToFree = (unsigned char *)Tcl_AttemptAlloc(info->ubufSize);
    info->ubufToFree = (unsigned char *) Tcl_AttemptAlloc(info->ubufSize);
    info->ubuf = info->ubufToFree;
    if (info->ubufToFree == NULL) {
	goto memoryError;
    }

    if (z->isEncrypted) {
	assert(z->numCompressedBytes >= ZIP_CRYPT_HDR_LEN); /* caller should have checked*/
4997
4998
4999
5000
5001
5002
5003
5004


5005
5006
5007

5008

5009
5010
5011
5012
5013
5014
5015
5016
5017
5018
5019
5020
5021
5022

5023
5024
5025
5026
5027
5028


5029
5030
5031
5032
5033
5034
5035
5073
5074
5075
5076
5077
5078
5079

5080
5081
5082
5083
5084
5085

5086
5087
5088
5089
5090
5091
5092
5093
5094
5095
5096
5097
5098
5099

5100
5101
5102
5103
5104


5105
5106
5107
5108
5109
5110
5111
5112
5113







-
+
+



+
-
+













-
+




-
-
+
+







	    stream.zalloc = Z_NULL;
	    stream.zfree = Z_NULL;
	    stream.opaque = Z_NULL;
	    stream.avail_in = z->numCompressedBytes;
	    if (z->isEncrypted) {
		unsigned int j;

		/* Min length ZIP_CRYPT_HDR_LEN for keys should already been checked. */
		/* Min length ZIP_CRYPT_HDR_LEN for keys should already been
		 * checked. */
		assert(stream.avail_in >= ZIP_CRYPT_HDR_LEN);

		stream.avail_in -= ZIP_CRYPT_HDR_LEN;
		cbuf = (unsigned char *)
		cbuf = (unsigned char *) Tcl_AttemptAlloc(stream.avail_in ? stream.avail_in : 1);
			Tcl_AttemptAlloc(stream.avail_in ? stream.avail_in : 1);
		if (!cbuf) {
		    goto memoryError;
		}
		for (j = 0; j < stream.avail_in; j++) {
		    ch = zbuf[j];
		    cbuf[j] = zdecode(info->keys, crc32tab, ch);
		}
		stream.next_in = cbuf;
	    } else {
		stream.next_in = zbuf;
	    }
	    stream.next_out = info->ubuf;
	    stream.avail_out = info->ubufSize;
	    if (inflateInit2(&stream, -15) != Z_OK) {
	    if (inflateInit2(&stream, ZLIB_MODE_RAW) != Z_OK) {
		goto corruptionError;
	    }
	    err = inflate(&stream, Z_SYNC_FLUSH);
	    inflateEnd(&stream);
	    if ((err != Z_STREAM_END) &&
		    ((err != Z_OK) || (stream.avail_in != 0))) {
	    if ((err != Z_STREAM_END)
		    && ((err != Z_OK) || (stream.avail_in != 0))) {
		goto corruptionError;
	    }
	    /* Even if decompression succeeded, counts should be as expected */
	    if ((int) stream.total_out != z->numBytes) {
		goto corruptionError;
	    }
	    info->numBytes = z->numBytes;
5115
5116
5117
5118
5119
5120
5121
5122

5123
5124
5125
5126
5127
5128
5129
5130
5131
5132
5133
5134
5135
5136
5137
5138
5139
5140
5141
5142

5143
5144
5145
5146
5147
5148
5149
5150
5151
5152
5153
5154
5155
5156
5157
5158
5159
5160

5161

5162
5163
5164
5165
5166
5167
5168
5169
5170
5171
5172
5173
5174
5175
5176

5177
5178
5179
5180
5181
5182
5183

5184
5185
5186
5187
5188
5189
5190
5193
5194
5195
5196
5197
5198
5199

5200
5201
5202
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219

5220
5221
5222
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
5237
5238
5239

5240
5241
5242
5243
5244
5245
5246
5247
5248
5249
5250
5251
5252
5253
5254

5255
5256
5257
5258
5259
5260
5261

5262
5263
5264
5265
5266
5267
5268
5269







-
+



















-
+


















+
-
+














-
+






-
+







    ZipChannel *info,		/* The channel to set up. */
    ZipEntry *z)		/* The zipped file that the channel will read
				 * from. */
{
    unsigned char *ubuf = NULL;
    int ch;

    info->iscompr = (z->compressMethod == ZIP_COMPMETH_DEFLATED);
    info->isCompressed = (z->compressMethod == ZIP_COMPMETH_DEFLATED);
    info->ubuf = z->zipFilePtr->data + z->offset;
    info->ubufToFree = NULL; /* ubuf memory not allocated */
    info->ubufSize = 0;
    info->isDirectory = z->isDirectory;
    info->isEncrypted = z->isEncrypted;
    info->mode = O_RDONLY;

    /* Caller must validate - bug [6ed3447a7e] */
    assert(z->numBytes >= 0 && z->numCompressedBytes >= 0);
    info->numBytes = z->numBytes;

    if (info->isEncrypted) {
	assert(z->numCompressedBytes >= ZIP_CRYPT_HDR_LEN); /* caller should have checked*/
	if (DecodeCryptHeader(interp, z, info->keys, info->ubuf) != TCL_OK) {
	    goto error_cleanup;
	}
	info->ubuf += ZIP_CRYPT_HDR_LEN;
    }

    if (info->iscompr) {
    if (info->isCompressed) {
	z_stream stream;
	int err;
	unsigned int j;

	/*
	 * Data to decode is compressed, and possibly encrpyted too. If
	 * encrypted, local variable ubuf is used to hold the decrypted but
	 * still compressed data.
	 */

	memset(&stream, 0, sizeof(z_stream));
	stream.zalloc = Z_NULL;
	stream.zfree = Z_NULL;
	stream.opaque = Z_NULL;
	stream.avail_in = z->numCompressedBytes;
	if (info->isEncrypted) {
	    assert(stream.avail_in >= ZIP_CRYPT_HDR_LEN);
	    stream.avail_in -= ZIP_CRYPT_HDR_LEN;
	    ubuf = (unsigned char *)
	    ubuf = (unsigned char *) Tcl_AttemptAlloc(stream.avail_in ? stream.avail_in : 1);
		    Tcl_AttemptAlloc(stream.avail_in ? stream.avail_in : 1);
	    if (!ubuf) {
		goto memoryError;
	    }

	    for (j = 0; j < stream.avail_in; j++) {
		ch = info->ubuf[j];
		ubuf[j] = zdecode(info->keys, crc32tab, ch);
	    }
	    stream.next_in = ubuf;
	} else {
	    stream.next_in = info->ubuf;
	}

	info->ubufSize = info->numBytes ? info->numBytes : 1;
	info->ubufToFree = (unsigned char *)Tcl_AttemptAlloc(info->ubufSize);
	info->ubufToFree = (unsigned char *) Tcl_AttemptAlloc(info->ubufSize);
	info->ubuf = info->ubufToFree;
	stream.next_out = info->ubuf;
	if (!info->ubuf) {
	    goto memoryError;
	}
	stream.avail_out = info->numBytes;
	if (inflateInit2(&stream, -15) != Z_OK) {
	if (inflateInit2(&stream, ZLIB_MODE_RAW) != Z_OK) {
	    goto corruptionError;
	}
	err = inflate(&stream, Z_SYNC_FLUSH);
	inflateEnd(&stream);

	/*
	 * Decompression was successful if we're either in the END state, or
5291
5292
5293
5294
5295
5296
5297
5298

5299
5300
5301
5302
5303
5304
5305
5370
5371
5372
5373
5374
5375
5376

5377
5378
5379
5380
5381
5382
5383
5384







-
+







	    buf->st_mode = S_IFREG | 0555;
	}
	buf->st_size = z->numBytes;
	buf->st_mtime = z->timestamp;
	buf->st_ctime = z->timestamp;
	buf->st_atime = z->timestamp;
	ret = 0;
    } else if (ContainsMountPoint(path, -1)) {
    } else if (ContainsMountPoint(path, TCL_AUTO_LENGTH)) {
	/* An intermediate dir under which a mount exists */
	memset(buf, 0, sizeof(Tcl_StatBuf));
	Tcl_Time t;
	Tcl_GetTime(&t);
	buf->st_atime = buf->st_mtime = buf->st_ctime = t.sec;
	buf->st_mode = S_IFDIR | 0555;
	ret = 0;
5347
5348
5349
5350
5351
5352
5353
5354

5355
5356
5357
5358
5359
5360

5361
5362
5363
5364
5365
5366
5367
5426
5427
5428
5429
5430
5431
5432

5433
5434
5435
5436
5437
5438

5439
5440
5441
5442
5443
5444
5445
5446







-
+





-
+







	if (mode & W_OK) {
	    access = -1;
	} else {
	    /*
	     * Even if entry does not exist, could be intermediate dir
	     * containing a mount point
	     */
	    access = ContainsMountPoint(path, -1) ? 0 : -1;
	    access = ContainsMountPoint(path, TCL_AUTO_LENGTH) ? 0 : -1;
	}
    }
    Unlock();
    return access;
}


/*
 *-------------------------------------------------------------------------
 *
 * ZipFSOpenFileChannelProc --
 *
 *	Open a channel to a file in a mounted ZIP archive. Delegates to
 *	ZipChannelOpen().
5385
5386
5387
5388
5389
5390
5391
5392

5393
5394
5395
5396
5397
5398
5399
5464
5465
5466
5467
5468
5469
5470

5471
5472
5473
5474
5475
5476
5477
5478







-
+







    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return NULL;
    }

    return ZipChannelOpen(interp, Tcl_GetString(pathPtr), mode);
}


/*
 *-------------------------------------------------------------------------
 *
 * ZipFSStatProc --
 *
 *	This function implements the ZIP filesystem specific version of the
 *	library version of stat.
5467
5468
5469
5470
5471
5472
5473
5474

5475
5476
5477
5478
5479
5480
5481
5482
5483
5484
5485
5486
5487
5488
5489
5490
5491
5492
5493
5494
5495


5496
5497
5498
5499
5500

5501
5502
5503
5504
5505
5506
5507
5546
5547
5548
5549
5550
5551
5552

5553
5554
5555
5556
5557
5558
5559
5560
5561
5562
5563
5564
5565
5566
5567
5568
5569
5570
5571
5572


5573
5574
5575
5576
5577
5578
5579
5580
5581
5582
5583
5584
5585
5586
5587







-
+



















-
-
+
+





+







 *-------------------------------------------------------------------------
 */

static Tcl_Obj *
ZipFSFilesystemSeparatorProc(
    TCL_UNUSED(Tcl_Obj *) /*pathPtr*/)
{
    return Tcl_NewStringObj("/", -1);
    return Tcl_NewStringObj("/", 1);
}

/*
 *-------------------------------------------------------------------------
 *
 * AppendWithPrefix --
 *
 *	Worker for ZipFSMatchInDirectoryProc() that is a wrapper around
 *	Tcl_ListObjAppendElement() which knows about handling prefixes.
 *
 *-------------------------------------------------------------------------
 */

static inline void
AppendWithPrefix(
    Tcl_Obj *result,		/* Where to append a list element to. */
    Tcl_DString *prefix,	/* The prefix to add to the element, or NULL
				 * for don't do that. */
    const char *name,		/* The name to append. */
    size_t nameLen)		/* The length of the name. May be TCL_INDEX_NONE for
				 * append-up-to-NUL-byte. */
    size_t nameLen)		/* The length of the name. May be TCL_INDEX_NONE
				 * for append-up-to-NUL-byte. */
{
    if (prefix) {
	size_t prefixLength = Tcl_DStringLength(prefix);

	Tcl_DStringAppend(prefix, name, nameLen);
	/* Don't use Tcl_DStringToObj(); we want to reuse prefix. */
	Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(
		Tcl_DStringValue(prefix), Tcl_DStringLength(prefix)));
	Tcl_DStringSetLength(prefix, prefixLength);
    } else {
	Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(name, nameLen));
    }
}
5531
5532
5533
5534
5535
5536
5537
5538

5539
5540
5541
5542
5543
5544
5545
5546
5547
5548
5549
5550
5551
5552
5553
5554



5555
5556
5557
5558
5559
5560
5561
5562
5563
5564

5565
5566
5567
5568
5569
5570
5571
5572
5573

5574
5575
5576
5577
5578
5579

5580
5581
5582

5583
5584
5585
5586
5587
5588
5589
5590
5591
5592


5593
5594
5595
5596
5597
5598
5599
5611
5612
5613
5614
5615
5616
5617

5618
5619
5620
5621
5622
5623
5624
5625
5626
5627
5628
5629
5630




5631
5632
5633

5634
5635
5636
5637
5638
5639
5640


5641
5642
5643
5644
5645
5646
5647
5648
5649

5650
5651
5652
5653
5654
5655

5656
5657
5658

5659
5660
5661
5662
5663
5664
5665
5666
5667


5668
5669
5670
5671
5672
5673
5674
5675
5676







-
+












-
-
-
-
+
+
+
-







-
-
+








-
+





-
+


-
+








-
-
+
+







    Tcl_Obj *result,		/* Where to append matched items to. */
    Tcl_Obj *pathPtr,		/* Where we are looking. */
    const char *pattern,	/* What names we are looking for. */
    Tcl_GlobTypeData *types)	/* What types we are looking for. */
{
    Tcl_Obj *normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    int scnt, l;
    Tcl_Size prefixLen, len, strip = 0;
    Tcl_Size len, strip = 0;
    char *pat, *prefix, *path;
    Tcl_DString dsPref, *prefixBuf = NULL;
    int foundInHash, notDuplicate;
    ZipEntry *z;
    int wanted; /* TCL_GLOB_TYPE* */

    if (!normPathPtr) {
	return -1;
    }
    if (types) {
	wanted = types->type;
	if ((wanted & TCL_GLOB_TYPE_MOUNT) && (wanted != TCL_GLOB_TYPE_MOUNT)) {
	    if (interp) {
		ZIPFS_ERROR(interp,
			      "Internal error: TCL_GLOB_TYPE_MOUNT should not "
			      "be set in conjunction with other glob types.");
	    ZIPFS_ERROR(interp,
		    "Internal error: TCL_GLOB_TYPE_MOUNT should not "
		    "be set in conjunction with other glob types.");
	    }
	    return TCL_ERROR;
	}
	if ((wanted & (TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE |
		TCL_GLOB_TYPE_MOUNT)) == 0) {
	    /* Not looking for files,dirs,mounts. zipfs cannot have others */
	    return TCL_OK;
	}
	wanted &=
	    (TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE | TCL_GLOB_TYPE_MOUNT);
	wanted &= TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE | TCL_GLOB_TYPE_MOUNT;
    } else {
	wanted = TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE;
    }

    /*
     * The prefix that gets prepended to results.
     */

    prefix = TclGetStringFromObj(pathPtr, &prefixLen);
    prefix = TclGetString(pathPtr);

    /*
     * The (normalized) path we're searching.
     */

    path = TclGetStringFromObj(normPathPtr, &len);
    path = Tcl_GetStringFromObj(normPathPtr, &len);

    Tcl_DStringInit(&dsPref);
    if (strcmp(prefix, path) == 0) {
    if (!strcmp(prefix, path)) {
	prefixBuf = NULL;
    } else {
	/*
	 * We need to strip the normalized prefix of the filenames and replace
	 * it with the official prefix that we were expecting to get.
	 */

	strip = len + 1;
	Tcl_DStringAppend(&dsPref, prefix, prefixLen);
	Tcl_DStringAppend(&dsPref, "/", 1);
	TclDStringAppendObj(&dsPref, pathPtr);
	TclDStringAppendLiteral(&dsPref, "/");
	prefix = Tcl_DStringValue(&dsPref);
	prefixBuf = &dsPref;
    }

    ReadLock();

    /*
5662
5663
5664
5665
5666
5667
5668
5669

5670
5671
5672
5673
5674
5675


5676
5677
5678
5679
5680


5681
5682
5683
5684
5685
5686
5687
5688
5689
5690
5691
5692
5693
5694
5695
5696

5697
5698
5699
5700
5701
5702
5703
5704

5705
5706
5707


5708
5709
5710


5711
5712
5713
5714
5715
5716
5717
5739
5740
5741
5742
5743
5744
5745

5746
5747
5748
5749
5750


5751
5752
5753
5754
5755
5756

5757
5758
5759
5760
5761
5762
5763
5764
5765
5766
5767
5768
5769
5770
5771
5772
5773

5774
5775
5776
5777
5778
5779
5780
5781

5782
5783


5784
5785
5786


5787
5788
5789
5790
5791
5792
5793
5794
5795







-
+




-
-
+
+




-
+
+















-
+







-
+

-
-
+
+

-
-
+
+







    Tcl_InitHashTable(&duplicates, TCL_STRING_KEYS);

    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    if (foundInHash) {
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); hPtr;
		hPtr = Tcl_NextHashEntry(&search)) {
	    z = (ZipEntry *)Tcl_GetHashValue(hPtr);
	    z = (ZipEntry *) Tcl_GetHashValue(hPtr);

	    if ((wanted == (TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE)) ||
		    (wanted == TCL_GLOB_TYPE_DIR && z->isDirectory) ||
		    (wanted == TCL_GLOB_TYPE_FILE && !z->isDirectory)) {
		if ((z->depth == scnt) &&
			((z->flags & ZE_F_VOLUME) == 0) /* Bug 14db54d81e */
		if ((z->depth == scnt)
			&& ((z->flags & ZE_F_VOLUME) == 0) /* Bug 14db54d81e */
			&& Tcl_StringCaseMatch(z->name, pat, 0)) {
		    Tcl_CreateHashEntry(&duplicates, z->name + strip,
			    &notDuplicate);
		    assert(notDuplicate);
		    AppendWithPrefix(result, prefixBuf, z->name + strip, -1);
		    AppendWithPrefix(result, prefixBuf, z->name + strip,
			    TCL_AUTO_LENGTH);
		}
	    }
	}
    }
    if (wanted & TCL_GLOB_TYPE_DIR) {
	/*
	 * Also check paths that are ancestors of a mount. e.g. glob
	 * //zipfs:/a/? with mount at //zipfs:/a/b/c. Also have to be
	 * careful about duplicates, such as when another mount is
	 * //zipfs:/a/b/d
	 */
	Tcl_DString ds;
	Tcl_DStringInit(&ds);
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
		hPtr = Tcl_NextHashEntry(&search)) {
	    ZipFile *zf = (ZipFile *)Tcl_GetHashValue(hPtr);
	    ZipFile *zf = (ZipFile *) Tcl_GetHashValue(hPtr);
	    if (Tcl_StringCaseMatch(zf->mountPoint, pat, 0)) {
		const char *tail = zf->mountPoint + len;
		if (*tail == '\0') {
		    continue;
		}
		const char *end = strchr(tail, '/');
		Tcl_DStringAppend(&ds, zf->mountPoint + strip,
			end ? (Tcl_Size)(end - zf->mountPoint) : -1);
			end ? (Tcl_Size)(end - zf->mountPoint) : TCL_AUTO_LENGTH);
		const char *matchedPath = Tcl_DStringValue(&ds);
		(void)Tcl_CreateHashEntry(
		    &duplicates, matchedPath, &notDuplicate);
		(void) Tcl_CreateHashEntry(
			&duplicates, matchedPath, &notDuplicate);
		if (notDuplicate) {
		    AppendWithPrefix(
			result, prefixBuf, matchedPath, Tcl_DStringLength(&ds));
		    AppendWithPrefix(result, prefixBuf, matchedPath,
			    Tcl_DStringLength(&ds));
		}
		Tcl_DStringFree(&ds);
	    }
	}
    }
    Tcl_DeleteHashTable(&duplicates);
    Tcl_Free(pat);
5751
5752
5753
5754
5755
5756
5757
5758

5759
5760
5761
5762
5763
5764
5765
5829
5830
5831
5832
5833
5834
5835

5836
5837
5838
5839
5840
5841
5842
5843







-
+







				 * filenames, or NULL if no prefix is to be
				 * used. */
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    int l;
    Tcl_Size normLength;
    const char *path = TclGetStringFromObj(normPathPtr, &normLength);
    const char *path = Tcl_GetStringFromObj(normPathPtr, &normLength);
    Tcl_Size len = normLength;

    if (len < 1) {
	/*
	 * Shouldn't happen. But "shouldn't"...
	 */

5785
5786
5787
5788
5789
5790
5791
5792

5793
5794

5795
5796
5797
5798
5799
5800
5801
5802

5803
5804
5805
5806
5807
5808
5809
5863
5864
5865
5866
5867
5868
5869

5870
5871

5872
5873
5874
5875
5876
5877
5878
5879

5880
5881
5882
5883
5884
5885
5886
5887







-
+

-
+







-
+







	    /*
	     * Enumerate the contents of the ZIP; it's mounted on the root.
	     * TODO - a holdover from androwish? Tcl does not allow mounting
	     * outside of the //zipfs:/ area.
	     */

	    for (z = zf->topEnts; z; z = z->tnext) {
		Tcl_Size lenz = strlen(z->name);
		Tcl_Size lenz = ZipEntryNameLength(z);

		if ((lenz > len + 1) && (strncmp(z->name, path, len) == 0)
		if ((lenz > len + 1) && !strncmp(z->name, path, len)
			&& (z->name[len] == '/')
			&& ((int) CountSlashes(z->name) == l)
			&& Tcl_StringCaseMatch(z->name + len + 1, pattern, 0)) {
		    AppendWithPrefix(result, prefix, z->name, lenz);
		}
	    }
	} else if ((zf->mountPointLen > len + 1)
		&& (strncmp(zf->mountPoint, path, len) == 0)
		&& !strncmp(zf->mountPoint, path, len)
		&& (zf->mountPoint[len] == '/')
		&& ((int) CountSlashes(zf->mountPoint) == l)
		&& Tcl_StringCaseMatch(zf->mountPoint + len + 1,
			pattern, 0)) {
	    /*
	     * Standard mount; append if it matches.
	     */
5838
5839
5840
5841
5842
5843
5844
5845

5846
5847
5848
5849
5850
5851
5852

5853
5854
5855
5856
5857
5858
5859
5916
5917
5918
5919
5920
5921
5922

5923
5924
5925
5926
5927
5928
5929

5930
5931
5932
5933
5934
5935
5936
5937







-
+






-
+







    Tcl_Size len;
    char *path;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }
    path = TclGetStringFromObj(pathPtr, &len);
    path = Tcl_GetStringFromObj(pathPtr, &len);

    /*
     * Claim any path under ZIPFS_VOLUME as ours. This is both a necessary
     * and sufficient condition as zipfs mounts at arbitrary paths are
     * not permitted (unlike Androwish).
     */
    return strncmp(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN) ? -1 : TCL_OK;
    return HasVolumePrefix(path) ? TCL_OK : -1;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSListVolumesProc --
 *
5867
5868
5869
5870
5871
5872
5873

5874


5875
5876
5877
5878
5879
5880
5881
5945
5946
5947
5948
5949
5950
5951
5952

5953
5954
5955
5956
5957
5958
5959
5960
5961







+
-
+
+







 *
 *-------------------------------------------------------------------------
 */

static Tcl_Obj *
ZipFSListVolumesProc(void)
{
    Tcl_Obj *volume;
    return Tcl_NewStringObj(ZIPFS_VOLUME, -1);
    TclNewLiteralStringObj(volume, ZIPFS_VOLUME);
    return volume;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSFileAttrStringsProc --
 *
5957
5958
5959
5960
5961
5962
5963
5964

5965
5966
5967

5968
5969
5970
5971
5972
5973
5974
5975
5976
5977
5978
5979
5980
5981
5982
5983
5984
5985
5986
5987

5988
5989
5990
5991
5992
5993


5994
5995
5996

5997
5998
5999
6000
6001
6002
6003
6037
6038
6039
6040
6041
6042
6043

6044
6045
6046

6047
6048
6049
6050
6051
6052
6053
6054
6055
6056
6057
6058
6059
6060
6061
6062
6063
6064
6065
6066

6067
6068
6069
6070
6071
6072

6073
6074
6075
6076

6077
6078
6079
6080
6081
6082
6083
6084







-
+


-
+



















-
+





-
+
+


-
+







    char *path;
    ZipEntry *z;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }
    path = TclGetStringFromObj(pathPtr, &len);
    path = Tcl_GetStringFromObj(pathPtr, &len);
    ReadLock();
    z = ZipFSLookup(path);
    if (!z && !ContainsMountPoint(path, -1)) {
    if (!z && !ContainsMountPoint(path, TCL_AUTO_LENGTH)) {
	Tcl_SetErrno(ENOENT);
	ZIPFS_POSIX_ERROR(interp, "file not found");
	ret = TCL_ERROR;
	goto done;
    }
    /* z == NULL for intermediate directories that are ancestors of mounts */
    switch (index) {
    case ZIP_ATTR_UNCOMPSIZE:
	TclNewIntObj(*objPtrRef, z ? z->numBytes : 0);
	break;
    case ZIP_ATTR_COMPSIZE:
	TclNewIntObj(*objPtrRef, z ? z->numCompressedBytes : 0);
	break;
    case ZIP_ATTR_OFFSET:
	TclNewIntObj(*objPtrRef, z ? z->offset : 0);
	break;
    case ZIP_ATTR_MOUNT:
	if (z) {
	    *objPtrRef = Tcl_NewStringObj(z->zipFilePtr->mountPoint,
					  z->zipFilePtr->mountPointLen);
		    z->zipFilePtr->mountPointLen);
	} else {
	    *objPtrRef = Tcl_NewStringObj("", 0);
	}
	break;
    case ZIP_ATTR_ARCHIVE:
	*objPtrRef = Tcl_NewStringObj(z ? z->zipFilePtr->name : "", -1);
	*objPtrRef = Tcl_NewStringObj(
		z ? z->zipFilePtr->name : "", TCL_AUTO_LENGTH);
	break;
    case ZIP_ATTR_PERMISSIONS:
	*objPtrRef = Tcl_NewStringObj("0o555", -1);
	*objPtrRef = Tcl_NewStringObj("0o555", TCL_AUTO_LENGTH);
	break;
    case ZIP_ATTR_CRC:
	TclNewIntObj(*objPtrRef, z ? z->crc32 : 0);
	break;
    default:
	ZIPFS_ERROR(interp, "unknown attribute");
	ZIPFS_ERROR_CODE(interp, "FILE_ATTR");
6050
6051
6052
6053
6054
6055
6056
6057

6058
6059
6060
6061
6062
6063
6064
6131
6132
6133
6134
6135
6136
6137

6138
6139
6140
6141
6142
6143
6144
6145







-
+







 *-------------------------------------------------------------------------
 */

static Tcl_Obj *
ZipFSFilesystemPathTypeProc(
    TCL_UNUSED(Tcl_Obj *) /*pathPtr*/)
{
    return Tcl_NewStringObj("zip", -1);
    return Tcl_NewStringObj("zip", TCL_AUTO_LENGTH);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSLoadFile --
 *
6218
6219
6220
6221
6222
6223
6224
6225
6226



6227
6228
6229
6230
6231
6232
6233
6299
6300
6301
6302
6303
6304
6305


6306
6307
6308
6309
6310
6311
6312
6313
6314
6315







-
-
+
+
+







	{NULL, NULL, NULL, NULL, NULL, 0}
    };
    static const char findproc[] =
	"namespace eval ::tcl::zipfs {}\n"
	"proc ::tcl::zipfs::Find dir {\n"
	"    set result {}\n"
	"    if {[catch {\n"
        "        concat [glob -directory $dir -nocomplain *] [glob -directory $dir -types hidden -nocomplain *]\n"
        "    } list]} {\n"
	"        concat [glob -directory $dir -nocomplain *] "
			"[glob -directory $dir -types hidden -nocomplain *]\n"
	"    } list]} {\n"
	"        return $result\n"
	"    }\n"
	"    foreach file $list {\n"
	"        if {[file tail $file] in {. ..}} {\n"
	"            continue\n"
	"        }\n"
	"        lappend result $file {*}[Find $file]\n"
6321
6322
6323
6324
6325
6326
6327
6328
6329
6330



6331
6332
6333

6334
6335
6336

6337
6338
6339
6340
6341
6342
6343
6403
6404
6405
6406
6407
6408
6409



6410
6411
6412
6413
6414

6415
6416
6417

6418
6419
6420
6421
6422
6423
6424
6425







-
-
-
+
+
+


-
+


-
+







#endif

/*
 *------------------------------------------------------------------------
 *
 * TclZipfsFinalize --
 *
 *    Frees all zipfs resources IRRESPECTIVE of open channels (there should
 *    not be any!) etc. To be called at process exit time (from
 *    Tcl_Finalize->TclFinalizeFilesystem)
 *	Frees all zipfs resources IRRESPECTIVE of open channels (there should
 *	not be any!) etc. To be called at process exit time (from
 *	Tcl_Finalize->TclFinalizeFilesystem)
 *
 * Results:
 *    None.
 *	None.
 *
 * Side effects:
 *    Frees up archives loaded into memory.
 *	Frees up archives loaded into memory.
 *
 *------------------------------------------------------------------------
 */
void
TclZipfsFinalize(void)
{
    WriteLock();
6450
6451
6452
6453
6454
6455
6456
6457

6458
6459
6460
6461
6462
6463
6464
6532
6533
6534
6535
6536
6537
6538

6539
6540
6541
6542
6543
6544
6545
6546







-
+







	Tcl_DString ds;

	Tcl_DStringInit(&ds);
	archive = Tcl_WCharToUtfDString((*argvPtr)[1], TCL_INDEX_NONE, &ds);
#else /* !_WIN32 */
	archive = (*argvPtr)[1];
#endif /* _WIN32 */
	if (strcmp(archive, "install") == 0) {
	if (!strcmp(archive, "install")) {
	    Tcl_Obj *vfsInitScript;

	    /*
	     * Run this now to ensure the file is present by the time Tcl_Main
	     * wants it.
	     */

6511
6512
6513
6514
6515
6516
6517








6518
6519
6520
6521
6522
6523
6524

6525
6526
6527
6528

6529
6530
6531
6532
6533
6534
6535
6536
6537
6538
6539
6540
6541

6542
6543
6544
6545
6546
6547
6548
6549
6550
6551

6552
6553
6554
6555
6556
6557
6558
6559
6560
6561

6562
6563
6564
6565
6566
6567
6568
6593
6594
6595
6596
6597
6598
6599
6600
6601
6602
6603
6604
6605
6606
6607
6608
6609
6610
6611
6612
6613

6614
6615
6616


6617
6618
6619
6620
6621
6622
6623
6624
6625
6626
6627
6628


6629
6630
6631
6632
6633
6634
6635
6636
6637


6638
6639
6640
6641
6642
6643
6644
6645
6646
6647

6648
6649
6650
6651
6652
6653
6654
6655







+
+
+
+
+
+
+
+






-
+


-
-
+











-
-
+








-
-
+









-
+







 *
 * TclZipfs_Mount, TclZipfs_MountBuffer, TclZipfs_Unmount --
 *
 *	Dummy version when no ZLIB support available.
 *
 *-------------------------------------------------------------------------
 */

static inline void
Unsupported(
    Tcl_Interp *interp)
{
    ZIPFS_ERROR(interp, "no zlib available");
    ZIPFS_ERROR_CODE(interp, "NO_ZLIB");
}

int
TclZipfs_Mount(
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(const char *),	/* Path to ZIP file to mount. */
    TCL_UNUSED(const char *),	/* Mount point path. */
    TCL_UNUSED(const char *))		/* Password for opening the ZIP, or NULL if
    TCL_UNUSED(const char *))	/* Password for opening the ZIP, or NULL if
				 * the ZIP is unprotected. */
{
    ZIPFS_ERROR(interp, "no zlib available");
    ZIPFS_ERROR_CODE(interp, "NO_ZLIB");
    Unsupported(interp);
    return TCL_ERROR;
}

int
TclZipfs_MountBuffer(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    TCL_UNUSED(const void *),
    TCL_UNUSED(size_t),
    TCL_UNUSED(const char *),	/* Mount point path. */
    TCL_UNUSED(int))
{
    ZIPFS_ERROR(interp, "no zlib available");
    ZIPFS_ERROR_CODE(interp, "NO_ZLIB");
    Unsupported(interp);
    return TCL_ERROR;
}

int
TclZipfs_Unmount(
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(const char *))	/* Mount point path. */
{
    ZIPFS_ERROR(interp, "no zlib available");
    ZIPFS_ERROR_CODE(interp, "NO_ZLIB");
    Unsupported(interp);
    return TCL_ERROR;
}

const char *
TclZipfs_AppHook(
    TCL_UNUSED(int *), /*argcPtr*/
#ifdef _WIN32
    TCL_UNUSED(WCHAR ***)) /* argvPtr */
#else /* !_WIN32 */
    TCL_UNUSED(char ***))		/* Pointer to argv */
    TCL_UNUSED(char ***))	/* Pointer to argv */
#endif /* _WIN32 */
{
    return NULL;
}

Tcl_Obj *
TclZipfs_TclLibrary(void)
Changes to generic/tclZlib.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16















17
18
19
20
21
22
23
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

-
-
-
-











+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclZlib.c --
 *
 *	This file provides the interface to the Zlib library.
 *
 * Copyright © 2004-2005 Pascal Scheffers <pascal@scheffers.net>
 * Copyright © 2005 Unitas Software B.V.
 * Copyright © 2008-2012 Donal K. Fellows
 *
 * Parts written by Jean-Claude Wippler, as part of Tclkit, placed in the
 * public domain March 2003.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/

/*
 * tclZlib.c --
 *
 *	This file provides the interface to the Zlib library.
 */

#include "tclInt.h"
#ifdef HAVE_ZLIB
#include "zlib.h"
#include "tclIO.h"

/*
 * The version of the zlib "package" that this implements. Note that this
440
441
442
443
444
445
446
447

448
449
450
451
452
453
454
451
452
453
454
455
456
457

458
459
460
461
462
463
464
465







-
+







	"binary", "text"
    };

    if (TclDictGet(interp, dictObj, "comment", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL) {
	Tcl_EncodingState state;
	valueStr = TclGetStringFromObj(value, &length);
	valueStr = Tcl_GetStringFromObj(value, &length);
	result = Tcl_UtfToExternal(NULL, latin1enc, valueStr, length,
		TCL_ENCODING_START|TCL_ENCODING_END|TCL_ENCODING_PROFILE_STRICT,
		&state, headerPtr->nativeCommentBuf, MAX_COMMENT_LEN - 1, NULL,
		&len, NULL);
	if (result != TCL_OK) {
	    if (interp) {
		if (result == TCL_CONVERT_UNKNOWN) {
476
477
478
479
480
481
482
483

484
485
486
487
488
489
490
487
488
489
490
491
492
493

494
495
496
497
498
499
500
501







-
+







	goto error;
    }

    if (TclDictGet(interp, dictObj, "filename", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL) {
	Tcl_EncodingState state;
	valueStr = TclGetStringFromObj(value, &length);
	valueStr = Tcl_GetStringFromObj(value, &length);
	result = Tcl_UtfToExternal(NULL, latin1enc, valueStr, length,
		TCL_ENCODING_START|TCL_ENCODING_END|TCL_ENCODING_PROFILE_STRICT,
		&state, headerPtr->nativeFilenameBuf, MAXPATHLEN - 1, NULL,
		&len, NULL);
	if (result != TCL_OK) {
	    if (interp) {
		if (result == TCL_CONVERT_UNKNOWN) {
3524
3525
3526
3527
3528
3529
3530
3531
3532


3533
3534
3535
3536
3537
3538
3539
3535
3536
3537
3538
3539
3540
3541


3542
3543
3544
3545
3546
3547
3548
3549
3550







-
-
+
+







			TclGetString(chanDataPtr->compDictObj));
	    } else {
		Tcl_DStringAppendElement(dsPtr, "");
	    }
	} else {
	    if (chanDataPtr->compDictObj) {
		Tcl_Size length;
		const char *str = TclGetStringFromObj(chanDataPtr->compDictObj,
			&length);
		const char *str = Tcl_GetStringFromObj(chanDataPtr->compDictObj,
		    &length);

		Tcl_DStringAppend(dsPtr, str, length);
	    }
	    return TCL_OK;
	}
    }

3770
3771
3772
3773
3774
3775
3776
3777

3778
3779
3780
3781
3782
3783
3784
3781
3782
3783
3784
3785
3786
3787

3788
3789
3790
3791
3792
3793
3794
3795







-
+







    if (compDictObj != NULL) {
	chanDataPtr->compDictObj = Tcl_DuplicateObj(compDictObj);
	Tcl_IncrRefCount(chanDataPtr->compDictObj);
	Tcl_GetBytesFromObj(NULL, chanDataPtr->compDictObj, (Tcl_Size *)NULL);
    }

    switch (format) {
    case  TCL_ZLIB_FORMAT_RAW:
    case TCL_ZLIB_FORMAT_RAW:
	wbits = WBITS_RAW;
	break;
    case TCL_ZLIB_FORMAT_ZLIB:
	wbits = WBITS_ZLIB;
	break;
    case TCL_ZLIB_FORMAT_GZIP:
	wbits = WBITS_GZIP;
Changes to library/auto.tcl.
1
2
3
4
5
6
7
8
9
10
11







12
13
14
15
16
17
18
1
2
3
4
5
6
7
8
9
10

11
12
13
14
15
16
17
18
19
20
21
22
23
24










-
+
+
+
+
+
+
+







# auto.tcl --
#
# utility procs formerly in init.tcl dealing with auto execution of commands
# and can be auto loaded themselves.
#
# Copyright © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1998 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# auto_reset --
#
# Destroy all cached information for auto-loading and auto-execution, so that
# the information gets recomputed the next time it's needed.  Also delete any
# commands that are listed in the auto-load index.
#
303
304
305
306
307
308
309
310

311
312
313
314
315
316
317
309
310
311
312
313
314
315

316
317
318
319
320
321
322
323







-
+







	set error [catch {
	    set f [open $file]
	    fconfigure $f -encoding utf-8 -eofchar \x1A
	    while {[gets $f line] >= 0} {
		if {[regexp {^proc[ 	]+([^ 	]*)} $line match procName]} {
		    set procName [lindex [auto_qualify $procName "::"] 0]
		    append index "set [list auto_index($procName)]"
		    append index " \[list source -encoding utf-8 \[file join \$dir [list $file]\]\]\n"
		    append index " \[list source \[file join \$dir [list $file]\]\]\n"
		}
	    }
	    close $f
	} msg opts]
	if {$error} {
	    catch {close $f}
	    cd $oldDir
590
591
592
593
594
595
596
597

598
599
600
601
602
603
604
596
597
598
599
600
601
602

603
604
605
606
607
608
609
610







-
+







    # the file name that we know about (which will be a proper list, and so
    # correctly quoted).

    set name [string range [list \}[fullname $name]] 2 end]
    set filenameParts [file split $scriptFile]

    append index [format \
	    {set auto_index(%s) [list source -encoding utf-8 [file join $dir %s]]%s} \
	    {set auto_index(%s) [list source [file join $dir %s]]%s} \
	    $name $filenameParts \n]
    return
}

if {[llength $::auto_mkindex_parser::initCommands]} {
    return
}
Added library/clockclassic.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
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
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
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
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
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
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Copyright © 2004-2007 Kevin B. Kenny
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# 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.
#
#

# We must have message catalogs that support the root locale, and we need
# access to the Registry on Windows systems.

uplevel \#0 {
    package require msgcat 1.6
    if { $::tcl_platform(platform) eq {windows} } {
	if { [catch { package require registry 1.1 }] } {
	    variable NoRegistry {}
	}
    }
}

# Put the library directory into the namespace for the ensemble so that the
# library code can find message catalogs and time zone definition files.

variable LibDir [info library]

#----------------------------------------------------------------------
#
# clock --
#
#	Manipulate times.
#
# The 'clock' command manipulates time.  Refer to the user documentation for
# the available subcommands and what they do.
#
#----------------------------------------------------------------------

# Export the subcommands

namespace export format
namespace export clicks
namespace export microseconds
namespace export milliseconds
namespace export scan
namespace export seconds
namespace export add

# Import the message catalog commands that we use.

namespace import ::msgcat::mcload
namespace import ::msgcat::mclocale
proc mc {args} { tailcall ::msgcat::mcn [namespace current] {*}$args }
namespace import ::msgcat::mcpackagelocale

#----------------------------------------------------------------------
#
# Initialize --
#
#	Finish initializing the 'clock' subsystem
#
# Results:
#	None.
#
# Side effects:
#	Namespace variable in the 'clock' subsystem are initialized.
#
# The 'Initialize' procedure initializes the namespace variables
# and root locale message catalog for the 'clock' subsystem.  It is broken
# into a procedure rather than simply evaluated as a script so that it will be
# able to use local variables, avoiding the dangers of 'creative writing' as
# in Bug 1185933.
#
#----------------------------------------------------------------------

proc Initialize {} {

    rename [namespace current]::Initialize {}

    variable LibDir

    # Define the Greenwich time zone

    proc InitTZData {} {
	variable TZData
	array unset TZData
	set TZData(:Etc/GMT) {
	    {-9223372036854775808 0 0 GMT}
	}
	set TZData(:GMT) $TZData(:Etc/GMT)
	set TZData(:Etc/UTC) {
	    {-9223372036854775808 0 0 UTC}
	}
	set TZData(:UTC) $TZData(:Etc/UTC)
	set TZData(:localtime) {}
    }
    InitTZData

    mcpackagelocale set {}
    ::msgcat::mcpackageconfig set mcfolder [file join $LibDir msgs]
    ::msgcat::mcpackageconfig set unknowncmd ""
    ::msgcat::mcpackageconfig set changecmd ChangeCurrentLocale

    # Define the message catalog for the root locale.

    ::msgcat::mcmset {} {
	AM {am}
	BCE {B.C.E.}
	CE {C.E.}
	DATE_FORMAT {%m/%d/%Y}
	DATE_TIME_FORMAT {%a %b %e %H:%M:%S %Y}
	DAYS_OF_WEEK_ABBREV	{
	    Sun Mon Tue Wed Thu Fri Sat
	}
	DAYS_OF_WEEK_FULL	{
	    Sunday Monday Tuesday Wednesday Thursday Friday Saturday
	}
	GREGORIAN_CHANGE_DATE	2299161
	LOCALE_DATE_FORMAT {%m/%d/%Y}
	LOCALE_DATE_TIME_FORMAT {%a %b %e %H:%M:%S %Y}
	LOCALE_ERAS {}
	LOCALE_NUMERALS		{
	    00 01 02 03 04 05 06 07 08 09
	    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
	}
	LOCALE_TIME_FORMAT {%H:%M:%S}
	LOCALE_YEAR_FORMAT {%EC%Ey}
	MONTHS_ABBREV		{
	    Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
	}
	MONTHS_FULL		{
	    	January		February	March
	    	April		May		June
	    	July		August		September
		October		November	December
	}
	PM {pm}
	TIME_FORMAT {%H:%M:%S}
	TIME_FORMAT_12 {%I:%M:%S %P}
	TIME_FORMAT_24 {%H:%M}
	TIME_FORMAT_24_SECS {%H:%M:%S}
    }

    # Define a few Gregorian change dates for other locales.  In most cases
    # the change date follows a language, because a nation's colonies changed
    # at the same time as the nation itself.  In many cases, different
    # national boundaries existed; the dominating rule is to follow the
    # nation's capital.

    # Italy, Spain, Portugal, Poland

    ::msgcat::mcset it GREGORIAN_CHANGE_DATE 2299161
    ::msgcat::mcset es GREGORIAN_CHANGE_DATE 2299161
    ::msgcat::mcset pt GREGORIAN_CHANGE_DATE 2299161
    ::msgcat::mcset pl GREGORIAN_CHANGE_DATE 2299161

    # France, Austria

    ::msgcat::mcset fr GREGORIAN_CHANGE_DATE 2299227

    # For Belgium, we follow Southern Netherlands; Liege Diocese changed
    # several weeks later.

    ::msgcat::mcset fr_BE GREGORIAN_CHANGE_DATE 2299238
    ::msgcat::mcset nl_BE GREGORIAN_CHANGE_DATE 2299238

    # Austria

    ::msgcat::mcset de_AT GREGORIAN_CHANGE_DATE 2299527

    # Hungary

    ::msgcat::mcset hu GREGORIAN_CHANGE_DATE 2301004

    # Germany, Norway, Denmark (Catholic Germany changed earlier)

    ::msgcat::mcset de_DE GREGORIAN_CHANGE_DATE 2342032
    ::msgcat::mcset nb GREGORIAN_CHANGE_DATE 2342032
    ::msgcat::mcset nn GREGORIAN_CHANGE_DATE 2342032
    ::msgcat::mcset no GREGORIAN_CHANGE_DATE 2342032
    ::msgcat::mcset da GREGORIAN_CHANGE_DATE 2342032

    # Holland (Brabant, Gelderland, Flanders, Friesland, etc. changed at
    # various times)

    ::msgcat::mcset nl GREGORIAN_CHANGE_DATE 2342165

    # Protestant Switzerland (Catholic cantons changed earlier)

    ::msgcat::mcset fr_CH GREGORIAN_CHANGE_DATE 2361342
    ::msgcat::mcset it_CH GREGORIAN_CHANGE_DATE 2361342
    ::msgcat::mcset de_CH GREGORIAN_CHANGE_DATE 2361342

    # English speaking countries

    ::msgcat::mcset en GREGORIAN_CHANGE_DATE 2361222

    # Sweden (had several changes onto and off of the Gregorian calendar)

    ::msgcat::mcset sv GREGORIAN_CHANGE_DATE 2361390

    # Russia

    ::msgcat::mcset ru GREGORIAN_CHANGE_DATE 2421639

    # Romania (Transylvania changed earlier - perhaps de_RO should show the
    # earlier date?)

    ::msgcat::mcset ro GREGORIAN_CHANGE_DATE 2422063

    # Greece

    ::msgcat::mcset el GREGORIAN_CHANGE_DATE 2423480

    #------------------------------------------------------------------
    #
    #				CONSTANTS
    #
    #------------------------------------------------------------------

    # Paths at which binary time zone data for the Olson libraries are known
    # to reside on various operating systems

    variable ZoneinfoPaths {}
    foreach path {
	/usr/share/zoneinfo
	/usr/share/lib/zoneinfo
	/usr/lib/zoneinfo
	/usr/local/etc/zoneinfo
    } {
	if { [file isdirectory $path] } {
	    lappend ZoneinfoPaths $path
	}
    }

    # Define the directories for time zone data and message catalogs.

    variable DataDir [file join $LibDir tzdata]

    # Number of days in the months, in common years and leap years.

    variable DaysInRomanMonthInCommonYear \
	{ 31 28 31 30 31 30 31 31 30 31 30 31 }
    variable DaysInRomanMonthInLeapYear \
	{ 31 29 31 30 31 30 31 31 30 31 30 31 }
    variable DaysInPriorMonthsInCommonYear [list 0]
    variable DaysInPriorMonthsInLeapYear [list 0]
    set i 0
    foreach j $DaysInRomanMonthInCommonYear {
	lappend DaysInPriorMonthsInCommonYear [incr i $j]
    }
    set i 0
    foreach j $DaysInRomanMonthInLeapYear {
	lappend DaysInPriorMonthsInLeapYear [incr i $j]
    }

    # Another epoch (Hi, Jeff!)

    variable Roddenberry 1946

    # Integer ranges

    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:
    # 	Bias StandardBias DaylightBias
    #   StandardDate.wYear StandardDate.wMonth StandardDate.wDayOfWeek
    #   StandardDate.wDay StandardDate.wHour StandardDate.wMinute
    #   StandardDate.wSecond StandardDate.wMilliseconds
    #   DaylightDate.wYear DaylightDate.wMonth DaylightDate.wDayOfWeek
    #   DaylightDate.wDay DaylightDate.wHour DaylightDate.wMinute
    #   DaylightDate.wSecond DaylightDate.wMilliseconds
    # The values are the names of time zones where those rules apply.  There
    # is considerable ambiguity in certain zones; an attempt has been made to
    # make a reasonable guess, but this table needs to be taken with a grain
    # of salt.

    variable WinZoneInfo [dict create {*}{
	{-43200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :Pacific/Kwajalein
	{-39600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}	 :Pacific/Midway
	{-36000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :Pacific/Honolulu
	{-32400 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Anchorage
	{-28800 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Los_Angeles
	{-28800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Tijuana
	{-25200 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Denver
	{-25200 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Chihuahua
	{-25200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :America/Phoenix
	{-21600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :America/Regina
	{-21600 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Chicago
	{-21600 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Mexico_City
	{-18000 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/New_York
	{-18000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :America/Indianapolis
	{-14400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :America/Caracas
	{-14400 0 3600 0 3 6 2 23 59 59 999 0 10 6 2 23 59 59 999}
							 :America/Santiago
	{-14400 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Manaus
	{-14400 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Halifax
	{-12600 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/St_Johns
	{-10800 0 3600 0 2 0 2 2 0 0 0 0 10 0 3 2 0 0 0} :America/Sao_Paulo
	{-10800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Godthab
	{-10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :America/Buenos_Aires
	{-10800 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Bahia
	{-10800 0 3600 0 3 0 2 2 0 0 0 0 10 0 1 2 0 0 0} :America/Montevideo
	{-7200 0 3600 0 9 0 5 2 0 0 0 0 3 0 5 2 0 0 0}   :America/Noronha
	{-3600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}  :Atlantic/Azores
	{-3600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Atlantic/Cape_Verde
	{0 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}       :UTC
	{0 0 3600 0 10 0 5 2 0 0 0 0 3 0 5 1 0 0 0}      :Europe/London
	{3600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}    :Africa/Kinshasa
	{3600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}   :CET
	{7200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}    :Africa/Harare
	{7200 0 3600 0 9 4 5 23 59 59 0 0 4 4 5 23 59 59 0}
			      				 :Africa/Cairo
	{7200 0 3600 0 10 0 5 4 0 0 0 0 3 0 5 3 0 0 0}   :Europe/Helsinki
	{7200 0 3600 0 9 0 3 2 0 0 0 0 3 5 5 2 0 0 0}    :Asia/Jerusalem
	{7200 0 3600 0 9 0 5 1 0 0 0 0 3 0 5 0 0 0 0}    :Europe/Bucharest
	{7200 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}   :Europe/Athens
	{7200 0 3600 0 9 5 5 1 0 0 0 0 3 4 5 0 0 0 0}    :Asia/Amman
	{7200 0 3600 0 10 6 5 23 59 59 999 0 3 0 5 0 0 0 0}
							 :Asia/Beirut
	{7200 0 -3600 0 4 0 1 2 0 0 0 0 9 0 1 2 0 0 0}   :Africa/Windhoek
	{10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Riyadh
	{10800 0 3600 0 10 0 1 4 0 0 0 0 4 0 1 3 0 0 0}  :Asia/Baghdad
	{10800 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}  :Europe/Moscow
	{12600 0 3600 0 9 2 4 2 0 0 0 0 3 0 1 2 0 0 0}   :Asia/Tehran
	{14400 0 3600 0 10 0 5 5 0 0 0 0 3 0 5 4 0 0 0}  :Asia/Baku
	{14400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Muscat
	{14400 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}  :Asia/Tbilisi
	{16200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Kabul
	{18000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Karachi
	{18000 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}  :Asia/Yekaterinburg
	{19800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Calcutta
	{20700 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Katmandu
	{21600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Dhaka
	{21600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}  :Asia/Novosibirsk
	{23400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Rangoon
	{25200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Bangkok
	{25200 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}  :Asia/Krasnoyarsk
	{28800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Chongqing
	{28800 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}  :Asia/Irkutsk
	{32400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Tokyo
	{32400 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}  :Asia/Yakutsk
	{34200 0 3600 0 3 0 5 3 0 0 0 0 10 0 5 2 0 0 0}  :Australia/Adelaide
	{34200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Australia/Darwin
	{36000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Australia/Brisbane
	{36000 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}  :Asia/Vladivostok
	{36000 0 3600 0 3 0 5 3 0 0 0 0 10 0 1 2 0 0 0}  :Australia/Hobart
	{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
    }]

    # Groups of fields that specify the date, priorities, and code bursts that
    # determine Julian Day Number given those groups.  The code in [clock
    # scan] will choose the highest priority (lowest numbered) set of fields
    # that determines the date.

    variable DateParseActions {

	{ seconds } 0 {}

	{ julianDay } 1 {}

	{ era century yearOfCentury month dayOfMonth } 2 {
	    dict set date year [expr { 100 * [dict get $date century]
				       + [dict get $date yearOfCentury] }]
	    set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
			  $changeover]
	}
	{ era century yearOfCentury dayOfYear } 2 {
	    dict set date year [expr { 100 * [dict get $date century]
				       + [dict get $date yearOfCentury] }]
	    set date [GetJulianDayFromEraYearDay $date[set date {}] \
			  $changeover]
	}

	{ century yearOfCentury month dayOfMonth } 3 {
	    dict set date era CE
	    dict set date year [expr { 100 * [dict get $date century]
				       + [dict get $date yearOfCentury] }]
	    set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
			  $changeover]
	}
	{ century yearOfCentury dayOfYear } 3 {
	    dict set date era CE
	    dict set date year [expr { 100 * [dict get $date century]
				       + [dict get $date yearOfCentury] }]
	    set date [GetJulianDayFromEraYearDay $date[set date {}] \
			  $changeover]
	}
	{ iso8601Century iso8601YearOfCentury iso8601Week dayOfWeek } 3 {
	    dict set date era CE
	    dict set date iso8601Year \
		[expr { 100 * [dict get $date iso8601Century]
			+ [dict get $date iso8601YearOfCentury] }]
	    set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \
			 $changeover]
	}

	{ yearOfCentury month dayOfMonth } 4 {
	    set date [InterpretTwoDigitYear $date[set date {}] $baseTime]
	    dict set date era CE
	    set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
			  $changeover]
	}
	{ yearOfCentury dayOfYear } 4 {
	    set date [InterpretTwoDigitYear $date[set date {}] $baseTime]
	    dict set date era CE
	    set date [GetJulianDayFromEraYearDay $date[set date {}] \
			  $changeover]
	}
	{ iso8601YearOfCentury iso8601Week dayOfWeek } 4 {
	    set date [InterpretTwoDigitYear \
			  $date[set date {}] $baseTime \
			  iso8601YearOfCentury iso8601Year]
	    dict set date era CE
	    set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \
			 $changeover]
	}

	{ month dayOfMonth } 5 {
	    set date [AssignBaseYear $date[set date {}] \
			  $baseTime $timeZone $changeover]
	    set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
			  $changeover]
	}
	{ dayOfYear } 5 {
	    set date [AssignBaseYear $date[set date {}] \
			  $baseTime $timeZone $changeover]
	    set date [GetJulianDayFromEraYearDay $date[set date {}] \
			 $changeover]
	}
	{ iso8601Week dayOfWeek } 5 {
	    set date [AssignBaseIso8601Year $date[set date {}] \
			  $baseTime $timeZone $changeover]
	    set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \
			 $changeover]
	}

	{ dayOfMonth } 6 {
	    set date [AssignBaseMonth $date[set date {}] \
			  $baseTime $timeZone $changeover]
	    set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
			  $changeover]
	}

	{ dayOfWeek } 7 {
	    set date [AssignBaseWeek $date[set date {}] \
			  $baseTime $timeZone $changeover]
	    set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \
			 $changeover]
	}

	{} 8 {
	    set date [AssignBaseJulianDay $date[set date {}] \
			  $baseTime $timeZone $changeover]
	}
    }

    # Groups of fields that specify time of day, priorities, and code that
    # processes them

    variable TimeParseActions {

	seconds 1 {}

	{ hourAMPM minute second amPmIndicator } 2 {
	    dict set date secondOfDay [InterpretHMSP $date]
	}
	{ hour minute second } 2 {
	    dict set date secondOfDay [InterpretHMS $date]
	}

	{ hourAMPM minute amPmIndicator } 3 {
	    dict set date second 0
	    dict set date secondOfDay [InterpretHMSP $date]
	}
	{ hour minute } 3 {
	    dict set date second 0
	    dict set date secondOfDay [InterpretHMS $date]
	}

	{ hourAMPM amPmIndicator } 4 {
	    dict set date minute 0
	    dict set date second 0
	    dict set date secondOfDay [InterpretHMSP $date]
	}
	{ hour } 4 {
	    dict set date minute 0
	    dict set date second 0
	    dict set date secondOfDay [InterpretHMS $date]
	}

	{ } 5 {
	    dict set date secondOfDay 0
	}
    }

    # Legacy time zones, used primarily for parsing RFC822 dates.

    variable LegacyTimeZone [dict create \
	gmt	+0000 \
	ut	+0000 \
	utc	+0000 \
	bst	+0100 \
	wet	+0000 \
	wat	-0100 \
	at	-0200 \
	nft	-0330 \
	nst	-0330 \
	ndt	-0230 \
	ast	-0400 \
	adt	-0300 \
	est	-0500 \
	edt	-0400 \
	cst	-0600 \
	cdt	-0500 \
	mst	-0700 \
	mdt	-0600 \
	pst	-0800 \
	pdt	-0700 \
	yst	-0900 \
	ydt	-0800 \
	akst	-0900 \
	akdt	-0800 \
	hst	-1000 \
	hdt	-0900 \
	cat	-1000 \
	ahst	-1000 \
	nt	-1100 \
	idlw	-1200 \
	cet	+0100 \
	cest	+0200 \
	met	+0100 \
	mewt	+0100 \
	mest	+0200 \
	swt	+0100 \
	sst	+0200 \
	fwt	+0100 \
	fst	+0200 \
	eet	+0200 \
	eest	+0300 \
	bt	+0300 \
	it	+0330 \
	zp4	+0400 \
	zp5	+0500 \
	ist	+0530 \
	zp6	+0600 \
	wast	+0700 \
	wadt	+0800 \
	jt	+0730 \
	cct	+0800 \
	jst	+0900 \
	kst     +0900 \
	cast	+0930 \
	jdt     +1000 \
	kdt     +1000 \
	cadt	+1030 \
	east	+1000 \
	eadt	+1030 \
	gst	+1000 \
	nzt	+1200 \
	nzst	+1200 \
	nzdt	+1300 \
	idle	+1200 \
	a	+0100 \
	b	+0200 \
	c	+0300 \
	d	+0400 \
	e	+0500 \
	f	+0600 \
	g	+0700 \
	h	+0800 \
	i	+0900 \
	k	+1000 \
	l	+1100 \
	m	+1200 \
	n	-0100 \
	o	-0200 \
	p	-0300 \
	q	-0400 \
	r	-0500 \
	s	-0600 \
	t	-0700 \
	u	-0800 \
	v	-0900 \
	w	-1000 \
	x	-1100 \
	y	-1200 \
	z	+0000 \
    ]

    # Caches

    variable LocaleNumeralCache {};	# 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 CachedSystemTimeZone;    # If 'CachedSystemTimeZone' exists,
					# it contains the value of the
					# system time zone, as determined from
					# the environment.
    variable TimeZoneBad {};	        # 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
}
Initialize

#----------------------------------------------------------------------
#
# clock format --
#
#	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.
#
#----------------------------------------------------------------------

proc format { args } {

    variable FormatProc
    variable TZData

    lassign [ParseFormatArgs {*}$args] format locale timezone
    set locale [string tolower $locale]
    set clockval [lindex $args 0]

    # Get the data for time changes in the given zone

    if {$timezone eq ""} {
	set timezone [GetSystemTimeZone]
    }
    if {![info exists TZData($timezone)]} {
	if {[catch {SetupTimeZone $timezone} retval opts]} {
	    dict unset opts -errorinfo
	    return -options $opts $retval
	}
    }

    # Build a procedure to format the result. Cache the built procedure's name
    # in the 'FormatProc' array to avoid losing its internal representation,
    # which contains the name resolution.

    set procName formatproc'$format'$locale
    set procName [namespace current]::[string map {: {\:} \\ {\\}} $procName]
    if {[info exists FormatProc($procName)]} {
	set procName $FormatProc($procName)
    } else {
	set FormatProc($procName) \
	    [ParseClockFormatFormat $procName $format $locale]
    }

    return [$procName $clockval $timezone]

}

#----------------------------------------------------------------------
#
# ParseClockFormatFormat --
#
#	Builds and caches a procedure that formats a time value.
#
# Parameters:
#	format -- Format string to use
#	locale -- Locale in which the format string is to be interpreted
#
# Results:
#	Returns the name of the newly-built procedure.
#
#----------------------------------------------------------------------

proc ParseClockFormatFormat {procName format locale} {

    if {[namespace which $procName] ne {}} {
	return $procName
    }

    # Map away the locale-dependent composite format groups

    EnterLocale $locale

    # Change locale if a fresh locale has been given on the command line.

    try {
	return [ParseClockFormatFormat2 $format $locale $procName]
    } trap CLOCK {result opts} {
	dict unset opts -errorinfo
	return -options $opts $result
    }
}

proc ParseClockFormatFormat2 {format locale procName} {
    set didLocaleEra 0
    set didLocaleNumerals 0
    set preFormatCode \
	[string map [list @GREGORIAN_CHANGE_DATE@ \
				       [mc GREGORIAN_CHANGE_DATE]] \
	     {
		 variable TZData
		 set date [GetDateFields $clockval \
			       $TZData($timezone) \
			       @GREGORIAN_CHANGE_DATE@]
	     }]
    set formatString {}
    set substituents {}
    set state {}

    set format [LocalizeFormat $locale $format]

    foreach char [split $format {}] {
	switch -exact -- $state {
	    {} {
		if { [string equal % $char] } {
		    set state percent
		} else {
		    append formatString $char
		}
	    }
	    percent {			# Character following a '%' character
		set state {}
		switch -exact -- $char {
		    % {			# A literal character, '%'
			append formatString %%
		    }
		    a {			# Day of week, abbreviated
			append formatString %s
			append substituents \
			    [string map \
				 [list @DAYS_OF_WEEK_ABBREV@ \
				      [list [mc DAYS_OF_WEEK_ABBREV]]] \
				 { [lindex @DAYS_OF_WEEK_ABBREV@ \
					[expr {[dict get $date dayOfWeek] \
						   % 7}]]}]
		    }
		    A {			# Day of week, spelt out.
			append formatString %s
			append substituents \
			    [string map \
				 [list @DAYS_OF_WEEK_FULL@ \
				      [list [mc DAYS_OF_WEEK_FULL]]] \
				 { [lindex @DAYS_OF_WEEK_FULL@ \
					[expr {[dict get $date dayOfWeek] \
						   % 7}]]}]
		    }
		    b - h {		# Name of month, abbreviated.
			append formatString %s
			append substituents \
			    [string map \
				 [list @MONTHS_ABBREV@ \
				      [list [mc MONTHS_ABBREV]]] \
				 { [lindex @MONTHS_ABBREV@ \
					[expr {[dict get $date month]-1}]]}]
		    }
		    B {			# Name of month, spelt out
			append formatString %s
			append substituents \
			    [string map \
				 [list @MONTHS_FULL@ \
				      [list [mc MONTHS_FULL]]] \
				 { [lindex @MONTHS_FULL@ \
					[expr {[dict get $date month]-1}]]}]
		    }
		    C {			# Century number
			append formatString %02d
			append substituents \
			    { [expr {[dict get $date year] / 100}]}
		    }
		    d {			# Day of month, with leading zero
			append formatString %02d
			append substituents { [dict get $date dayOfMonth]}
		    }
		    e {			# Day of month, without leading zero
			append formatString %2d
			append substituents { [dict get $date dayOfMonth]}
		    }
		    E {			# Format group in a locale-dependent
					# alternative era
			set state percentE
			if {!$didLocaleEra} {
			    append preFormatCode \
				[string map \
				     [list @LOCALE_ERAS@ \
					  [list [mc LOCALE_ERAS]]] \
				     {
					 set date [GetLocaleEra \
						       $date[set date {}] \
						       @LOCALE_ERAS@]}] \n
			    set didLocaleEra 1
			}
			if {!$didLocaleNumerals} {
			    append preFormatCode \
				[list set localeNumerals \
				     [mc LOCALE_NUMERALS]] \n
			    set didLocaleNumerals 1
			}
		    }
		    g {			# Two-digit year relative to ISO8601
					# week number
			append formatString %02d
			append substituents \
			    { [expr { [dict get $date iso8601Year] % 100 }]}
		    }
		    G {			# Four-digit year relative to ISO8601
					# week number
			append formatString %02d
			append substituents { [dict get $date iso8601Year]}
		    }
		    H {			# Hour in the 24-hour day, leading zero
			append formatString %02d
			append substituents \
			    { [expr { [dict get $date localSeconds] \
					  / 3600 % 24}]}
		    }
		    I {			# Hour AM/PM, with leading zero
			append formatString %02d
			append substituents \
			    { [expr { ( ( ( [dict get $date localSeconds] \
					    % 86400 ) \
					  + 86400 \
					  - 3600 ) \
					/ 3600 ) \
				      % 12 + 1 }] }
		    }
		    j {			# Day of year (001-366)
			append formatString %03d
			append substituents { [dict get $date dayOfYear]}
		    }
		    J {			# Julian Day Number
			append formatString %07ld
			append substituents { [dict get $date julianDay]}
		    }
		    k {			# Hour (0-23), no leading zero
			append formatString %2d
			append substituents \
			    { [expr { [dict get $date localSeconds]
				      / 3600
				      % 24 }]}
		    }
		    l {			# Hour (12-11), no leading zero
			append formatString %2d
			append substituents \
			    { [expr { ( ( ( [dict get $date localSeconds]
					   % 86400 )
					 + 86400
					 - 3600 )
				       / 3600 )
				     % 12 + 1 }]}
		    }
		    m {			# Month number, leading zero
			append formatString %02d
			append substituents { [dict get $date month]}
		    }
		    M {			# Minute of the hour, leading zero
			append formatString %02d
			append substituents \
			    { [expr { [dict get $date localSeconds]
				      / 60
				      % 60 }]}
		    }
		    n {			# A literal newline
			append formatString \n
		    }
		    N {			# Month number, no leading zero
			append formatString %2d
			append substituents { [dict get $date month]}
		    }
		    O {			# A format group in the locale's
					# alternative numerals
			set state percentO
			if {!$didLocaleNumerals} {
			    append preFormatCode \
				[list set localeNumerals \
				     [mc LOCALE_NUMERALS]] \n
			    set didLocaleNumerals 1
			}
		    }
		    p {			# Localized 'AM' or 'PM' indicator
					# converted to uppercase
			append formatString %s
			append preFormatCode \
			    [list set AM [string toupper [mc AM]]] \n \
			    [list set PM [string toupper [mc PM]]] \n
			append substituents \
			    { [expr {(([dict get $date localSeconds]
				       % 86400) < 43200) ?
				     $AM : $PM}]}
		    }
		    P {			# Localized 'AM' or 'PM' indicator
			append formatString %s
			append preFormatCode \
			    [list set am [mc AM]] \n \
			    [list set pm [mc PM]] \n
			append substituents \
			    { [expr {(([dict get $date localSeconds]
				       % 86400) < 43200) ?
				     $am : $pm}]}

		    }
		    Q {			# Hi, Jeff!
			append formatString %s
			append substituents { [FormatStarDate $date]}
		    }
		    s {			# Seconds from the Posix Epoch
			append formatString %s
			append substituents { [dict get $date seconds]}
		    }
		    S {			# Second of the minute, with
			# leading zero
			append formatString %02d
			append substituents \
			    { [expr { [dict get $date localSeconds]
				      % 60 }]}
		    }
		    t {			# A literal tab character
			append formatString \t
		    }
		    u {			# Day of the week (1-Monday, 7-Sunday)
			append formatString %1d
			append substituents { [dict get $date dayOfWeek]}
		    }
		    U {			# Week of the year (00-53). The
					# first Sunday of the year is the
					# first day of week 01
			append formatString %02d
			append preFormatCode {
			    set dow [dict get $date dayOfWeek]
			    if { $dow == 7 } {
				set dow 0
			    }
			    incr dow
			    set UweekNumber \
				[expr { ( [dict get $date dayOfYear]
					  - $dow + 7 )
					/ 7 }]
			}
			append substituents { $UweekNumber}
		    }
		    V {			# The ISO8601 week number
			append formatString %02d
			append substituents { [dict get $date iso8601Week]}
		    }
		    w {			# Day of the week (0-Sunday,
					# 6-Saturday)
			append formatString %1d
			append substituents \
			    { [expr { [dict get $date dayOfWeek] % 7 }]}
		    }
		    W {			# Week of the year (00-53). The first
					# Monday of the year is the first day
					# of week 01.
			append preFormatCode {
			    set WweekNumber \
				[expr { ( [dict get $date dayOfYear]
					  - [dict get $date dayOfWeek]
					  + 7 )
					/ 7 }]
			}
			append formatString %02d
			append substituents { $WweekNumber}
		    }
		    y {			# The two-digit year of the century
			append formatString %02d
			append substituents \
			    { [expr { [dict get $date year] % 100 }]}
		    }
		    Y {			# The four-digit year
			append formatString %04d
			append substituents { [dict get $date year]}
		    }
		    z {			# The time zone as hours and minutes
					# east (+) or west (-) of Greenwich
			append formatString %s
			append substituents { [FormatNumericTimeZone \
						   [dict get $date tzOffset]]}
		    }
		    Z {			# The name of the time zone
			append formatString %s
			append substituents { [dict get $date tzName]}
		    }
		    % {			# A literal percent character
			append formatString %%
		    }
		    default {		# An unknown escape sequence
			append formatString %% $char
		    }
		}
	    }
	    percentE {			# Character following %E
		set state {}
		switch -exact -- $char {
		    E {
			append formatString %s
			append substituents { } \
			    [string map \
				 [list @BCE@ [list [mc BCE]] \
				      @CE@ [list [mc CE]]] \
				      {[dict get {BCE @BCE@ CE @CE@} \
					    [dict get $date era]]}]
		    }
		    C {			# Locale-dependent era
			append formatString %s
			append substituents { [dict get $date localeEra]}
		    }
		    y {			# Locale-dependent year of the era
			append preFormatCode {
			    set y [dict get $date localeYear]
			    if { $y >= 0 && $y < 100 } {
				set Eyear [lindex $localeNumerals $y]
			    } else {
				set Eyear $y
			    }
			}
			append formatString %s
			append substituents { $Eyear}
		    }
		    default {		# Unknown %E format group
			append formatString %%E $char
		    }
		}
	    }
	    percentO {			# Character following %O
		set state {}
		switch -exact -- $char {
		    d - e {		# Day of the month in alternative
			# numerals
			append formatString %s
			append substituents \
			    { [lindex $localeNumerals \
				   [dict get $date dayOfMonth]]}
		    }
		    H - k {		# Hour of the day in alternative
					# numerals
			append formatString %s
			append substituents \
			    { [lindex $localeNumerals \
				   [expr { [dict get $date localSeconds]
					   / 3600
					   % 24 }]]}
		    }
		    I - l {		# Hour (12-11) AM/PM in alternative
					# numerals
			append formatString %s
			append substituents \
			    { [lindex $localeNumerals \
				   [expr { ( ( ( [dict get $date localSeconds]
						 % 86400 )
					       + 86400
					       - 3600 )
					     / 3600 )
					   % 12 + 1 }]]}
		    }
		    m {			# Month number in alternative numerals
			append formatString %s
			append substituents \
			    { [lindex $localeNumerals [dict get $date month]]}
		    }
		    M {			# Minute of the hour in alternative
					# numerals
			append formatString %s
			append substituents \
			    { [lindex $localeNumerals \
				   [expr { [dict get $date localSeconds]
					   / 60
					   % 60 }]]}
		    }
		    S {			# Second of the minute in alternative
					# numerals
			append formatString %s
			append substituents \
			    { [lindex $localeNumerals \
				   [expr { [dict get $date localSeconds]
					   % 60 }]]}
		    }
		    u {			# Day of the week (Monday=1,Sunday=7)
					# in alternative numerals
			append formatString %s
			append substituents \
			    { [lindex $localeNumerals \
				   [dict get $date dayOfWeek]]}
			}
		    w {			# Day of the week (Sunday=0,Saturday=6)
					# in alternative numerals
			append formatString %s
			append substituents \
			    { [lindex $localeNumerals \
				   [expr { [dict get $date dayOfWeek] % 7 }]]}
		    }
		    y {			# Year of the century in alternative
					# numerals
			append formatString %s
			append substituents \
			    { [lindex $localeNumerals \
				   [expr { [dict get $date year] % 100 }]]}
		    }
		    default {	# Unknown format group
			append formatString %%O $char
		    }
		}
	    }
	}
    }

    # Clean up any improperly terminated groups

    switch -exact -- $state {
	percent {
	    append formatString %%
	}
	percentE {
	    append retval %%E
	}
	percentO {
	    append retval %%O
	}
    }

    proc $procName {clockval timezone} "
	$preFormatCode
	return \[::format [list $formatString] $substituents\]
    "

    #    puts [list $procName [info args $procName] [info body $procName]]

    return $procName
}

#----------------------------------------------------------------------
#
# clock scan --
#
#	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.
#
#----------------------------------------------------------------------

proc scan { args } {

    set format {}

    # Check the count of args

    if { [llength $args] < 1 || [llength $args] % 2 != 1 } {
	set cmdName "clock scan"
	return -code error \
	    -errorcode [list CLOCK wrongNumArgs] \
	    "wrong \# args: should be\
	     \"$cmdName string\
	     ?-base seconds?\
	     ?-format string? ?-gmt boolean?\
	     ?-locale LOCALE? ?-timezone ZONE?\""
    }

    # Set defaults

    set base [clock seconds]
    set string [lindex $args 0]
    set format {}
    set gmt 0
    set locale c
    set timezone [GetSystemTimeZone]

    # Pick up command line options.

    foreach { flag value } [lreplace $args 0 0] {
	switch -exact -- $flag {
	    -b - -ba - -bas - -base {
		set base $value
	    }
	    -f - -fo - -for - -form - -forma - -format {
		set saw(-format) {}
		set format $value
	    }
	    -g - -gm - -gmt {
		set saw(-gmt) {}
		set gmt $value
	    }
	    -l - -lo - -loc - -loca - -local - -locale {
		set saw(-locale) {}
		set locale [string tolower $value]
	    }
	    -t - -ti - -tim - -time - -timez - -timezo - -timezon - -timezone {
		set saw(-timezone) {}
		set timezone $value
	    }
	    default {
		return -code error \
		    -errorcode [list CLOCK badOption $flag] \
		    "bad option \"$flag\":\
		     must be -base, -format, -gmt, -locale, or -timezone"
	    }
	}
    }

    # Check options for validity

    if { [info exists saw(-gmt)] && [info exists saw(-timezone)] } {
	return -code error \
	    -errorcode [list CLOCK gmtWithTimezone] \
	    "cannot use -gmt and -timezone in same call"
    }
    if { [catch { expr { wide($base) } } result] } {
	return -code error "expected integer but got \"$base\""
    }
    if { ![string is boolean -strict $gmt] } {
	return -code error "expected boolean value but got \"$gmt\""
    } elseif { $gmt } {
	set timezone :GMT
    }

    if { ![info exists saw(-format)] } {
	# Perhaps someday we'll localize the legacy code. Right now, it's not
	# localized.
	if { [info exists saw(-locale)] } {
	    return -code error \
		-errorcode [list CLOCK flagWithLegacyFormat] \
		"legacy \[clock scan\] does not support -locale"

	}
	return [FreeScan $string $base $timezone $locale]
    }

    # Change locale if a fresh locale has been given on the command line.

    EnterLocale $locale

    try {
	# Map away the locale-dependent composite format groups

	set scanner [ParseClockScanFormat $format $locale]
	return [$scanner $string $base $timezone]
    } trap CLOCK {result opts} {
	# Conceal location of generation of expected errors
	dict unset opts -errorinfo
	return -options $opts $result
    }
}

#----------------------------------------------------------------------
#
# FreeScan --
#
#	Scans a time in free format
#
# Parameters:
#	string - String containing the time to scan
#	base - Base time, expressed in seconds from the Epoch
#	timezone - Default time zone in which the time will be expressed
#	locale - (Unused) Name of the locale where the time will be scanned.
#
# Results:
#	Returns the date and time extracted from the string in seconds from
#	the epoch
#
#----------------------------------------------------------------------

proc FreeScan { string base timezone locale } {

    variable TZData

    # Get the data for time changes in the given zone

    try {
	SetupTimeZone $timezone
    } on error {retval opts} {
	dict unset opts -errorinfo
	return -options $opts $retval
    }

    # Extract year, month and day from the base time for the parser to use as
    # defaults

    set date [GetDateFields $base $TZData($timezone) 2361222]
    dict set date secondOfDay [expr {
	[dict get $date localSeconds] % 86400
    }]

    # Parse the date.  The parser will return a list comprising date, time,
    # time zone, relative month/day/seconds, relative weekday, ordinal month.

    try {
	set scanned [Oldscan $string \
		     [dict get $date year] \
		     [dict get $date month] \
		     [dict get $date dayOfMonth]]
	lassign $scanned \
	    parseDate parseTime parseZone parseRel \
	    parseWeekday parseOrdinalMonth
    } on error message {
	return -code error \
	    "unable to convert date-time string \"$string\": $message"
    }

    # If the caller supplied a date in the string, update the 'date' dict with
    # the value. If the caller didn't specify a time with the date, default to
    # midnight.

    if { [llength $parseDate] > 0 } {
	lassign $parseDate y m d
	if { $y < 100 } {
	    if { $y >= 39 } {
		incr y 1900
	    } else {
		incr y 2000
	    }
	}
	dict set date era CE
	dict set date year $y
	dict set date month $m
	dict set date dayOfMonth $d
	if { $parseTime eq {} } {
	    set parseTime 0
	}
    }

    # If the caller supplied a time zone in the string, it comes back as a
    # two-element list; the first element is the number of minutes east of
    # Greenwich, and the second is a Daylight Saving Time indicator (1 == yes,
    # 0 == no, -1 == unknown). We make it into a time zone indicator of
    # +-hhmm.

    if { [llength $parseZone] > 0 } {
	lassign $parseZone minEast dstFlag
	set timezone [FormatNumericTimeZone \
			  [expr { 60 * $minEast + 3600 * $dstFlag }]]
	SetupTimeZone $timezone
    }
    dict set date tzName $timezone

    # Assemble date, time, zone into seconds-from-epoch

    set date [GetJulianDayFromEraYearMonthDay $date[set date {}] 2361222]
    if { $parseTime ne {} } {
	dict set date secondOfDay $parseTime
    } elseif { [llength $parseWeekday] != 0
	       || [llength $parseOrdinalMonth] != 0
	       || ( [llength $parseRel] != 0
		    && ( [lindex $parseRel 0] != 0
			 || [lindex $parseRel 1] != 0 ) ) } {
	dict set date secondOfDay 0
    }

    dict set date localSeconds [expr {
	-210866803200
	+ ( 86400 * wide([dict get $date julianDay]) )
	+ [dict get $date secondOfDay]
    }]
    dict set date tzName $timezone
    set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) 2361222]
    set seconds [dict get $date seconds]

    # Do relative times

    if { [llength $parseRel] > 0 } {
	lassign $parseRel relMonth relDay relSecond
	set seconds [add $seconds \
			 $relMonth months $relDay days $relSecond seconds \
			 -timezone $timezone -locale $locale]
    }

    # Do relative weekday

    if { [llength $parseWeekday] > 0 } {
	lassign $parseWeekday dayOrdinal dayOfWeek
	set date2 [GetDateFields $seconds $TZData($timezone) 2361222]
	dict set date2 era CE
	set jdwkday [WeekdayOnOrBefore $dayOfWeek [expr {
	    [dict get $date2 julianDay] + 6
	}]]
	incr jdwkday [expr { 7 * $dayOrdinal }]
	if { $dayOrdinal > 0 } {
	    incr jdwkday -7
	}
	dict set date2 secondOfDay \
	    [expr { [dict get $date2 localSeconds] % 86400 }]
	dict set date2 julianDay $jdwkday
	dict set date2 localSeconds [expr {
	    -210866803200
	    + ( 86400 * wide([dict get $date2 julianDay]) )
	    + [dict get $date secondOfDay]
	}]
	dict set date2 tzName $timezone
	set date2 [ConvertLocalToUTC $date2[set date2 {}] $TZData($timezone) \
		       2361222]
	set seconds [dict get $date2 seconds]

    }

    # Do relative month

    if { [llength $parseOrdinalMonth] > 0 } {
	lassign $parseOrdinalMonth monthOrdinal monthNumber
	if { $monthOrdinal > 0 } {
	    set monthDiff [expr { $monthNumber - [dict get $date month] }]
	    if { $monthDiff <= 0 } {
		incr monthDiff 12
	    }
	    incr monthOrdinal -1
	} else {
	    set monthDiff [expr { [dict get $date month] - $monthNumber }]
	    if { $monthDiff >= 0 } {
		incr monthDiff -12
	    }
	    incr monthOrdinal
	}
	set seconds [add $seconds $monthOrdinal years $monthDiff months \
			 -timezone $timezone -locale $locale]
    }

    return $seconds
}


#----------------------------------------------------------------------
#
# ParseClockScanFormat --
#
#	Parses a format string given to [clock scan -format]
#
# Parameters:
#	formatString - The format being parsed
#	locale - The current locale
#
# Results:
#	Constructs and returns a procedure that accepts the string being
#	scanned, the base time, and the time zone.  The procedure will either
#	return the scanned time or else throw an error that should be rethrown
#	to the caller of [clock scan]
#
# Side effects:
#	The given procedure is defined in the current namespace.  Scan
#	procedures are not deleted once installed.
#
# Why do we parse dates by defining a procedure to parse them?  The reason is
# that by doing so, we have one convenient place to cache all the information:
# the regular expressions that match the patterns (which will be compiled),
# the code that assembles the date information, everything lands in one place.
# In this way, when a given format is reused at run time, all the information
# of how to apply it is available in a single place.
#
#----------------------------------------------------------------------

proc ParseClockScanFormat {formatString locale} {
    # Check whether the format has been parsed previously, and return the
    # existing recognizer if it has.

    set procName scanproc'$formatString'$locale
    set procName [namespace current]::[string map {: {\:} \\ {\\}} $procName]
    if { [namespace which $procName] != {} } {
	return $procName
    }

    variable DateParseActions
    variable TimeParseActions

    # Localize the %x, %X, etc. groups

    set formatString [LocalizeFormat $locale $formatString]

    # Condense whitespace

    regsub -all {[[:space:]]+} $formatString { } formatString

    # Walk through the groups of the format string.  In this loop, we
    # accumulate:
    #	- a regular expression that matches the string,
    #   - the count of capturing brackets in the regexp
    #   - a set of code that post-processes the fields captured by the regexp,
    #   - a dictionary whose keys are the names of fields that are present
    #     in the format string.

    set re {^[[:space:]]*}
    set captureCount 0
    set postcode {}
    set fieldSet [dict create]
    set fieldCount 0
    set postSep {}
    set state {}

    foreach c [split $formatString {}] {
	switch -exact -- $state {
	    {} {
		if { $c eq "%" } {
		    set state %
		} elseif { $c eq " " } {
		    append re {[[:space:]]+}
		} else {
		    if { ! [string is alnum $c] } {
			append re "\\"
		    }
		    append re $c
		}
	    }
	    % {
		set state {}
		switch -exact -- $c {
		    % {
			append re %
		    }
		    { } {
			append re "\[\[:space:\]\]*"
		    }
		    a - A { 		# Day of week, in words
			set l {}
			foreach \
			    i {7 1 2 3 4 5 6} \
			    abr [mc DAYS_OF_WEEK_ABBREV] \
			    full [mc DAYS_OF_WEEK_FULL] {
				dict set l [string tolower $abr] $i
				dict set l [string tolower $full] $i
				incr i
			    }
			lassign [UniquePrefixRegexp $l] regex lookup
			append re ( $regex )
			dict set fieldSet dayOfWeek [incr fieldCount]
			append postcode "dict set date dayOfWeek \[" \
			    "dict get " [list $lookup] " " \
			    \[ {string tolower $field} [incr captureCount] \] \
			    "\]\n"
		    }
		    b - B - h {		# Name of month
			set i 0
			set l {}
			foreach \
			    abr [mc MONTHS_ABBREV] \
			    full [mc MONTHS_FULL] {
				incr i
				dict set l [string tolower $abr] $i
				dict set l [string tolower $full] $i
			    }
			lassign [UniquePrefixRegexp $l] regex lookup
			append re ( $regex )
			dict set fieldSet month [incr fieldCount]
			append postcode "dict set date month \[" \
			    "dict get " [list $lookup] \
			    " " \[ {string tolower $field} \
			    [incr captureCount] \] \
			    "\]\n"
		    }
		    C {			# Gregorian century
			append re \\s*(\\d\\d?)
			dict set fieldSet century [incr fieldCount]
			append postcode "dict set date century \[" \
			    "::scan \$field" [incr captureCount] " %d" \
			    "\]\n"
		    }
		    d - e {		# Day of month
			append re \\s*(\\d\\d?)
			dict set fieldSet dayOfMonth [incr fieldCount]
			append postcode "dict set date dayOfMonth \[" \
			    "::scan \$field" [incr captureCount] " %d" \
			    "\]\n"
		    }
		    E {			# Prefix for locale-specific codes
			set state %E
		    }
		    g {			# ISO8601 2-digit year
			append re \\s*(\\d\\d)
			dict set fieldSet iso8601YearOfCentury \
			    [incr fieldCount]
			append postcode \
			    "dict set date iso8601YearOfCentury \[" \
			    "::scan \$field" [incr captureCount] " %d" \
			    "\]\n"
		    }
		    G {			# ISO8601 4-digit year
			append re \\s*(\\d\\d)(\\d\\d)
			dict set fieldSet iso8601Century [incr fieldCount]
			dict set fieldSet iso8601YearOfCentury \
			    [incr fieldCount]
			append postcode \
			    "dict set date iso8601Century \[" \
			    "::scan \$field" [incr captureCount] " %d" \
			    "\]\n" \
			    "dict set date iso8601YearOfCentury \[" \
			    "::scan \$field" [incr captureCount] " %d" \
			    "\]\n"
		    }
		    H - k {		# Hour of day
			append re \\s*(\\d\\d?)
			dict set fieldSet hour [incr fieldCount]
			append postcode "dict set date hour \[" \
			    "::scan \$field" [incr captureCount] " %d" \
			    "\]\n"
		    }
		    I - l {		# Hour, AM/PM
			append re \\s*(\\d\\d?)
			dict set fieldSet hourAMPM [incr fieldCount]
			append postcode "dict set date hourAMPM \[" \
			    "::scan \$field" [incr captureCount] " %d" \
			    "\]\n"
		    }
		    j {			# Day of year
			append re \\s*(\\d\\d?\\d?)
			dict set fieldSet dayOfYear [incr fieldCount]
			append postcode "dict set date dayOfYear \[" \
			    "::scan \$field" [incr captureCount] " %d" \
			    "\]\n"
		    }
		    J {			# Julian Day Number
			append re \\s*(\\d+)
			dict set fieldSet julianDay [incr fieldCount]
			append postcode "dict set date julianDay \[" \
			    "::scan \$field" [incr captureCount] " %ld" \
			    "\]\n"
		    }
		    m - N {		# Month number
			append re \\s*(\\d\\d?)
			dict set fieldSet month [incr fieldCount]
			append postcode "dict set date month \[" \
			    "::scan \$field" [incr captureCount] " %d" \
			    "\]\n"
		    }
		    M {			# Minute
			append re \\s*(\\d\\d?)
			dict set fieldSet minute [incr fieldCount]
			append postcode "dict set date minute \[" \
			    "::scan \$field" [incr captureCount] " %d" \
			    "\]\n"
		    }
		    n {			# Literal newline
			append re \\n
		    }
		    O {			# Prefix for locale numerics
			set state %O
		    }
		    p - P { 		# AM/PM indicator
			set l [list [string tolower [mc AM]] 0 \
				   [string tolower [mc PM]] 1]
			lassign [UniquePrefixRegexp $l] regex lookup
			append re ( $regex )
			dict set fieldSet amPmIndicator [incr fieldCount]
			append postcode "dict set date amPmIndicator \[" \
			    "dict get " [list $lookup] " \[string tolower " \
			    "\$field" \
			    [incr captureCount] \
			    "\]\]\n"
		    }
		    Q {			# Hi, Jeff!
			append re {Stardate\s+([-+]?\d+)(\d\d\d)[.](\d)}
			incr captureCount
			dict set fieldSet seconds [incr fieldCount]
			append postcode {dict set date seconds } \[ \
			    {ParseStarDate $field} [incr captureCount] \
			    { $field} [incr captureCount] \
			    { $field} [incr captureCount] \
			    \] \n
		    }
		    s {			# Seconds from Posix Epoch
			# This next case is insanely difficult, because it's
			# problematic to determine whether the field is
			# actually within the range of a wide integer.
			append re {\s*([-+]?\d+)}
			dict set fieldSet seconds [incr fieldCount]
			append postcode {dict set date seconds } \[ \
			    {ScanWide $field} [incr captureCount] \] \n
		    }
		    S {			# Second
			append re \\s*(\\d\\d?)
			dict set fieldSet second [incr fieldCount]
			append postcode "dict set date second \[" \
			    "::scan \$field" [incr captureCount] " %d" \
			    "\]\n"
		    }
		    t {			# Literal tab character
			append re \\t
		    }
		    u - w {		# Day number within week, 0 or 7 == Sun
					# 1=Mon, 6=Sat
			append re \\s*(\\d)
			dict set fieldSet dayOfWeek [incr fieldCount]
			append postcode {::scan $field} [incr captureCount] \
			    { %d dow} \n \
			    {
				if { $dow == 0 } {
				    set dow 7
				} elseif { $dow > 7 } {
				    return -code error \
					-errorcode [list CLOCK badDayOfWeek] \
					"day of week is greater than 7"
				}
				dict set date dayOfWeek $dow
			    }
		    }
		    U {			# Week of year. The first Sunday of
					# the year is the first day of week
					# 01. No scan rule uses this group.
			append re \\s*\\d\\d?
		    }
		    V {			# Week of ISO8601 year

			append re \\s*(\\d\\d?)
			dict set fieldSet iso8601Week [incr fieldCount]
			append postcode "dict set date iso8601Week \[" \
			    "::scan \$field" [incr captureCount] " %d" \
			    "\]\n"
		    }
		    W {			# Week of the year (00-53). The first
					# Monday of the year is the first day
					# of week 01. No scan rule uses this
					# group.
			append re \\s*\\d\\d?
		    }
		    y {			# Two-digit Gregorian year
			append re \\s*(\\d\\d?)
			dict set fieldSet yearOfCentury [incr fieldCount]
			append postcode "dict set date yearOfCentury \[" \
			    "::scan \$field" [incr captureCount] " %d" \
			    "\]\n"
		    }
		    Y {			# 4-digit Gregorian year
			append re \\s*(\\d\\d)(\\d\\d)
			dict set fieldSet century [incr fieldCount]
			dict set fieldSet yearOfCentury [incr fieldCount]
			append postcode \
			    "dict set date century \[" \
			    "::scan \$field" [incr captureCount] " %d" \
			    "\]\n" \
			    "dict set date yearOfCentury \[" \
			    "::scan \$field" [incr captureCount] " %d" \
			    "\]\n"
		    }
		    z - Z {			# Time zone name
			append re {(?:([-+]\d\d(?::?\d\d(?::?\d\d)?)?)|([[:alnum:]]{1,4}))}
			dict set fieldSet tzName [incr fieldCount]
			append postcode \
			    {if } \{ { $field} [incr captureCount] \
			    { ne "" } \} { } \{ \n \
			    {dict set date tzName $field} \
			    $captureCount \n \
			    \} { else } \{ \n \
			    {dict set date tzName } \[ \
			    {ConvertLegacyTimeZone $field} \
			    [incr captureCount] \] \n \
			    \} \n \
		    }
		    % {			# Literal percent character
			append re %
		    }
		    default {
			append re %
			if { ! [string is alnum $c] } {
			    append re \\
			    }
			append re $c
		    }
		}
	    }
	    %E {
		switch -exact -- $c {
		    C {			# Locale-dependent era
			set d {}
			foreach triple [mc LOCALE_ERAS] {
			    lassign $triple t symbol year
			    dict set d [string tolower $symbol] $year
			}
			lassign [UniquePrefixRegexp $d] regex lookup
			append re (?: $regex )
		    }
		    E {
			set l {}
			dict set l [string tolower [mc BCE]] BCE
			dict set l [string tolower [mc CE]] CE
			dict set l b.c.e. BCE
			dict set l c.e. CE
			dict set l b.c. BCE
			dict set l a.d. CE
			lassign [UniquePrefixRegexp $l] regex lookup
			append re ( $regex )
			dict set fieldSet era [incr fieldCount]
			append postcode "dict set date era \["\
			    "dict get " [list $lookup] \
			    { } \[ {string tolower $field} \
			    [incr captureCount] \] \
			    "\]\n"
		    }
		    y {			# Locale-dependent year of the era
			lassign [LocaleNumeralMatcher $locale] regex lookup
			append re $regex
			incr captureCount
		    }
		    default {
			append re %E
			if { ! [string is alnum $c] } {
			    append re \\
			    }
			append re $c
		    }
		}
		set state {}
	    }
	    %O {
		switch -exact -- $c {
		    d - e {
			lassign [LocaleNumeralMatcher $locale] regex lookup
			append re $regex
			dict set fieldSet dayOfMonth [incr fieldCount]
			append postcode "dict set date dayOfMonth \[" \
			    "dict get " [list $lookup] " \$field" \
			    [incr captureCount] \
			    "\]\n"
		    }
		    H - k {
			lassign [LocaleNumeralMatcher $locale] regex lookup
			append re $regex
			dict set fieldSet hour [incr fieldCount]
			append postcode "dict set date hour \[" \
			    "dict get " [list $lookup] " \$field" \
			    [incr captureCount] \
			    "\]\n"
		    }
		    I - l {
			lassign [LocaleNumeralMatcher $locale] regex lookup
			append re $regex
			dict set fieldSet hourAMPM [incr fieldCount]
			append postcode "dict set date hourAMPM \[" \
			    "dict get " [list $lookup] " \$field" \
			    [incr captureCount] \
			    "\]\n"
		    }
		    m {
			lassign [LocaleNumeralMatcher $locale] regex lookup
			append re $regex
			dict set fieldSet month [incr fieldCount]
			append postcode "dict set date month \[" \
			    "dict get " [list $lookup] " \$field" \
			    [incr captureCount] \
			    "\]\n"
		    }
		    M {
			lassign [LocaleNumeralMatcher $locale] regex lookup
			append re $regex
			dict set fieldSet minute [incr fieldCount]
			append postcode "dict set date minute \[" \
			    "dict get " [list $lookup] " \$field" \
			    [incr captureCount] \
			    "\]\n"
		    }
		    S {
			lassign [LocaleNumeralMatcher $locale] regex lookup
			append re $regex
			dict set fieldSet second [incr fieldCount]
			append postcode "dict set date second \[" \
			    "dict get " [list $lookup] " \$field" \
			    [incr captureCount] \
			    "\]\n"
		    }
		    u - w {
			lassign [LocaleNumeralMatcher $locale] regex lookup
			append re $regex
			dict set fieldSet dayOfWeek [incr fieldCount]
			append postcode "set dow \[dict get " [list $lookup] \
			    { $field} [incr captureCount] \] \n \
			    {
				if { $dow == 0 } {
				    set dow 7
				} elseif { $dow > 7 } {
				    return -code error \
					-errorcode [list CLOCK badDayOfWeek] \
					"day of week is greater than 7"
				}
				dict set date dayOfWeek $dow
			    }
		    }
		    y {
			lassign [LocaleNumeralMatcher $locale] regex lookup
			append re $regex
			dict set fieldSet yearOfCentury [incr fieldCount]
			append postcode {dict set date yearOfCentury } \[ \
			    {dict get } [list $lookup] { $field} \
			    [incr captureCount] \] \n
		    }
		    default {
			append re %O
			if { ! [string is alnum $c] } {
			    append re \\
			    }
			append re $c
		    }
		}
		set state {}
	    }
	}
    }

    # Clean up any unfinished format groups

    append re $state \\s*\$

    # Build the procedure

    set procBody {}
    append procBody "variable TZData" \n
    append procBody "if \{ !\[ regexp -nocase [list $re] \$string ->"
    for { set i 1 } { $i <= $captureCount } { incr i } {
	append procBody " " field $i
    }
    append procBody "\] \} \{" \n
    append procBody {
	return -code error -errorcode [list CLOCK badInputString] \
	    {input string does not match supplied format}
    }
    append procBody \}\n
    append procBody "set date \[dict create\]" \n
    append procBody {dict set date tzName $timeZone} \n
    append procBody $postcode
    append procBody [list set changeover [mc GREGORIAN_CHANGE_DATE]] \n

    # Set up the time zone before doing anything with a default base date
    # that might need a timezone to interpret it.

    if { ![dict exists $fieldSet seconds]
	    && ![dict exists $fieldSet starDate] } {
	if { [dict exists $fieldSet tzName] } {
	    append procBody {
		set timeZone [dict get $date tzName]
	    }
	}
	append procBody {
	    SetupTimeZone $timeZone
	}
    }

    # Add code that gets Julian Day Number from the fields.

    append procBody [MakeParseCodeFromFields $fieldSet $DateParseActions]

    # Get time of day

    append procBody [MakeParseCodeFromFields $fieldSet $TimeParseActions]

    # Assemble seconds from the Julian day and second of the day.
    # Convert to local time unless epoch seconds or stardate are
    # being processed - they're always absolute

    if { ![dict exists $fieldSet seconds]
	 && ![dict exists $fieldSet starDate] } {
	append procBody {
	    if { [dict get $date julianDay] > 5373484 } {
		return -code error -errorcode [list CLOCK dateTooLarge] \
		    "requested date too large to represent"
	    }
	    dict set date localSeconds [expr {
		-210866803200
		+ ( 86400 * wide([dict get $date julianDay]) )
		+ [dict get $date secondOfDay]
	    }]
	}

	# Finally, convert the date to local time

	append procBody {
	    set date [ConvertLocalToUTC $date[set date {}] \
			  $TZData($timeZone) $changeover]
	}
    }

    # Return result

    append procBody {return [dict get $date seconds]} \n

    proc $procName { string baseTime timeZone } $procBody

    # puts [list proc $procName [list string baseTime timeZone] $procBody]

    return $procName
}

#----------------------------------------------------------------------
#
# LocaleNumeralMatcher --
#
#	Composes a regexp that captures the numerals in the given locale, and
#	a dictionary to map them to conventional numerals.
#
# Parameters:
#	locale - Name of the current locale
#
# Results:
#	Returns a two-element list comprising the regexp and the dictionary.
#
# Side effects:
#	Caches the result.
#
#----------------------------------------------------------------------

proc LocaleNumeralMatcher {l} {
    variable LocaleNumeralCache

    if { ![dict exists $LocaleNumeralCache $l] } {
	set d {}
	set i 0
	set sep \(
	foreach n [mc LOCALE_NUMERALS] {
	    dict set d $n $i
	    regsub -all {[^[:alnum:]]} $n \\\\& subex
	    append re $sep $subex
	    set sep |
	    incr i
	}
	append re \)
	dict set LocaleNumeralCache $l [list $re $d]
    }
    return [dict get $LocaleNumeralCache $l]
}



#----------------------------------------------------------------------
#
# UniquePrefixRegexp --
#
#	Composes a regexp that performs unique-prefix matching.  The RE
#	matches one of a supplied set of strings, or any unique prefix
#	thereof.
#
# Parameters:
#	data - List of alternating match-strings and values.
#	       Match-strings with distinct values are considered
#	       distinct.
#
# Results:
#	Returns a two-element list.  The first is a regexp that matches any
#	unique prefix of any of the strings.  The second is a dictionary whose
#	keys are match values from the regexp and whose values are the
#	corresponding values from 'data'.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc UniquePrefixRegexp { data } {
    # The 'successors' dictionary will contain, for each string that is a
    # prefix of any key, all characters that may follow that prefix.  The
    # 'prefixMapping' dictionary will have keys that are prefixes of keys and
    # values that correspond to the keys.

    set prefixMapping [dict create]
    set successors [dict create {} {}]

    # Walk the key-value pairs

    foreach { key value } $data {
	# Construct all prefixes of the key;

	set prefix {}
	foreach char [split $key {}] {
	    set oldPrefix $prefix
	    dict set successors $oldPrefix $char {}
	    append prefix $char

	    # Put the prefixes in the 'prefixMapping' and 'successors'
	    # dictionaries

	    dict lappend prefixMapping $prefix $value
	    if { ![dict exists $successors $prefix] } {
		dict set successors $prefix {}
	    }
	}
    }

    # Identify those prefixes that designate unique values, and those that are
    # the full keys

    set uniquePrefixMapping {}
    dict for { key valueList } $prefixMapping {
	if { [llength $valueList] == 1 } {
	    dict set uniquePrefixMapping $key [lindex $valueList 0]
	}
    }
    foreach { key value } $data {
	dict set uniquePrefixMapping $key $value
    }

    # Construct the re.

    return [list \
		[MakeUniquePrefixRegexp $successors $uniquePrefixMapping {}] \
		$uniquePrefixMapping]
}

#----------------------------------------------------------------------
#
# MakeUniquePrefixRegexp --
#
#	Service procedure for 'UniquePrefixRegexp' that constructs a regular
#	expresison that matches the unique prefixes.
#
# Parameters:
#	successors - Dictionary whose keys are all prefixes
#		     of keys passed to 'UniquePrefixRegexp' and whose
#		     values are dictionaries whose keys are the characters
#		     that may follow those prefixes.
#	uniquePrefixMapping - Dictionary whose keys are the unique
#			      prefixes and whose values are not examined.
#	prefixString - Current prefix being processed.
#
# Results:
#	Returns a constructed regular expression that matches the set of
#	unique prefixes beginning with the 'prefixString'.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc MakeUniquePrefixRegexp { successors
					  uniquePrefixMapping
					  prefixString } {

    # Get the characters that may follow the current prefix string

    set schars [lsort -ascii [dict keys [dict get $successors $prefixString]]]
    if { [llength $schars] == 0 } {
	return {}
    }

    # If there is more than one successor character, or if the current prefix
    # is a unique prefix, surround the generated re with non-capturing
    # parentheses.

    set re {}
    if {
	[dict exists $uniquePrefixMapping $prefixString]
	|| [llength $schars] > 1
    } then {
	append re "(?:"
    }

    # Generate a regexp that matches the successors.

    set sep ""
    foreach { c } $schars {
	set nextPrefix $prefixString$c
	regsub -all {[^[:alnum:]]} $c \\\\& rechar
	append re $sep $rechar \
	    [MakeUniquePrefixRegexp \
		 $successors $uniquePrefixMapping $nextPrefix]
	set sep |
    }

    # If the current prefix is a unique prefix, make all following text
    # optional. Otherwise, if there is more than one successor character,
    # close the non-capturing parentheses.

    if { [dict exists $uniquePrefixMapping $prefixString] } {
	append re ")?"
    } elseif { [llength $schars] > 1 } {
	append re ")"
    }

    return $re
}

#----------------------------------------------------------------------
#
# MakeParseCodeFromFields --
#
#	Composes Tcl code to extract the Julian Day Number from a dictionary
#	containing date fields.
#
# Parameters:
#	dateFields -- Dictionary whose keys are fields of the date,
#	              and whose values are the rightmost positions
#		      at which those fields appear.
#	parseActions -- List of triples: field set, priority, and
#			code to emit.  Smaller priorities are better, and
#			the list must be in ascending order by priority
#
# Results:
#	Returns a burst of code that extracts the day number from the given
#	date.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc MakeParseCodeFromFields { dateFields parseActions } {

    set currPrio 999
    set currFieldPos [list]
    set currCodeBurst {
	error "in MakeParseCodeFromFields: can't happen"
    }

    foreach { fieldSet prio parseAction } $parseActions {
	# If we've found an answer that's better than any that follow, quit
	# now.

	if { $prio > $currPrio } {
	    break
	}

	# Accumulate the field positions that are used in the current field
	# grouping.

	set fieldPos [list]
	set ok true
	foreach field $fieldSet {
	    if { ! [dict exists $dateFields $field] } {
		set ok 0
		break
	    }
	    lappend fieldPos [dict get $dateFields $field]
	}

	# Quit if we don't have a complete set of fields
	if { !$ok } {
	    continue
	}

	# Determine whether the current answer is better than the last.

	set fPos [lsort -integer -decreasing $fieldPos]

	if { $prio ==  $currPrio } {
	    foreach currPos $currFieldPos newPos $fPos {
		if {
		    ![string is integer $newPos]
		    || ![string is integer $currPos]
		    || $newPos > $currPos
		} then {
		    break
		}
		if { $newPos < $currPos } {
		    set ok 0
		    break
		}
	    }
	}
	if { !$ok } {
	    continue
	}

	# Remember the best possibility for extracting date information

	set currPrio $prio
	set currFieldPos $fPos
	set currCodeBurst $parseAction
    }

    return $currCodeBurst
}

#----------------------------------------------------------------------
#
# 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, loads the designated locale's files.
#
#----------------------------------------------------------------------

proc EnterLocale { locale } {
    if { $locale eq {system} } {
	if { $::tcl_platform(platform) ne {windows} } {
	    # On a non-windows platform, the 'system' locale is the same as
	    # the 'current' locale

	    set locale current
	} else {
	    # 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
	    }
	}
    }
    if { $locale eq {current}} {
	set locale [mclocale]
    }
    # Eventually load the locale
    mcpackagelocale set $locale
}

#----------------------------------------------------------------------
#
# LoadWindowsDateTimeFormats --
#
#	Load the date/time formats from the Control Panel in Windows and
#	convert them so that they're usable by Tcl.
#
# Parameters:
#	locale - Name of the locale in whose message catalog
#	         the converted formats are to be stored.
#
# Results:
#	None.
#
# Side effects:
#	Updates the given message catalog with the locale strings.
#
# Presumes that on entry, [mclocale] is set to the current locale, so that
# default strings can be obtained if the Registry query fails.
#
#----------------------------------------------------------------------

proc LoadWindowsDateTimeFormats { locale } {
    # Bail out if we can't find the Registry

    variable NoRegistry
    if { [info exists NoRegistry] } return

    if { ![catch {
	registry get "HKEY_CURRENT_USER\\Control Panel\\International" \
	    sShortDate
    } string] } {
	set quote {}
	set datefmt {}
	foreach { unquoted quoted } [split $string '] {
	    append datefmt $quote [string map {
		dddd %A
		ddd  %a
		dd   %d
		d    %e
		MMMM %B
		MMM  %b
		MM   %m
		M    %N
		yyyy %Y
		yy   %y
		y    %y
		gg   {}
	    } $unquoted]
	    if { $quoted eq {} } {
		set quote '
	    } else {
		set quote $quoted
	    }
	}
	::msgcat::mcset $locale DATE_FORMAT $datefmt
    }

    if { ![catch {
	registry get "HKEY_CURRENT_USER\\Control Panel\\International" \
	    sLongDate
    } string] } {
	set quote {}
	set ldatefmt {}
	foreach { unquoted quoted } [split $string '] {
	    append ldatefmt $quote [string map {
		dddd %A
		ddd  %a
		dd   %d
		d    %e
		MMMM %B
		MMM  %b
		MM   %m
		M    %N
		yyyy %Y
		yy   %y
		y    %y
		gg   {}
	    } $unquoted]
	    if { $quoted eq {} } {
		set quote '
	    } else {
		set quote $quoted
	    }
	}
	::msgcat::mcset $locale LOCALE_DATE_FORMAT $ldatefmt
    }

    if { ![catch {
	registry get "HKEY_CURRENT_USER\\Control Panel\\International" \
	    sTimeFormat
    } string] } {
	set quote {}
	set timefmt {}
	foreach { unquoted quoted } [split $string '] {
	    append timefmt $quote [string map {
		HH    %H
		H     %k
		hh    %I
		h     %l
		mm    %M
		m     %M
		ss    %S
		s     %S
		tt    %p
		t     %p
	    } $unquoted]
	    if { $quoted eq {} } {
		set quote '
	    } else {
		set quote $quoted
	    }
	}
	::msgcat::mcset $locale TIME_FORMAT $timefmt
    }

    catch {
	::msgcat::mcset $locale DATE_TIME_FORMAT "$datefmt $timefmt"
    }
    catch {
	::msgcat::mcset $locale LOCALE_DATE_TIME_FORMAT "$ldatefmt $timefmt"
    }

    return

}

#----------------------------------------------------------------------
#
# LocalizeFormat --
#
#	Map away locale-dependent format groups in a clock format.
#
# Parameters:
#	locale -- Current [mclocale] locale, supplied to avoid
#		  an extra call
#	format -- Format supplied to [clock scan] or [clock format]
#
# Results:
#	Returns the string with locale-dependent composite format groups
#	substituted out.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc LocalizeFormat { locale format } {

    # message catalog key to cache this format
    set key FORMAT_$format

    if { [::msgcat::mcexists -exactlocale -exactnamespace $key] } {
	return [mc $key]
    }
    # 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 list {
	%% %%
	%D %m/%d/%Y
	%+ {%a %b %e %H:%M:%S %Z %Y}
    }
    lappend list %EY [string map $list [mc LOCALE_YEAR_FORMAT]]
    lappend list %T  [string map $list [mc TIME_FORMAT_24_SECS]]
    lappend list %R  [string map $list [mc TIME_FORMAT_24]]
    lappend list %r  [string map $list [mc TIME_FORMAT_12]]
    lappend list %X  [string map $list [mc TIME_FORMAT]]
    lappend list %EX [string map $list [mc LOCALE_TIME_FORMAT]]
    lappend list %x  [string map $list [mc DATE_FORMAT]]
    lappend list %Ex [string map $list [mc LOCALE_DATE_FORMAT]]
    lappend list %c  [string map $list [mc DATE_TIME_FORMAT]]
    lappend list %Ec [string map $list [mc LOCALE_DATE_TIME_FORMAT]]
    set format [string map $list $format]

    ::msgcat::mcset $locale $key $format
    return $format
}

#----------------------------------------------------------------------
#
# FormatNumericTimeZone --
#
#	Formats a time zone as +hhmmss
#
# Parameters:
#	z - Time zone in seconds east of Greenwich
#
# Results:
#	Returns the time zone formatted in a numeric form
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc FormatNumericTimeZone { z } {
    if { $z < 0 } {
	set z [expr { - $z }]
	set retval -
    } else {
	set retval +
    }
    append retval [::format %02d [expr { $z / 3600 }]]
    set z [expr { $z % 3600 }]
    append retval [::format %02d [expr { $z / 60 }]]
    set z [expr { $z % 60 }]
    if { $z != 0 } {
	append retval [::format %02d $z]
    }
    return $retval
}

#----------------------------------------------------------------------
#
# FormatStarDate --
#
#	Formats a date as a StarDate.
#
# Parameters:
#	date - Dictionary containing 'year', 'dayOfYear', and
#	       'localSeconds' fields.
#
# Results:
#	Returns the given date formatted as a StarDate.
#
# Side effects:
#	None.
#
# Jeff Hobbs put this in to support an atrocious pun about Tcl being
# "Enterprise ready."  Now we're stuck with it.
#
#----------------------------------------------------------------------

proc FormatStarDate { date } {
    variable Roddenberry

    # Get day of year, zero based

    set doy [expr { [dict get $date dayOfYear] - 1 }]

    # Determine whether the year is a leap year

    set lp [IsGregorianLeapYear $date]

    # Convert day of year to a fractional year

    if { $lp } {
	set fractYear [expr { 1000 * $doy / 366 }]
    } else {
	set fractYear [expr { 1000 * $doy / 365 }]
    }

    # Put together the StarDate

    return [::format "Stardate %02d%03d.%1d" \
		[expr { [dict get $date year] - $Roddenberry }] \
		$fractYear \
		[expr { [dict get $date localSeconds] % 86400
			/ ( 86400 / 10 ) }]]
}

#----------------------------------------------------------------------
#
# ParseStarDate --
#
#	Parses a StarDate
#
# Parameters:
#	year - Year from the Roddenberry epoch
#	fractYear - Fraction of a year specifying the day of year.
#	fractDay - Fraction of a day
#
# Results:
#	Returns a count of seconds from the Posix epoch.
#
# Side effects:
#	None.
#
# Jeff Hobbs put this in to support an atrocious pun about Tcl being
# "Enterprise ready."  Now we're stuck with it.
#
#----------------------------------------------------------------------

proc ParseStarDate { year fractYear fractDay } {
    variable Roddenberry

    # Build a tentative date from year and fraction.

    set date [dict create \
		  gregorian 1 \
		  era CE \
		  year [expr { $year + $Roddenberry }] \
		  dayOfYear [expr { $fractYear * 365 / 1000 + 1 }]]
    set date [GetJulianDayFromGregorianEraYearDay $date[set date {}]]

    # Determine whether the given year is a leap year

    set lp [IsGregorianLeapYear $date]

    # Reconvert the fractional year according to whether the given year is a
    # leap year

    if { $lp } {
	dict set date dayOfYear \
	    [expr { $fractYear * 366 / 1000 + 1 }]
    } else {
	dict set date dayOfYear \
	    [expr { $fractYear * 365 / 1000 + 1 }]
    }
    dict unset date julianDay
    dict unset date gregorian
    set date [GetJulianDayFromGregorianEraYearDay $date[set date {}]]

    return [expr {
	86400 * [dict get $date julianDay]
	- 210866803200
	+ ( 86400 / 10 ) * $fractDay
    }]
}

#----------------------------------------------------------------------
#
# ScanWide --
#
#	Scans a wide integer from an input
#
# Parameters:
#	str - String containing a decimal wide integer
#
# Results:
#	Returns the string as a pure wide integer.  Throws an error if the
#	string is misformatted or out of range.
#
#----------------------------------------------------------------------

proc ScanWide { str } {
    set count [::scan $str {%ld %c} result junk]
    if { $count != 1 } {
	return -code error -errorcode [list CLOCK notAnInteger $str] \
	    "\"$str\" is not an integer"
    }
    if { [incr result 0] != $str } {
	return -code error -errorcode [list CLOCK dateTooLarge] \
	    "integer value too large to represent"
    }
    return $result
}

#----------------------------------------------------------------------
#
# InterpretTwoDigitYear --
#
#	Given a date that contains only the year of the century, determines
#	the target value of a two-digit year.
#
# Parameters:
#	date - Dictionary containing fields of the date.
#	baseTime - Base time relative to which the date is expressed.
#	twoDigitField - Name of the field that stores the two-digit year.
#			Default is 'yearOfCentury'
#	fourDigitField - Name of the field that will receive the four-digit
#	                 year.  Default is 'year'
#
# Results:
#	Returns the dictionary augmented with the four-digit year, stored in
#	the given key.
#
# Side effects:
#	None.
#
# The current rule for interpreting a two-digit year is that the year shall be
# between 1937 and 2037, thus staying within the range of a 32-bit signed
# value for time.  This rule may change to a sliding window in future
# versions, so the 'baseTime' parameter (which is currently ignored) is
# provided in the procedure signature.
#
#----------------------------------------------------------------------

proc InterpretTwoDigitYear { date baseTime
					   { twoDigitField yearOfCentury }
					   { fourDigitField year } } {
    set yr [dict get $date $twoDigitField]
    if { $yr <= 37 } {
	dict set date $fourDigitField [expr { $yr + 2000 }]
    } else {
	dict set date $fourDigitField [expr { $yr + 1900 }]
    }
    return $date
}

#----------------------------------------------------------------------
#
# AssignBaseYear --
#
#	Places the number of the current year into a dictionary.
#
# Parameters:
#	date - Dictionary value to update
#	baseTime - Base time from which to extract the year, expressed
#		   in seconds from the Posix epoch
#	timezone - the time zone in which the date is being scanned
#	changeover - the Julian Day on which the Gregorian calendar
#		     was adopted in the target locale.
#
# Results:
#	Returns the dictionary with the current year assigned.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc AssignBaseYear { date baseTime timezone changeover } {
    variable TZData

    # Find the Julian Day Number corresponding to the base time, and
    # find the Gregorian year corresponding to that Julian Day.

    set date2 [GetDateFields $baseTime $TZData($timezone) $changeover]

    # Store the converted year

    dict set date era [dict get $date2 era]
    dict set date year [dict get $date2 year]

    return $date
}

#----------------------------------------------------------------------
#
# AssignBaseIso8601Year --
#
#	Determines the base year in the ISO8601 fiscal calendar.
#
# Parameters:
#	date - Dictionary containing the fields of the date that
#	       is to be augmented with the base year.
#	baseTime - Base time expressed in seconds from the Posix epoch.
#	timeZone - Target time zone
#	changeover - Julian Day of adoption of the Gregorian calendar in
#		     the target locale.
#
# Results:
#	Returns the given date with "iso8601Year" set to the
#	base year.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc AssignBaseIso8601Year {date baseTime timeZone changeover} {
    variable TZData

    # Find the Julian Day Number corresponding to the base time

    set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover]

    # Calculate the ISO8601 date and transfer the year

    dict set date era CE
    dict set date iso8601Year [dict get $date2 iso8601Year]
    return $date
}

#----------------------------------------------------------------------
#
# AssignBaseMonth --
#
#	Places the number of the current year and month into a
#	dictionary.
#
# Parameters:
#	date - Dictionary value to update
#	baseTime - Time from which the year and month are to be
#	           obtained, expressed in seconds from the Posix epoch.
#	timezone - Name of the desired time zone
#	changeover - Julian Day on which the Gregorian calendar was adopted.
#
# Results:
#	Returns the dictionary with the base year and month assigned.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc AssignBaseMonth {date baseTime timezone changeover} {
    variable TZData

    # Find the year and month corresponding to the base time

    set date2 [GetDateFields $baseTime $TZData($timezone) $changeover]
    dict set date era [dict get $date2 era]
    dict set date year [dict get $date2 year]
    dict set date month [dict get $date2 month]
    return $date
}

#----------------------------------------------------------------------
#
# AssignBaseWeek --
#
#	Determines the base year and week in the ISO8601 fiscal calendar.
#
# Parameters:
#	date - Dictionary containing the fields of the date that
#	       is to be augmented with the base year and week.
#	baseTime - Base time expressed in seconds from the Posix epoch.
#	changeover - Julian Day on which the Gregorian calendar was adopted
#		     in the target locale.
#
# Results:
#	Returns the given date with "iso8601Year" set to the
#	base year and "iso8601Week" to the week number.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc AssignBaseWeek {date baseTime timeZone changeover} {
    variable TZData

    # Find the Julian Day Number corresponding to the base time

    set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover]

    # Calculate the ISO8601 date and transfer the year

    dict set date era CE
    dict set date iso8601Year [dict get $date2 iso8601Year]
    dict set date iso8601Week [dict get $date2 iso8601Week]
    return $date
}

#----------------------------------------------------------------------
#
# AssignBaseJulianDay --
#
#	Determines the base day for a time-of-day conversion.
#
# Parameters:
#	date - Dictionary that is to get the base day
#	baseTime - Base time expressed in seconds from the Posix epoch
#	changeover - Julian day on which the Gregorian calendar was
#		     adpoted in the target locale.
#
# Results:
#	Returns the given dictionary augmented with a 'julianDay' field
#	that contains the base day.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc AssignBaseJulianDay { date baseTime timeZone changeover } {
    variable TZData

    # Find the Julian Day Number corresponding to the base time

    set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover]
    dict set date julianDay [dict get $date2 julianDay]

    return $date
}

#----------------------------------------------------------------------
#
# InterpretHMSP --
#
#	Interprets a time in the form "hh:mm:ss am".
#
# Parameters:
#	date -- Dictionary containing "hourAMPM", "minute", "second"
#	        and "amPmIndicator" fields.
#
# Results:
#	Returns the number of seconds from local midnight.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc InterpretHMSP { date } {
    set hr [dict get $date hourAMPM]
    if { $hr == 12 } {
	set hr 0
    }
    if { [dict get $date amPmIndicator] } {
	incr hr 12
    }
    dict set date hour $hr
    return [InterpretHMS $date[set date {}]]
}

#----------------------------------------------------------------------
#
# InterpretHMS --
#
#	Interprets a 24-hour time "hh:mm:ss"
#
# Parameters:
#	date -- Dictionary containing the "hour", "minute" and "second"
#	        fields.
#
# Results:
#	Returns the given dictionary augmented with a "secondOfDay"
#	field containing the number of seconds from local midnight.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc InterpretHMS { date } {
    return [expr {
	( [dict get $date hour] * 60
	  + [dict get $date minute] ) * 60
	+ [dict get $date second]
    }]
}

#----------------------------------------------------------------------
#
# 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 system time zone in the 'CachedSystemTimeZone'
#	variable, since determining it may be an expensive process.
#
#----------------------------------------------------------------------

proc GetSystemTimeZone {} {
    variable CachedSystemTimeZone
    variable TimeZoneBad

    if {[set result [getenv TCL_TZ]] ne {}} {
	set timezone $result
    } elseif {[set result [getenv TZ]] ne {}} {
	set timezone $result
    } else {
	# Cache the time zone only if it was detected by one of the
	# expensive methods.
	if { [info exists CachedSystemTimeZone] } {
	    set timezone $CachedSystemTimeZone
	} elseif { $::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
	}
	set CachedSystemTimeZone $timezone
    }
    if { ![dict exists $TimeZoneBad $timezone] } {
	dict set TimeZoneBad $timezone [catch {SetupTimeZone $timezone}]
    }
    if { [dict get $TimeZoneBad $timezone] } {
	return :localtime
    } else {
	return $timezone
    }
}

#----------------------------------------------------------------------
#
# ConvertLegacyTimeZone --
#
#	Given an alphanumeric time zone identifier and the system time zone,
#	convert the alphanumeric identifier to an unambiguous time zone.
#
# Parameters:
#	tzname - Name of the time zone to convert
#
# Results:
#	Returns a time zone name corresponding to tzname, but in an
#	unambiguous form, generally +hhmm.
#
# This procedure is implemented primarily to allow the parsing of RFC822
# date/time strings.  Processing a time zone name on input is not recommended
# practice, because there is considerable room for ambiguity; for instance, is
# BST Brazilian Standard Time, or British Summer Time?
#
#----------------------------------------------------------------------

proc ConvertLegacyTimeZone { tzname } {
    variable LegacyTimeZone

    set tzname [string tolower $tzname]
    if { ![dict exists $LegacyTimeZone $tzname] } {
	return -code error -errorcode [list CLOCK badTZName $tzname] \
	    "time zone \"$tzname\" not found"
    }
    return [dict get $LegacyTimeZone $tzname]
}

#----------------------------------------------------------------------
#
# 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 SetupTimeZone { timezone } {
    variable TZData

    if {! [info exists TZData($timezone)] } {
	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]
	} then {
	    # Make a fixed offset

	    ::scan $hh %d hh
	    if { $mm eq {} } {
		set mm 0
	    } else {
		::scan $mm %d mm
	    }
	    if { $ss eq {} } {
		set ss 0
	    } else {
		::scan $ss %d ss
	    }
	    set offset [expr { ( $hh * 60 + $mm ) * 60 + $ss }]
	    if { $s eq {-} } {
		set offset [expr { - $offset }]
	    }
	    set TZData($timezone) [list [list $MINWIDE $offset -1 $timezone]]

	} elseif { [string index $timezone 0] eq {:} } {
	    # Convert using a time zone file

	    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)
	}
    }

    return
}

#----------------------------------------------------------------------
#
# GuessWindowsTimeZone --
#
#	Determines the system time zone on windows.
#
# Parameters:
#	None.
#
# Results:
#	Returns a time zone specifier that corresponds to the system time zone
#	information found in the Registry.
#
# Bugs:
#	Fixed dates for DST change are unimplemented at present, because no
#	time zone information supplied with Windows actually uses them!
#
# On a Windows system where neither $env(TCL_TZ) nor $env(TZ) is specified,
# GuessWindowsTimeZone looks in the Registry for the system time zone
# information.  It then attempts to find an entry in WinZoneInfo for a time
# zone that uses the same rules.  If it finds one, it returns it; otherwise,
# it constructs a Posix-style time zone string and returns that.
#
#----------------------------------------------------------------------

proc GuessWindowsTimeZone {} {
    variable WinZoneInfo
    variable NoRegistry
    variable TimeZoneBad

    if { [info exists NoRegistry] } {
	return :localtime
    }

    # Dredge time zone information out of the registry

    if { [catch {
	set rpath HKEY_LOCAL_MACHINE\\System\\CurrentControlSet\\Control\\TimeZoneInformation
	set data [list \
		      [expr { -60
			      * [registry get $rpath Bias] }] \
		      [expr { -60
				  * [registry get $rpath StandardBias] }] \
		      [expr { -60 \
				  * [registry get $rpath DaylightBias] }]]
	set stdtzi [registry get $rpath StandardStart]
	foreach ind {0 2 14 4 6 8 10 12} {
	    binary scan $stdtzi @${ind}s val
	    lappend data $val
	}
	set daytzi [registry get $rpath DaylightStart]
	foreach ind {0 2 14 4 6 8 10 12} {
	    binary scan $daytzi @${ind}s val
	    lappend data $val
	}
    }] } {
	# Missing values in the Registry - bail out

	return :localtime
    }

    # 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] } {
	    dict set TimeZoneBad $tzname [catch {SetupTimeZone $tzname}]
	}
    } else {
	set tzname {}
    }
    if { $tzname eq {} || [dict get $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 }]
	set dstDelta [expr { $bias + $dstBias }]
	if { $stdDelta <= 0 } {
	    set stdSignum +
	    set stdDelta [expr { - $stdDelta }]
	    set dispStdSignum -
	} else {
	    set stdSignum -
	    set dispStdSignum +
	}
	set hh [::format %02d [expr { $stdDelta / 3600 }]]
	set mm [::format %02d [expr { ($stdDelta / 60 ) % 60 }]]
	set ss [::format %02d [expr { $stdDelta % 60 }]]
	set tzname {}
	append tzname < $dispStdSignum $hh $mm > $stdSignum $hh : $mm : $ss
	if { $stdMonth >= 0 } {
	    if { $dstDelta <= 0 } {
		set dstSignum +
		set dstDelta [expr { - $dstDelta }]
		set dispDstSignum -
	    } else {
		set dstSignum -
		set dispDstSignum +
	    }
	    set hh [::format %02d [expr { $dstDelta / 3600 }]]
	    set mm [::format %02d [expr { ($dstDelta / 60 ) % 60 }]]
	    set ss [::format %02d [expr { $dstDelta % 60 }]]
	    append tzname < $dispDstSignum $hh $mm > $dstSignum $hh : $mm : $ss
	    if { $dstYear == 0 } {
		append tzname ,M $dstMonth . $dstDayOfMonth . $dstDayOfWeek
	    } else {
		# I have not been able to find any locale on which Windows
		# converts time zone on a fixed day of the year, hence don't
		# know how to interpret the fields.  If someone can inform me,
		# I'd be glad to code it up.  For right now, we bail out in
		# such a case.
		return :localtime
	    }
	    append tzname / [::format %02d $dstHour] \
		: [::format %02d $dstMinute] \
		: [::format %02d $dstSecond]
	    if { $stdYear == 0 } {
		append tzname ,M $stdMonth . $stdDayOfMonth . $stdDayOfWeek
	    } else {
		# I have not been able to find any locale on which Windows
		# converts time zone on a fixed day of the year, hence don't
		# know how to interpret the fields.  If someone can inform me,
		# I'd be glad to code it up.  For right now, we bail out in
		# such a case.
		return :localtime
	    }
	    append tzname / [::format %02d $stdHour] \
		: [::format %02d $stdMinute] \
		: [::format %02d $stdSecond]
	}
	dict set WinZoneInfo $data $tzname
    }

    return [dict get $WinZoneInfo $data]
}

#----------------------------------------------------------------------
#
# LoadTimeZoneFile --
#
#	Load the data file that specifies the conversion between a
#	given time zone and Greenwich.
#
# Parameters:
#	fileName -- Name of the file to load
#
# Results:
#	None.
#
# Side effects:
#	TZData(:fileName) contains the time zone data
#
#----------------------------------------------------------------------

proc LoadTimeZoneFile { fileName } {
    variable DataDir
    variable TZData

    if { [info exists TZData($fileName)] } {
	return
    }

    # Since an unsafe interp uses the [clock] command in the parent, this code
    # is security sensitive.  Make sure that the path name cannot escape the
    # given directory.

    if { ![regexp {^[[.-.][:alpha:]_]+(?:/[[.-.][:alpha:]_]+)*$} $fileName] } {
	return -code error \
	    -errorcode [list CLOCK badTimeZone $:fileName] \
	    "time zone \":$fileName\" not valid"
    }
    try {
	source [file join $DataDir $fileName]
    } on error {} {
	return -code error \
	    -errorcode [list CLOCK badTimeZone :$fileName] \
	    "time zone \":$fileName\" not found"
    }
    return
}

#----------------------------------------------------------------------
#
# LoadZoneinfoFile --
#
#	Loads a binary time zone information file in Olson format.
#
# Parameters:
#	fileName - Relative path name of the file to load.
#
# Results:
#	Returns an empty result normally; returns an error if no Olson file
#	was found or the file was malformed in some way.
#
# Side effects:
#	TZData(:fileName) contains the time zone data
#
#----------------------------------------------------------------------

proc LoadZoneinfoFile { fileName } {
    variable ZoneinfoPaths

    # Since an unsafe interp uses the [clock] command in the parent, this code
    # is security sensitive.  Make sure that the path name cannot escape the
    # given directory.

    if { ![regexp {^[[.-.][:alpha:]_]+(?:/[[.-.][:alpha:]_]+)*$} $fileName] } {
	return -code error \
	    -errorcode [list CLOCK badTimeZone $:fileName] \
	    "time zone \":$fileName\" not valid"
    }
    foreach d $ZoneinfoPaths {
	set fname [file join $d $fileName]
	if { [file readable $fname] && [file isfile $fname] } {
	    break
	}
	unset fname
    }
    ReadZoneinfoFile $fileName $fname
}

#----------------------------------------------------------------------
#
# ReadZoneinfoFile --
#
#	Loads a binary time zone information file in Olson format.
#
# Parameters:
#	fileName - Name of the time zone (relative path name of the
#		   file).
#	fname - Absolute path name of the file.
#
# Results:
#	Returns an empty result normally; returns an error if no Olson file
#	was found or the file was malformed in some way.
#
# Side effects:
#	TZData(:fileName) contains the time zone data
#
#----------------------------------------------------------------------

proc ReadZoneinfoFile {fileName fname} {
    variable MINWIDE
    variable TZData
    if { ![file exists $fname] } {
	return -code error "$fileName not found"
    }

    if { [file size $fname] > 262144 } {
	return -code error "$fileName too big"
    }

    # Suck in all the data from the file

    set f [open $fname r]
    fconfigure $f -translation binary
    set d [read $f]
    close $f

    # The file begins with a magic number, sixteen reserved bytes, and then
    # six 4-byte integers giving counts of fields in the file.

    binary scan $d a4a1x15IIIIII \
	magic version nIsGMT nIsStd nLeap nTime nType nChar
    set seek 44
    set ilen 4
    set iformat I
    if { $magic != {TZif} } {
	return -code error "$fileName not a time zone information file"
    }
    if { $nType > 255 } {
	return -code error "$fileName contains too many time types"
    }
    # Accept only Posix-style zoneinfo.  Sorry, 'leaps' bigots.
    if { $nLeap != 0 } {
	return -code error "$fileName contains leap seconds"
    }

    # In a version 2 file, we use the second part of the file, which contains
    # 64-bit transition times.

    if {$version eq "2"} {
	set seek [expr {
	    44
	    + 5 * $nTime
	    + 6 * $nType
	    + 4 * $nLeap
	    + $nIsStd
	    + $nIsGMT
	    + $nChar
	}]
	binary scan $d @${seek}a4a1x15IIIIII \
	    magic version nIsGMT nIsStd nLeap nTime nType nChar
	if {$magic ne {TZif}} {
	    return -code error "seek address $seek miscomputed, magic = $magic"
	}
	set iformat W
	set ilen 8
	incr seek 44
    }

    # Next come ${nTime} transition times, followed by ${nTime} time type
    # codes.  The type codes are unsigned 1-byte quantities.  We insert an
    # arbitrary start time in front of the transitions.

    binary scan $d @${seek}${iformat}${nTime}c${nTime} times tempCodes
    incr seek [expr { ($ilen + 1) * $nTime }]
    set times [linsert $times 0 $MINWIDE]
    set codes {}
    foreach c $tempCodes {
	lappend codes [expr { $c & 0xFF }]
    }
    set codes [linsert $codes 0 0]

    # Next come ${nType} time type descriptions, each of which has an offset
    # (seconds east of GMT), a DST indicator, and an index into the
    # abbreviation text.

    for { set i 0 } { $i < $nType } { incr i } {
	binary scan $d @${seek}Icc gmtOff isDst abbrInd
	lappend types [list $gmtOff $isDst $abbrInd]
	incr seek 6
    }

    # Next come $nChar characters of time zone name abbreviations, which are
    # null-terminated.
    # We build them up into a dictionary indexed by character index, because
    # that's what's in the indices above.

    binary scan $d @${seek}a${nChar} abbrs
    incr seek ${nChar}
    set abbrList [split $abbrs \0]
    set i 0
    set abbrevs {}
    foreach a $abbrList {
	for {set j 0} {$j <= [string length $a]} {incr j} {
	    dict set abbrevs $i [string range $a $j end]
	    incr i
	}
    }

    # Package up a list of tuples, each of which contains transition time,
    # seconds east of Greenwich, DST flag and time zone abbreviation.

    set r {}
    set lastTime $MINWIDE
    foreach t $times c $codes {
	if { $t < $lastTime } {
	    return -code error "$fileName has times out of order"
	}
	set lastTime $t
	lassign [lindex $types $c] gmtoff isDst abbrInd
	set abbrev [dict get $abbrevs $abbrInd]
	lappend r [list $t $gmtoff $isDst $abbrev]
    }

    # In a version 2 file, there is also a POSIX-style time zone description
    # at the very end of the file.  To get to it, skip over nLeap leap second
    # values (8 bytes each),
    # nIsStd standard/DST indicators and nIsGMT UTC/local indicators.

    if {$version eq {2}} {
	set seek [expr {$seek + 8 * $nLeap + $nIsStd + $nIsGMT + 1}]
	set last [string first \n $d $seek]
	set posix [string range $d $seek [expr {$last-1}]]
	if {[llength $posix] > 0} {
	    set posixFields [ParsePosixTimeZone $posix]
	    foreach tuple [ProcessPosixTimeZone $posixFields] {
		lassign $tuple t gmtoff isDst abbrev
		if {$t > $lastTime} {
		    lappend r $tuple
		}
	    }
	}
    }

    set TZData(:$fileName) $r

    return
}

#----------------------------------------------------------------------
#
# ParsePosixTimeZone --
#
#	Parses the TZ environment variable in Posix form
#
# Parameters:
#	tz	Time zone specifier to be interpreted
#
# Results:
#	Returns a dictionary whose values contain the various pieces of the
#	time zone specification.
#
# Side effects:
#	None.
#
# Errors:
#	Throws an error if the syntax of the time zone is incorrect.
#
# The following keys are present in the dictionary:
#	stdName - Name of the time zone when Daylight Saving Time
#		  is not in effect.
#	stdSignum - Sign (+, -, or empty) of the offset from Greenwich
#		    to the given (non-DST) time zone.  + and the empty
#		    string denote zones west of Greenwich, - denotes east
#		    of Greenwich; this is contrary to the ISO convention
#		    but follows Posix.
#	stdHours - Hours part of the offset from Greenwich to the given
#		   (non-DST) time zone.
#	stdMinutes - Minutes part of the offset from Greenwich to the
#		     given (non-DST) time zone. Empty denotes zero.
#	stdSeconds - Seconds part of the offset from Greenwich to the
#		     given (non-DST) time zone. Empty denotes zero.
#	dstName - Name of the time zone when DST is in effect, or the
#		  empty string if the time zone does not observe Daylight
#		  Saving Time.
#	dstSignum, dstHours, dstMinutes, dstSeconds -
#		Fields corresponding to stdSignum, stdHours, stdMinutes,
#		stdSeconds for the Daylight Saving Time version of the
#		time zone.  If dstHours is empty, it is presumed to be 1.
#	startDayOfYear - The ordinal number of the day of the year on which
#			 Daylight Saving Time begins.  If this field is
#			 empty, then DST begins on a given month-week-day,
#			 as below.
#	startJ - The letter J, or an empty string.  If a J is present in
#		 this field, then startDayOfYear does not count February 29
#		 even in leap years.
#	startMonth - The number of the month in which Daylight Saving Time
#		     begins, supplied if startDayOfYear is empty.  If both
#		     startDayOfYear and startMonth are empty, then US rules
#		     are presumed.
#	startWeekOfMonth - The number of the week in the month in which
#			   Daylight Saving Time begins, in the range 1-5.
#			   5 denotes the last week of the month even in a
#			   4-week month.
#	startDayOfWeek - The number of the day of the week (Sunday=0,
#			 Saturday=6) on which Daylight Saving Time begins.
#	startHours - The hours part of the time of day at which Daylight
#		     Saving Time begins. An empty string is presumed to be 2.
#	startMinutes - The minutes part of the time of day at which DST begins.
#		       An empty string is presumed zero.
#	startSeconds - The seconds part of the time of day at which DST begins.
#		       An empty string is presumed zero.
#	endDayOfYear, endJ, endMonth, endWeekOfMonth, endDayOfWeek,
#	endHours, endMinutes, endSeconds -
#		Specify the end of DST in the same way that the start* fields
#		specify the beginning of DST.
#
# This procedure serves only to break the time specifier into fields.  No
# attempt is made to canonicalize the fields or supply default values.
#
#----------------------------------------------------------------------

proc ParsePosixTimeZone { tz } {
    if {[regexp -expanded -nocase -- {
	^
	# 1 - Standard time zone name
	([[:alpha:]]+ | <[-+[:alnum:]]+>)
	# 2 - Standard time zone offset, signum
	([-+]?)
	# 3 - Standard time zone offset, hours
	([[:digit:]]{1,2})
	(?:
	    # 4 - Standard time zone offset, minutes
	    : ([[:digit:]]{1,2})
	    (?:
		# 5 - Standard time zone offset, seconds
		: ([[:digit:]]{1,2} )
	    )?
	)?
	(?:
	    # 6 - DST time zone name
	    ([[:alpha:]]+ | <[-+[:alnum:]]+>)
	    (?:
		(?:
		    # 7 - DST time zone offset, signum
		    ([-+]?)
		    # 8 - DST time zone offset, hours
		    ([[:digit:]]{1,2})
		    (?:
			# 9 - DST time zone offset, minutes
			: ([[:digit:]]{1,2})
			(?:
			    # 10 - DST time zone offset, seconds
			    : ([[:digit:]]{1,2})
			)?
		    )?
		)?
		(?:
		    ,
		    (?:
			# 11 - Optional J in n and Jn form 12 - Day of year
			( J ? )	( [[:digit:]]+ )
			| M
			# 13 - Month number 14 - Week of month 15 - Day of week
			( [[:digit:]] + )
			[.] ( [[:digit:]] + )
			[.] ( [[:digit:]] + )
		    )
		    (?:
			# 16 - Start time of DST - hours
			/ ( [[:digit:]]{1,2} )
			(?:
			    # 17 - Start time of DST - minutes
			    : ( [[:digit:]]{1,2} )
			    (?:
				# 18 - Start time of DST - seconds
				: ( [[:digit:]]{1,2} )
			    )?
			)?
		    )?
		    ,
		    (?:
			# 19 - Optional J in n and Jn form 20 - Day of year
			( J ? )	( [[:digit:]]+ )
			| M
			# 21 - Month number 22 - Week of month 23 - Day of week
			( [[:digit:]] + )
			[.] ( [[:digit:]] + )
			[.] ( [[:digit:]] + )
		    )
		    (?:
			# 24 - End time of DST - hours
			/ ( [[:digit:]]{1,2} )
			(?:
			    # 25 - End time of DST - minutes
			    : ( [[:digit:]]{1,2} )
			    (?:
				# 26 - End time of DST - seconds
				: ( [[:digit:]]{1,2} )
			    )?
			)?
		    )?
		)?
	    )?
	)?
	$
    } $tz -> x(stdName) x(stdSignum) x(stdHours) x(stdMinutes) x(stdSeconds) \
	     x(dstName) x(dstSignum) x(dstHours) x(dstMinutes) x(dstSeconds) \
	     x(startJ) x(startDayOfYear) \
	     x(startMonth) x(startWeekOfMonth) x(startDayOfWeek) \
	     x(startHours) x(startMinutes) x(startSeconds) \
	     x(endJ) x(endDayOfYear) \
	     x(endMonth) x(endWeekOfMonth) x(endDayOfWeek) \
	     x(endHours) x(endMinutes) x(endSeconds)] } {
	# it's a good timezone

	return [array get x]
    }

    return -code error\
	-errorcode [list CLOCK badTimeZone $tz] \
	"unable to parse time zone specification \"$tz\""
}

#----------------------------------------------------------------------
#
# ProcessPosixTimeZone --
#
#	Handle a Posix time zone after it's been broken out into fields.
#
# Parameters:
#	z - Dictionary returned from 'ParsePosixTimeZone'
#
# Results:
#	Returns time zone information for the 'TZData' array.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ProcessPosixTimeZone { z } {
    variable MINWIDE
    variable TZData

    # Determine the standard time zone name and seconds east of Greenwich

    set stdName [dict get $z stdName]
    if { [string index $stdName 0] eq {<} } {
	set stdName [string range $stdName 1 end-1]
    }
    if { [dict get $z stdSignum] eq {-} } {
	set stdSignum +1
    } else {
	set stdSignum -1
    }
    set stdHours [lindex [::scan [dict get $z stdHours] %d] 0]
    if { [dict get $z stdMinutes] ne {} } {
	set stdMinutes [lindex [::scan [dict get $z stdMinutes] %d] 0]
    } else {
	set stdMinutes 0
    }
    if { [dict get $z stdSeconds] ne {} } {
	set stdSeconds [lindex [::scan [dict get $z stdSeconds] %d] 0]
    } else {
	set stdSeconds 0
    }
    set stdOffset [expr {
	(($stdHours * 60 + $stdMinutes) * 60 + $stdSeconds) * $stdSignum
    }]
    set data [list [list $MINWIDE $stdOffset 0 $stdName]]

    # If there's no daylight zone, we're done

    set dstName [dict get $z dstName]
    if { $dstName eq {} } {
	return $data
    }
    if { [string index $dstName 0] eq {<} } {
	set dstName [string range $dstName 1 end-1]
    }

    # Determine the daylight name

    if { [dict get $z dstSignum] eq {-} } {
	set dstSignum +1
    } else {
	set dstSignum -1
    }
    if { [dict get $z dstHours] eq {} } {
	set dstOffset [expr { 3600 + $stdOffset }]
    } else {
	set dstHours [lindex [::scan [dict get $z dstHours] %d] 0]
	if { [dict get $z dstMinutes] ne {} } {
	    set dstMinutes [lindex [::scan [dict get $z dstMinutes] %d] 0]
	} else {
	    set dstMinutes 0
	}
	if { [dict get $z dstSeconds] ne {} } {
	    set dstSeconds [lindex [::scan [dict get $z dstSeconds] %d] 0]
	} else {
	    set dstSeconds 0
	}
	set dstOffset [expr {
	    (($dstHours*60 + $dstMinutes) * 60 + $dstSeconds) * $dstSignum
	}]
    }

    # Fill in defaults for European or US DST rules
    # US start time is the second Sunday in March
    # EU start time is the last Sunday in March
    # US end time is the first Sunday in November.
    # EU end time is the last Sunday in October

    if {
	[dict get $z startDayOfYear] eq {}
	&& [dict get $z startMonth] eq {}
    } then {
	if {($stdSignum * $stdHours>=0) && ($stdSignum * $stdHours<=12)} {
	    # EU
	    dict set z startWeekOfMonth 5
	    if {$stdHours>2} {
		dict set z startHours 2
	    } else {
		dict set z startHours [expr {$stdHours+1}]
	    }
	} else {
	    # US
	    dict set z startWeekOfMonth 2
	    dict set z startHours 2
	}
	dict set z startMonth 3
	dict set z startDayOfWeek 0
	dict set z startMinutes 0
	dict set z startSeconds 0
    }
    if {
	[dict get $z endDayOfYear] eq {}
	&& [dict get $z endMonth] eq {}
    } then {
	if {($stdSignum * $stdHours>=0) && ($stdSignum * $stdHours<=12)} {
	    # EU
	    dict set z endMonth 10
	    dict set z endWeekOfMonth 5
	    if {$stdHours>2} {
		dict set z endHours 3
	    } else {
		dict set z endHours [expr {$stdHours+2}]
	    }
	} else {
	    # US
	    dict set z endMonth 11
	    dict set z endWeekOfMonth 1
	    dict set z endHours 2
	}
	dict set z endDayOfWeek 0
	dict set z endMinutes 0
	dict set z endSeconds 0
    }

    # Put DST in effect in all years from 1916 to 2099.

    for { set y 1916 } { $y < 2100 } { incr y } {
	set startTime [DeterminePosixDSTTime $z start $y]
	incr startTime [expr { - wide($stdOffset) }]
	set endTime [DeterminePosixDSTTime $z end $y]
	incr endTime [expr { - wide($dstOffset) }]
	if { $startTime < $endTime } {
	    lappend data \
		[list $startTime $dstOffset 1 $dstName] \
		[list $endTime $stdOffset 0 $stdName]
	} else {
	    lappend data \
		[list $endTime $stdOffset 0 $stdName] \
		[list $startTime $dstOffset 1 $dstName]
	}
    }

    return $data
}

#----------------------------------------------------------------------
#
# DeterminePosixDSTTime --
#
#	Determines the time that Daylight Saving Time starts or ends from a
#	Posix time zone specification.
#
# Parameters:
#	z - Time zone data returned from ParsePosixTimeZone.
#	    Missing fields are expected to be filled in with
#	    default values.
#	bound - The word 'start' or 'end'
#	y - The year for which the transition time is to be determined.
#
# Results:
#	Returns the transition time as a count of seconds from the epoch.  The
#	time is relative to the wall clock, not UTC.
#
#----------------------------------------------------------------------

proc DeterminePosixDSTTime { z bound y } {

    variable FEB_28

    # Determine the start or end day of DST

    set date [dict create era CE year $y]
    set doy [dict get $z ${bound}DayOfYear]
    if { $doy ne {} } {

	# Time was specified as a day of the year

	if { [dict get $z ${bound}J] ne {}
	     && [IsGregorianLeapYear $y]
	     && ( $doy > $FEB_28 ) } {
	    incr doy
	}
	dict set date dayOfYear $doy
	set date [GetJulianDayFromEraYearDay $date[set date {}] 2361222]
    } else {
	# Time was specified as a day of the week within a month

	dict set date month [dict get $z ${bound}Month]
	dict set date dayOfWeek [dict get $z ${bound}DayOfWeek]
	set dowim [dict get $z ${bound}WeekOfMonth]
	if { $dowim >= 5 } {
	    set dowim -1
	}
	dict set date dayOfWeekInMonth $dowim
	set date [GetJulianDayFromEraYearMonthWeekDay $date[set date {}] 2361222]

    }

    set jd [dict get $date julianDay]
    set seconds [expr {
	wide($jd) * wide(86400) - wide(210866803200)
    }]

    set h [dict get $z ${bound}Hours]
    if { $h eq {} } {
	set h 2
    } else {
	set h [lindex [::scan $h %d] 0]
    }
    set m [dict get $z ${bound}Minutes]
    if { $m eq {} } {
	set m 0
    } else {
	set m [lindex [::scan $m %d] 0]
    }
    set s [dict get $z ${bound}Seconds]
    if { $s eq {} } {
	set s 0
    } else {
	set s [lindex [::scan $s %d] 0]
    }
    set tod [expr { ( $h * 60 + $m ) * 60 + $s }]
    return [expr { $seconds + $tod }]
}

#----------------------------------------------------------------------
#
# GetLocaleEra --
#
#	Given local time expressed in seconds from the Posix epoch,
#	determine localized era and year within the era.
#
# Parameters:
#	date - Dictionary that must contain the keys, 'localSeconds',
#	       whose value is expressed as the appropriate local time;
#	       and 'year', whose value is the Gregorian year.
#	etable - Value of the LOCALE_ERAS key in the message catalogue
#	         for the target locale.
#
# Results:
#	Returns the dictionary, augmented with the keys, 'localeEra' and
#	'localeYear'.
#
#----------------------------------------------------------------------

proc GetLocaleEra { date etable } {
    set index [BSearch $etable [dict get $date localSeconds]]
    if { $index < 0} {
	dict set date localeEra \
	    [::format %02d [expr { [dict get $date year] / 100 }]]
	dict set date localeYear [expr {
	    [dict get $date year] % 100
	}]
    } else {
	dict set date localeEra [lindex $etable $index 1]
	dict set date localeYear [expr {
	    [dict get $date year] - [lindex $etable $index 2]
	}]
    }
    return $date
}

#----------------------------------------------------------------------
#
# 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
#		'dayOfYear' slots are populated. The calendar in use
#		is determined by the date itself relative to:
#       changeover -- Julian day on which the Gregorian calendar was
#		adopted in the current locale.
#
# Results:
#	Returns the given dictionary augmented with a 'julianDay' key whose
#	value is the desired Julian Day Number, and a 'gregorian' key that
#	specifies whether the calendar is Gregorian (1) or Julian (0).
#
# Side effects:
#	None.
#
# Bugs:
#	This code needs to be moved to the C layer.
#
#----------------------------------------------------------------------

proc GetJulianDayFromEraYearDay {date changeover} {
    # Get absolute year number from the civil year

    switch -exact -- [dict get $date era] {
	BCE {
	    set year [expr { 1 - [dict get $date year] }]
	}
	CE {
	    set year [dict get $date year]
	}
    }
    set ym1 [expr { $year - 1 }]

    # Try the Gregorian calendar first.

    dict set date gregorian 1
    set jd [expr {
	1721425
	+ [dict get $date dayOfYear]
	+ ( 365 * $ym1 )
	+ ( $ym1 / 4 )
	- ( $ym1 / 100 )
	+ ( $ym1 / 400 )
    }]

    # If the date is before the Gregorian change, use the Julian calendar.

    if { $jd < $changeover } {
	dict set date gregorian 0
	set jd [expr {
	    1721423
	    + [dict get $date dayOfYear]
	    + ( 365 * $ym1 )
	    + ( $ym1 / 4 )
	}]
    }

    dict set date julianDay $jd
    return $date
}

#----------------------------------------------------------------------
#
# GetJulianDayFromEraYearMonthWeekDay --
#
#	Determines the Julian Day number corresponding to the nth given
#	day-of-the-week in a given month.
#
# Parameters:
#	date - Dictionary containing the keys, 'era', 'year', 'month'
#	       'weekOfMonth', 'dayOfWeek', and 'dayOfWeekInMonth'.
#	changeover - Julian Day of adoption of the Gregorian calendar
#
# Results:
#	Returns the given dictionary, augmented with a 'julianDay' key.
#
# Side effects:
#	None.
#
# Bugs:
#	This code needs to be moved to the C layer.
#
#----------------------------------------------------------------------

proc GetJulianDayFromEraYearMonthWeekDay {date changeover} {
    # Come up with a reference day; either the zeroeth day of the given month
    # (dayOfWeekInMonth >= 0) or the seventh day of the following month
    # (dayOfWeekInMonth < 0)

    set date2 $date
    set week [dict get $date dayOfWeekInMonth]
    if { $week >= 0 } {
	dict set date2 dayOfMonth 0
    } else {
	dict incr date2 month
	dict set date2 dayOfMonth 7
    }
    set date2 [GetJulianDayFromEraYearMonthDay $date2[set date2 {}] \
		   $changeover]
    set wd0 [WeekdayOnOrBefore [dict get $date dayOfWeek] \
		 [dict get $date2 julianDay]]
    dict set date julianDay [expr { $wd0 + 7 * $week }]
    return $date
}

#----------------------------------------------------------------------
#
# IsGregorianLeapYear --
#
#	Determines whether a given date represents a leap year in the
#	Gregorian calendar.
#
# Parameters:
#	date -- The date to test.  The fields, 'era', 'year' and 'gregorian'
#	        must be set.
#
# Results:
#	Returns 1 if the year is a leap year, 0 otherwise.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc IsGregorianLeapYear { date } {
    switch -exact -- [dict get $date era] {
	BCE {
	    set year [expr { 1 - [dict get $date year]}]
	}
	CE {
	    set year [dict get $date year]
	}
    }
    if { $year % 4 != 0 } {
	return 0
    } elseif { ![dict get $date gregorian] } {
	return 1
    } elseif { $year % 400 == 0 } {
	return 1
    } elseif { $year % 100 == 0 } {
	return 0
    } else {
	return 1
    }
}

#----------------------------------------------------------------------
#
# WeekdayOnOrBefore --
#
#	Determine the nearest day of week (given by the 'weekday' parameter,
#	Sunday==0) on or before a given Julian Day.
#
# Parameters:
#	weekday -- Day of the week
#	j -- Julian Day number
#
# Results:
#	Returns the Julian Day Number of the desired date.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc WeekdayOnOrBefore { weekday j } {
    set k [expr { ( $weekday + 6 )  % 7 }]
    return [expr { $j - ( $j - $k ) % 7 }]
}

#----------------------------------------------------------------------
#
# BSearch --
#
#	Service procedure that does binary search in several places inside the
#	'clock' command.
#
# Parameters:
#	list - List of lists, sorted in ascending order by the
#	       first elements
#	key - Value to search for
#
# Results:
#	Returns the index of the greatest element in $list that is less than
#	or equal to $key.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc BSearch { list key } {
    if {[llength $list] == 0} {
	return -1
    }
    if { $key < [lindex $list 0 0] } {
	return -1
    }

    set l 0
    set u [expr { [llength $list] - 1 }]

    while { $l < $u } {
	# At this point, we know that
	#   $k >= [lindex $list $l 0]
	#   Either $u == [llength $list] or else $k < [lindex $list $u+1 0]
	# We find the midpoint of the interval {l,u} rounded UP, compare
	# against it, and set l or u to maintain the invariant.  Note that the
	# interval shrinks at each step, guaranteeing convergence.

	set m [expr { ( $l + $u + 1 ) / 2 }]
	if { $key >= [lindex $list $m 0] } {
	    set l $m
	} else {
	    set u [expr { $m - 1 }]
	}
    }

    return $l
}

#----------------------------------------------------------------------
#
# clock add --
#
#	Adds an offset to a given time.
#
# 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
#		(Deprecated) 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 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.
#
#----------------------------------------------------------------------

proc add { clockval args } {
    if { [llength $args] % 2 != 0 } {
	set cmdName "clock add"
	return -code error \
	    -errorcode [list CLOCK wrongNumArgs] \
	    "wrong \# args: should be\
	     \"$cmdName clockval ?number units?...\
	     ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?\""
    }
    if { [catch { expr {wide($clockval)} } result] } {
	return -code error $result
    }

    set offsets {}
    set gmt 0
    set locale c
    set timezone [GetSystemTimeZone]

    foreach { a b } $args {
	if { [string is integer -strict $a] } {
	    lappend offsets $a $b
	} else {
	    switch -exact -- $a {
		-g - -gm - -gmt {
		    set saw(-gmt) {}
		    set gmt $b
		}
		-l - -lo - -loc - -loca - -local - -locale {
		    set locale [string tolower $b]
		}
		-t - -ti - -tim - -time - -timez - -timezo - -timezon -
		-timezone {
		    set saw(-timezone) {}
		    set timezone $b
		}
		default {
		    throw [list CLOCK badOption $a] \
			"bad option \"$a\":\
			 must be -gmt, -locale or -timezone"
		}
	    }
	}
    }

    # Check options for validity

    if { [info exists saw(-gmt)] && [info exists saw(-timezone)] } {
	return -code error \
	    -errorcode [list CLOCK gmtWithTimezone] \
	    "cannot use -gmt and -timezone in same call"
    }
    if { [catch { expr { wide($clockval) } } result] } {
	return -code error "expected integer but got \"$clockval\""
    }
    if { ![string is boolean -strict $gmt] } {
	return -code error "expected boolean value but got \"$gmt\""
    } elseif { $gmt } {
	set timezone :GMT
    }

    EnterLocale $locale

    set changeover [mc GREGORIAN_CHANGE_DATE]

    if {[catch {SetupTimeZone $timezone} retval opts]} {
	dict unset opts -errorinfo
	return -options $opts $retval
    }

    try {
	foreach { quantity unit } $offsets {
	    switch -exact -- $unit {
		years - year {
		    set clockval [AddMonths [expr { 12 * $quantity }] \
			    $clockval $timezone $changeover]
		}
		months - month {
		    set clockval [AddMonths $quantity $clockval $timezone \
			    $changeover]
		}

		weeks - week {
		    set clockval [AddDays [expr { 7 * $quantity }] \
			    $clockval $timezone $changeover]
		}
		days - day {
		    set clockval [AddDays $quantity $clockval $timezone \
			    $changeover]
		}

		hours - hour {
		    set clockval [expr { 3600 * $quantity + $clockval }]
		}
		minutes - minute {
		    set clockval [expr { 60 * $quantity + $clockval }]
		}
		seconds - second {
		    set clockval [expr { $quantity + $clockval }]
		}

		default {
		    throw [list CLOCK badUnit $unit] \
			"unknown unit \"$unit\", must be \
			years, months, weeks, days, hours, minutes or seconds"
		}
	    }
	}
	return $clockval
    } trap CLOCK {result opts} {
	# Conceal the innards of [clock] when it's an expected error
	dict unset opts -errorinfo
	return -options $opts $result
    }
}

#----------------------------------------------------------------------
#
# AddMonths --
#
#	Add a given number of months to a given clock value in a given
#	time zone.
#
# Parameters:
#	months - Number of months to add (may be negative)
#	clockval - Seconds since the epoch before the operation
#	timezone - Time zone in which the operation is to be performed
#
# Results:
#	Returns the new clock value as a number of seconds since
#	the epoch.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc AddMonths { months clockval timezone changeover } {
    variable DaysInRomanMonthInCommonYear
    variable DaysInRomanMonthInLeapYear
    variable TZData

    # Convert the time to year, month, day, and fraction of day.

    set date [GetDateFields $clockval $TZData($timezone) $changeover]
    dict set date secondOfDay [expr {
	[dict get $date localSeconds] % 86400
    }]
    dict set date tzName $timezone

    # Add the requisite number of months

    set m [dict get $date month]
    incr m $months
    incr m -1
    set delta [expr { $m / 12 }]
    set mm [expr { $m % 12 }]
    dict set date month [expr { $mm + 1 }]
    dict incr date year $delta

    # If the date doesn't exist in the current month, repair it

    if { [IsGregorianLeapYear $date] } {
	set hath [lindex $DaysInRomanMonthInLeapYear $mm]
    } else {
	set hath [lindex $DaysInRomanMonthInCommonYear $mm]
    }
    if { [dict get $date dayOfMonth] > $hath } {
	dict set date dayOfMonth $hath
    }

    # Reconvert to a number of seconds

    set date [GetJulianDayFromEraYearMonthDay \
		  $date[set date {}]\
		  $changeover]
    dict set date localSeconds [expr {
	-210866803200
	+ ( 86400 * wide([dict get $date julianDay]) )
	+ [dict get $date secondOfDay]
    }]
    set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) \
		 $changeover]

    return [dict get $date seconds]

}

#----------------------------------------------------------------------
#
# AddDays --
#
#	Add a given number of days to a given clock value in a given time
#	zone.
#
# Parameters:
#	days - Number of days to add (may be negative)
#	clockval - Seconds since the epoch before the operation
#	timezone - Time zone in which the operation is to be performed
#	changeover - Julian Day on which the Gregorian calendar was adopted
#		     in the target locale.
#
# Results:
#	Returns the new clock value as a number of seconds since the epoch.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc AddDays { days clockval timezone changeover } {
    variable TZData

    # Convert the time to Julian Day

    set date [GetDateFields $clockval $TZData($timezone) $changeover]
    dict set date secondOfDay [expr {
	[dict get $date localSeconds] % 86400
    }]
    dict set date tzName $timezone

    # Add the requisite number of days

    dict incr date julianDay $days

    # Reconvert to a number of seconds

    dict set date localSeconds [expr {
	-210866803200
	+ ( 86400 * wide([dict get $date julianDay]) )
	+ [dict get $date secondOfDay]
    }]
    set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) \
		  $changeover]

    return [dict get $date seconds]

}

#----------------------------------------------------------------------
#
# 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 ChangeCurrentLocale {args} {
    variable FormatProc
    variable LocaleNumeralCache
    variable CachedSystemTimeZone
    variable TimeZoneBad

    foreach p [info procs [namespace current]::scanproc'*'current] {
	rename $p {}
    }
    foreach p [info procs [namespace current]::formatproc'*'current] {
	rename $p {}
    }

    catch {array unset FormatProc *'current}
    set LocaleNumeralCache {}
}

#----------------------------------------------------------------------
#
# ClearCaches --
#
#	Clears all caches to reclaim the memory used in [clock]
#
# Parameters:
#	None.
#
# Results:
#	None.
#
# Side effects:
#	Caches are cleared.
#
#----------------------------------------------------------------------

proc ClearCaches {} {
    variable FormatProc
    variable LocaleNumeralCache
    variable CachedSystemTimeZone
    variable TimeZoneBad

    foreach p [info procs [namespace current]::scanproc'*] {
	rename $p {}
    }
    foreach p [info procs [namespace current]::formatproc'*] {
	rename $p {}
    }

    catch {unset FormatProc}
    set LocaleNumeralCache {}
    catch {unset CachedSystemTimeZone}
    set TimeZoneBad {}
    InitTZData
}
Changes to library/cookiejar/cookiejar.tcl.










1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15



16
17
18
19
20
21
22
+
+
+
+
+
+
+
+
+
+





-
-
-







# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# cookiejar.tcl --
#
#	Implementation of an HTTP cookie storage engine using SQLite. The
#	implementation is done as a TclOO class, and includes a punycode
#	encoder and decoder (though only the encoder is currently used).
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Dependencies
package require Tcl 8.6-
package require http 2.8.4
package require sqlite3
package require tcl::idna 1.0

Changes to library/cookiejar/idna.tcl.












1
2
3
4
5
6
7
8


9
10
11
12
13
14
15
16
17
18
19
20
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
+
+
+
+
+
+
+
+
+
+
+
+






-
-
+
+
-
-
-
-
-







# Copyright © 2014 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# idna.tcl --
#
#	Implementation of IDNA (Internationalized Domain Names for
#	Applications) encoding/decoding system, built on a punycode engine
#	developed directly from the code in RFC 3492, Appendix C (with
#	substantial modifications).
#
# This implementation includes code from that RFC, translated to Tcl; the

# This implementation includes code from that RFC, translated to Tcl.
# other parts are:
# Copyright © 2014 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

namespace eval ::tcl::idna {
    namespace ensemble create -command puny -map {
	encode punyencode
	decode punydecode
    }
    namespace ensemble create -command ::tcl::idna -map {
Changes to library/history.tcl.
1
2
3
4
5
6
7
8











9
10
11
12
13
14
15




1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
-
-
-
-




+
+
+
+
+
+
+
+
+
+
+







# history.tcl --
#
# Implementation of the history command.
#
# Copyright © 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.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# history.tcl --
#
# Implementation of the history command.
#

# The tcl::history array holds the history list and some additional
# bookkeeping variables.
#
# nextid	the index used for the next history list item.
# keep		the max size of the history list
Changes to library/http/http.tcl.










1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16



17
18
19
20
21
22
23
+
+
+
+
+
+
+
+
+
+






-
-
-







# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# http.tcl --
#
#	Client-side HTTP for GET, POST, and HEAD commands. These routines can
#	be used in untrusted code that uses the Safesock security policy.
#	These procedures use a callback interface to avoid using vwait, which
#	is not defined in the safe base.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl 8.6-
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
package provide http 2.10b4

namespace eval http {
1779
1780
1781
1782
1783
1784
1785
1786

1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1786
1787
1788
1789
1790
1791
1792

1793



1794
1795
1796
1797
1798
1799
1800







-
+
-
-
-







	    ##Log post socket opened, - token $token
	    ##Log socket opened, now fconfigure - token $token
	    set delay [expr {[clock milliseconds] - $pre}]
	    if {$delay > 3000} {
		Log socket delay $delay - token $token
	    }
	    fconfigure $sock -translation {auto crlf} \
			     -buffersize $state(-blocksize)
		-buffersize $state(-blocksize) -profile strict
	    if {[package vsatisfies [package provide Tcl] 9.0-]} {
		fconfigure $sock -profile replace
	    }
	    ##Log socket opened, DONE fconfigure - token $token
	}

	Log "Using $sock for $state(socketinfo) - token $token" \
	    [expr {$state(-keepalive)?"keepalive":""}]

	# Code above has set state(sock) $sock
2200
2201
2202
2203
2204
2205
2206
2207

2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2204
2205
2206
2207
2208
2209
2210

2211



2212
2213
2214
2215
2216
2217
2218







-
+
-
-
-







    set defport [lindex $urlTypes($lower) 0]

    # Send data in cr-lf format, but accept any line terminators.
    # Initialisation to {auto *} now done in geturl, KeepSocket and DoneRequest.
    # We are concerned here with the request (write) not the response (read).
    lassign [fconfigure $sock -translation] trRead trWrite
    fconfigure $sock -translation [list $trRead crlf] \
		     -buffersize $state(-blocksize)
	-buffersize $state(-blocksize) -profile strict
    if {[package vsatisfies [package provide Tcl] 9.0-]} {
	fconfigure $sock -profile replace
    }

    # The following is disallowed in safe interpreters, but the socket is
    # already in non-blocking mode in that case.

    catch {fconfigure $sock -blocking off}
    set how GET
    if {$isQuery} {
2593
2594
2595
2596
2597
2598
2599
2600

2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2594
2595
2596
2597
2598
2599
2600

2601



2602
2603
2604
2605
2606
2607
2608







-
+
-
-
-







    upvar 0 $token state
    set tk [namespace tail $token]
    set sock $state(sock)

    #Log ---- $state(socketinfo) >> conn to $token for HTTP response
    lassign [fconfigure $sock -translation] trRead trWrite
    fconfigure $sock -translation [list auto $trWrite] \
		     -buffersize $state(-blocksize)
	-buffersize $state(-blocksize) -profile strict
    if {[package vsatisfies [package provide Tcl] 9.0-]} {
	fconfigure $sock -profile replace
    }
    Log ^D$tk begin receiving response - token $token

    coroutine ${token}--EventCoroutine http::Event $sock $token
    if {[info exists state(-handler)] || [info exists state(-progress)]} {
	fileevent $sock readable [list http::EventGateway $sock $token]
    } else {
	fileevent $sock readable ${token}--EventCoroutine
4588
4589
4590
4591
4592
4593
4594
4595
4596

4597
4598

4599
4600
4601
4602
4603
4604
4605
4606
4586
4587
4588
4589
4590
4591
4592


4593


4594

4595
4596
4597
4598
4599
4600
4601







-
-
+
-
-
+
-







	    # If we are getting text, set the incoming channel's encoding
	    # correctly.  iso8859-1 is the RFC default, but this could be any
	    # IANA charset.  However, we only know how to convert what we have
	    # encodings for.

	    set enc [CharsetToEncoding $state(charset)]
	    if {$enc ne "binary"} {
		if {[package vsatisfies [package provide Tcl] 9.0-]} {
		    set state(body) [encoding convertfrom -profile replace $enc $state(body)]
		set state(body) [
		} else {
		    set state(body) [encoding convertfrom $enc $state(body)]
		    encoding convertfrom -profile strict $enc $state(body)]
		}
	    }

	    # Translate text line endings.
	    set state(body) [string map {\r\n \n \r \n} $state(body)]
	}
	if {[info exists state(-guesstype)] && $state(-guesstype)} {
	    GuessType $token
4675
4676
4677
4678
4679
4680
4681
4682
4683

4684
4685
4686
4687
4688
4689
4690
4691
4692
4693
4670
4671
4672
4673
4674
4675
4676


4677



4678
4679
4680
4681
4682
4683
4684







-
-
+
-
-
-







	    set res $value
	}
    }
    set enc [CharsetToEncoding $res]
    if {$enc eq "binary"} {
	return 0
    }
    if {[package vsatisfies [package provide Tcl] 9.0-]} {
	set state(body) [encoding convertfrom -profile replace $enc $state(body)]
    set state(body) [encoding convertfrom -profile strict $enc $state(body)]
    } else {
	set state(body) [encoding convertfrom $enc $state(body)]
    }
    set state(body) [string map {\r\n \n \r \n} $state(body)]
    set state(type) application/xml
    set state(binary) 0
    set state(charset) $res
    return 1
}

4760
4761
4762
4763
4764
4765
4766
4767
4768

4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4751
4752
4753
4754
4755
4756
4757


4758



4759
4760
4761
4762
4763
4764
4765







-
-
+
-
-
-







    variable http
    variable formMap

    # The spec says: "non-alphanumeric characters are replaced by '%HH'". Use
    # a pre-computed map and [string map] to do the conversion (much faster
    # than [regsub]/[subst]). [Bug 1020491]

    if {[package vsatisfies [package provide Tcl] 9.0-]} {
	set string [encoding convertto -profile replace $http(-urlencoding) $string]
    set string [encoding convertto -profile strict $http(-urlencoding) $string]
    } else {
	set string [encoding convertto $http(-urlencoding) $string]
    }
    return [string map $formMap $string]
}

# http::ProxyRequired --
#	Default proxy filter.
#
# Arguments:
Changes to library/init.tcl.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16













17
18
19
20
21
22
23





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
-
-
-
-
-










-
+
+
+
+
+
+
+
+
+
+
+
+
+







# init.tcl --
#
# Default system startup file for Tcl-based applications.  Defines
# "unknown" procedure and auto-load facilities.
#
# Copyright © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
# Copyright © 2004 Kevin B. Kenny.
# Copyright © 2018 Sean Woods
#
# All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# Copyright © 2004 Nathan Coulter
# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# init.tcl --
#
# Default system startup file for Tcl-based applications.  Defines
# "unknown" procedure and auto-load facilities.

package require -exact tcl 9.0b4

# Compute the auto path to use in this interpreter.
# The values on the path come from several locations:
#
# The environment variable TCLLIBPATH
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
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







+




-
-
+
+
-
-
-
-
+
+
+
+
+
+
+

+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    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

    apply {{} {
	set cmdmap [dict create]
	foreach cmd {add clicks format microseconds milliseconds scan seconds} {
	namespace export add classic clicks format microseconds \
	    milliseconds scan seconds
	    dict set cmdmap $cmd ::tcl::clock::$cmd
	}
	namespace inscope ::tcl::clock [list namespace ensemble create -command \
	    ::clock -map $cmdmap]

	namespace ensemble create -command ::clock -unknown [
	    list ::apply [list args {
		source [file join $::tcl_library clock.tcl]
		return
	    } ::tcl::clock]]

	::tcl::unsupported::clock::configure -init-complete
    } ::tcl::clock}
    }}
}


    # Set up the 'clockclassic' ensemble
    namespace eval ::tcl::clock::classic [list variable TclLibDir $::tcl_library]

    apply [list {} {
	# Auto-loading stubs for 'clockclassic.tcl'
	foreach cmd {add format scan} {
	    proc $cmd args {
		variable TclLibDir
		source [file join $TclLibDir clockclassic.tcl]
		return [uplevel 1 [info level 0]]
	    }
	}

	namespace eval [namespace parent] {
	    namespace export classic
	}
    } ::tcl::clock::classic]
}


# Conditionalize for presence of exec.

if {[namespace which -command exec] eq ""} {

    # Some machines do not have exec. Also, on all
    # platforms, safe interpreters do not have exec.
297
298
299
300
301
302
303
304

305
306
307
308
309
310
311
328
329
330
331
332
333
334

335
336
337
338
339
340
341
342







-
+







	    history change $newcmd 0
	    uplevel 1 [list ::catch $newcmd \
		    ::tcl::UnknownResult ::tcl::UnknownOptions]
	    dict incr ::tcl::UnknownOptions -level
	    return -options $::tcl::UnknownOptions $::tcl::UnknownResult
	}

	set ret [catch [list uplevel 1 [list info commands $name*]] candidates]
	set ret [catch [list uplevel 1 [list ::info commands $name*]] candidates]
	if {$name eq "::"} {
	    set name ""
	}
	if {$ret != 0} {
	    dict append opts -errorinfo \
		    "\n    (expanding command prefix \"$name\" in unknown)"
	    return -options $opts $candidates
Changes to library/install.tcl.







1
2
3
4
5
6
7
1
2
3
4
5
6
7
8
9
10
11
12
13
14
+
+
+
+
+
+
+







# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

###
# Installer actions built into tclsh and invoked
# if the first command line argument is "install"
###
if {[llength $argv] < 2} {
  exit 0
}
Changes to library/msgcat/msgcat.tcl.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# msgcat.tcl --
#
#	This file defines various procedures which implement a
#	message catalog facility for Tcl programs.  It should be
#	loaded with the command "package require msgcat".
#
# Copyright © 2010-2018 Harald Oehlmann.
# Copyright © 1998-2000 Ajuba Solutions.
# Copyright © 1998 Mark Harrison.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# msgcat.tcl --
#
#	This file defines various procedures which implement a
#	message catalog facility for Tcl programs.  It should be
#	loaded with the command "package require msgcat".

# We use oo::define::self, which is new in Tcl 8.7
package require Tcl 8.7-
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the installation directory in the Makefiles.
package provide msgcat 1.7.1

Changes to library/msgs/af.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset af DAYS_OF_WEEK_ABBREV [list \
        "So"\
        "Ma"\
        "Di"\
        "Wo"\
        "Do"\
        "Vr"\
        "Sa"]
    ::msgcat::mcset af DAYS_OF_WEEK_FULL [list \
        "Sondag"\
        "Maandag"\
        "Dinsdag"\
        "Woensdag"\
        "Donderdag"\
        "Vrydag"\
        "Saterdag"]
    ::msgcat::mcset af MONTHS_ABBREV [list \
        "Jan"\
        "Feb"\
        "Mar"\
        "Apr"\
        "Mei"\
        "Jun"\
        "Jul"\
        "Aug"\
        "Sep"\
        "Okt"\
        "Nov"\
        "Des"\
        ""]
    ::msgcat::mcset af MONTHS_FULL [list \
        "Januarie"\
        "Februarie"\
        "Maart"\
        "April"\
        "Mei"\
        "Junie"\
        "Julie"\
        "Augustus"\
        "September"\
        "Oktober"\
        "November"\
        "Desember"\
        ""]
    ::msgcat::mcset af AM "VM"
    ::msgcat::mcset af PM "NM"

::msgcat::mcset af DAYS_OF_WEEK_ABBREV [list \
	"So"\
	"Ma"\
	"Di"\
	"Wo"\
	"Do"\
	"Vr"\
	"Sa"]
::msgcat::mcset af DAYS_OF_WEEK_FULL [list \
	"Sondag"\
	"Maandag"\
	"Dinsdag"\
	"Woensdag"\
	"Donderdag"\
	"Vrydag"\
	"Saterdag"]
::msgcat::mcset af MONTHS_ABBREV [list \
	"Jan"\
	"Feb"\
	"Mar"\
	"Apr"\
	"Mei"\
	"Jun"\
	"Jul"\
	"Aug"\
	"Sep"\
	"Okt"\
	"Nov"\
	"Des"\
	""]
::msgcat::mcset af MONTHS_FULL [list \
	"Januarie"\
	"Februarie"\
	"Maart"\
	"April"\
	"Mei"\
	"Junie"\
	"Julie"\
	"Augustus"\
	"September"\
	"Oktober"\
	"November"\
	"Desember"\
	""]
::msgcat::mcset af AM "VM"
::msgcat::mcset af PM "NM"
}
Changes to library/msgs/af_za.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset af_ZA DATE_FORMAT "%d %B %Y"
    ::msgcat::mcset af_ZA TIME_FORMAT_12 "%l:%M:%S %P"
    ::msgcat::mcset af_ZA DATE_TIME_FORMAT "%d %B %Y %l:%M:%S %P %z"

::msgcat::mcset af_ZA DATE_FORMAT "%d %B %Y"
::msgcat::mcset af_ZA TIME_FORMAT_12 "%l:%M:%S %P"
::msgcat::mcset af_ZA DATE_TIME_FORMAT "%d %B %Y %l:%M:%S %P %z"
}
Changes to library/msgs/ar.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ar DAYS_OF_WEEK_ABBREV [list \
        "ح"\
        "ن"\
        "ث"\
        "ر"\
        "خ"\
        "ج"\
        "س"]
    ::msgcat::mcset ar DAYS_OF_WEEK_FULL [list \
        "الأحد"\
        "الاثنين"\
        "الثلاثاء"\
        "الأربعاء"\
        "الخميس"\
        "الجمعة"\
        "السبت"]
    ::msgcat::mcset ar MONTHS_ABBREV [list \
        "ينا"\
        "فبر"\
        "مار"\
        "أبر"\
        "ماي"\
        "يون"\
        "يول"\
        "أغس"\
        "سبت"\
        "أكت"\
        "نوف"\
        "ديس"\
        ""]
    ::msgcat::mcset ar MONTHS_FULL [list \
        "يناير"\
        "فبراير"\
        "مارس"\
        "أبريل"\
        "مايو"\
        "يونيو"\
        "يوليو"\
        "أغسطس"\
        "سبتمبر"\
        "أكتوبر"\
        "نوفمبر"\
        "ديسمبر"\
        ""]
    ::msgcat::mcset ar BCE "ق.م"
    ::msgcat::mcset ar CE "م"
    ::msgcat::mcset ar AM "ص"
    ::msgcat::mcset ar PM "م"
    ::msgcat::mcset ar DATE_FORMAT "%d/%m/%Y"
    ::msgcat::mcset ar TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset ar DATE_TIME_FORMAT "%d/%m/%Y %I:%M:%S %P %z"

::msgcat::mcset ar DAYS_OF_WEEK_ABBREV [list \
	"ح"\
	"ن"\
	"ث"\
	"ر"\
	"خ"\
	"ج"\
	"س"]
::msgcat::mcset ar DAYS_OF_WEEK_FULL [list \
	"الأحد"\
	"الاثنين"\
	"الثلاثاء"\
	"الأربعاء"\
	"الخميس"\
	"الجمعة"\
	"السبت"]
::msgcat::mcset ar MONTHS_ABBREV [list \
	"ينا"\
	"فبر"\
	"مار"\
	"أبر"\
	"ماي"\
	"يون"\
	"يول"\
	"أغس"\
	"سبت"\
	"أكت"\
	"نوف"\
	"ديس"\
	""]
::msgcat::mcset ar MONTHS_FULL [list \
	"يناير"\
	"فبراير"\
	"مارس"\
	"أبريل"\
	"مايو"\
	"يونيو"\
	"يوليو"\
	"أغسطس"\
	"سبتمبر"\
	"أكتوبر"\
	"نوفمبر"\
	"ديسمبر"\
	""]
::msgcat::mcset ar BCE "ق.م"
::msgcat::mcset ar CE "م"
::msgcat::mcset ar AM "ص"
::msgcat::mcset ar PM "م"
::msgcat::mcset ar DATE_FORMAT "%d/%m/%Y"
::msgcat::mcset ar TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset ar DATE_TIME_FORMAT "%d/%m/%Y %I:%M:%S %P %z"
}
Changes to library/msgs/ar_in.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ar_IN DATE_FORMAT "%A %d %B %Y"
    ::msgcat::mcset ar_IN TIME_FORMAT_12 "%I:%M:%S  %z"
    ::msgcat::mcset ar_IN DATE_TIME_FORMAT "%A %d %B %Y %I:%M:%S  %z %z"

::msgcat::mcset ar_IN DATE_FORMAT "%A %d %B %Y"
::msgcat::mcset ar_IN TIME_FORMAT_12 "%I:%M:%S  %z"
::msgcat::mcset ar_IN DATE_TIME_FORMAT "%A %d %B %Y %I:%M:%S  %z %z"
}
Changes to library/msgs/ar_jo.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ar_JO DAYS_OF_WEEK_ABBREV [list \
        "الأحد"\
        "الاثنين"\
        "الثلاثاء"\
        "الأربعاء"\
        "الخميس"\
        "الجمعة"\
        "السبت"]
    ::msgcat::mcset ar_JO MONTHS_ABBREV [list \
        "كانون الثاني"\
        "شباط"\
        "آذار"\
        "نيسان"\
        "نوار"\
        "حزيران"\
        "تموز"\
        "آب"\
        "أيلول"\
        "تشرين الأول"\
        "تشرين الثاني"\
        "كانون الأول"\
        ""]
    ::msgcat::mcset ar_JO MONTHS_FULL [list \
        "كانون الثاني"\
        "شباط"\
        "آذار"\
        "نيسان"\
        "نوار"\
        "حزيران"\
        "تموز"\
        "آب"\
        "أيلول"\
        "تشرين الأول"\
        "تشرين الثاني"\
        "كانون الأول"\
        ""]

::msgcat::mcset ar_JO DAYS_OF_WEEK_ABBREV [list \
	"الأحد"\
	"الاثنين"\
	"الثلاثاء"\
	"الأربعاء"\
	"الخميس"\
	"الجمعة"\
	"السبت"]
::msgcat::mcset ar_JO MONTHS_ABBREV [list \
	"كانون الثاني"\
	"شباط"\
	"آذار"\
	"نيسان"\
	"نوار"\
	"حزيران"\
	"تموز"\
	"آب"\
	"أيلول"\
	"تشرين الأول"\
	"تشرين الثاني"\
	"كانون الأول"\
	""]
::msgcat::mcset ar_JO MONTHS_FULL [list \
	"كانون الثاني"\
	"شباط"\
	"آذار"\
	"نيسان"\
	"نوار"\
	"حزيران"\
	"تموز"\
	"آب"\
	"أيلول"\
	"تشرين الأول"\
	"تشرين الثاني"\
	"كانون الأول"\
	""]
}
Changes to library/msgs/ar_lb.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ar_LB DAYS_OF_WEEK_ABBREV [list \
        "الأحد"\
        "الاثنين"\
        "الثلاثاء"\
        "الأربعاء"\
        "الخميس"\
        "الجمعة"\
        "السبت"]
    ::msgcat::mcset ar_LB MONTHS_ABBREV [list \
        "كانون الثاني"\
        "شباط"\
        "آذار"\
        "نيسان"\
        "نوار"\
        "حزيران"\
        "تموز"\
        "آب"\
        "أيلول"\
        "تشرين الأول"\
        "تشرين الثاني"\
        "كانون الأول"\
        ""]
    ::msgcat::mcset ar_LB MONTHS_FULL [list \
        "كانون الثاني"\
        "شباط"\
        "آذار"\
        "نيسان"\
        "نوار"\
        "حزيران"\
        "تموز"\
        "آب"\
        "أيلول"\
        "تشرين الأول"\
        "تشرين الثاني"\
        "كانون الأول"\
        ""]

::msgcat::mcset ar_LB DAYS_OF_WEEK_ABBREV [list \
	"الأحد"\
	"الاثنين"\
	"الثلاثاء"\
	"الأربعاء"\
	"الخميس"\
	"الجمعة"\
	"السبت"]
::msgcat::mcset ar_LB MONTHS_ABBREV [list \
	"كانون الثاني"\
	"شباط"\
	"آذار"\
	"نيسان"\
	"نوار"\
	"حزيران"\
	"تموز"\
	"آب"\
	"أيلول"\
	"تشرين الأول"\
	"تشرين الثاني"\
	"كانون الأول"\
	""]
::msgcat::mcset ar_LB MONTHS_FULL [list \
	"كانون الثاني"\
	"شباط"\
	"آذار"\
	"نيسان"\
	"نوار"\
	"حزيران"\
	"تموز"\
	"آب"\
	"أيلول"\
	"تشرين الأول"\
	"تشرين الثاني"\
	"كانون الأول"\
	""]
}
Changes to library/msgs/ar_sy.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ar_SY DAYS_OF_WEEK_ABBREV [list \
        "الأحد"\
        "الاثنين"\
        "الثلاثاء"\
        "الأربعاء"\
        "الخميس"\
        "الجمعة"\
        "السبت"]
    ::msgcat::mcset ar_SY MONTHS_ABBREV [list \
        "كانون الثاني"\
        "شباط"\
        "آذار"\
        "نيسان"\
        "نوار"\
        "حزيران"\
        "تموز"\
        "آب"\
        "أيلول"\
        "تشرين الأول"\
        "تشرين الثاني"\
        "كانون الأول"\
        ""]
    ::msgcat::mcset ar_SY MONTHS_FULL [list \
        "كانون الثاني"\
        "شباط"\
        "آذار"\
        "نيسان"\
        "نواران"\
        "حزير"\
        "تموز"\
        "آب"\
        "أيلول"\
        "تشرين الأول"\
        "تشرين الثاني"\
        "كانون الأول"\
        ""]

::msgcat::mcset ar_SY DAYS_OF_WEEK_ABBREV [list \
	"الأحد"\
	"الاثنين"\
	"الثلاثاء"\
	"الأربعاء"\
	"الخميس"\
	"الجمعة"\
	"السبت"]
::msgcat::mcset ar_SY MONTHS_ABBREV [list \
	"كانون الثاني"\
	"شباط"\
	"آذار"\
	"نيسان"\
	"نوار"\
	"حزيران"\
	"تموز"\
	"آب"\
	"أيلول"\
	"تشرين الأول"\
	"تشرين الثاني"\
	"كانون الأول"\
	""]
::msgcat::mcset ar_SY MONTHS_FULL [list \
	"كانون الثاني"\
	"شباط"\
	"آذار"\
	"نيسان"\
	"نواران"\
	"حزير"\
	"تموز"\
	"آب"\
	"أيلول"\
	"تشرين الأول"\
	"تشرين الثاني"\
	"كانون الأول"\
	""]
}
Changes to library/msgs/be.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset be DAYS_OF_WEEK_ABBREV [list \
        "нд"\
        "пн"\
        "ат"\
        "ср"\
        "чц"\
        "пт"\
        "сб"]
    ::msgcat::mcset be DAYS_OF_WEEK_FULL [list \
        "нядзеля"\
        "панядзелак"\
        "аўторак"\
        "серада"\
        "чацвер"\
        "пятніца"\
        "субота"]
    ::msgcat::mcset be MONTHS_ABBREV [list \
        "стд"\
        "лют"\
        "скв"\
        "крс"\
        "май"\
        "чрв"\
        "лпн"\
        "жнв"\
        "врс"\
        "кст"\
        "лст"\
        "снж"\
        ""]
    ::msgcat::mcset be MONTHS_FULL [list \
        "студзеня"\
        "лютага"\
        "сакавіка"\
        "красавіка"\
        "мая"\
        "чрвеня"\
        "ліпеня"\
        "жніўня"\
        "верасня"\
        "кастрычніка"\
        "листапада"\
        "снежня"\
        ""]
    ::msgcat::mcset be BCE "да н.е."
    ::msgcat::mcset be CE "н.е."
    ::msgcat::mcset be DATE_FORMAT "%e.%m.%Y"
    ::msgcat::mcset be TIME_FORMAT "%k.%M.%S"
    ::msgcat::mcset be DATE_TIME_FORMAT "%e.%m.%Y %k.%M.%S %z"

::msgcat::mcset be DAYS_OF_WEEK_ABBREV [list \
	"нд"\
	"пн"\
	"ат"\
	"ср"\
	"чц"\
	"пт"\
	"сб"]
::msgcat::mcset be DAYS_OF_WEEK_FULL [list \
	"нядзеля"\
	"панядзелак"\
	"аўторак"\
	"серада"\
	"чацвер"\
	"пятніца"\
	"субота"]
::msgcat::mcset be MONTHS_ABBREV [list \
	"стд"\
	"лют"\
	"скв"\
	"крс"\
	"май"\
	"чрв"\
	"лпн"\
	"жнв"\
	"врс"\
	"кст"\
	"лст"\
	"снж"\
	""]
::msgcat::mcset be MONTHS_FULL [list \
	"студзеня"\
	"лютага"\
	"сакавіка"\
	"красавіка"\
	"мая"\
	"чрвеня"\
	"ліпеня"\
	"жніўня"\
	"верасня"\
	"кастрычніка"\
	"листапада"\
	"снежня"\
	""]
::msgcat::mcset be BCE "да н.е."
::msgcat::mcset be CE "н.е."
::msgcat::mcset be DATE_FORMAT "%e.%m.%Y"
::msgcat::mcset be TIME_FORMAT "%k.%M.%S"
::msgcat::mcset be DATE_TIME_FORMAT "%e.%m.%Y %k.%M.%S %z"
}
Changes to library/msgs/bg.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset bg DAYS_OF_WEEK_ABBREV [list \
        "Нд"\
        "Пн"\
        "Вт"\
        "Ср"\
        "Чт"\
        "Пт"\
        "Сб"]
    ::msgcat::mcset bg DAYS_OF_WEEK_FULL [list \
        "Неделя"\
        "Понеделник"\
        "Вторник"\
        "Сряда"\
        "Четвъртък"\
        "Петък"\
        "Събота"]
    ::msgcat::mcset bg MONTHS_ABBREV [list \
        "I"\
        "II"\
        "III"\
        "IV"\
        "V"\
        "VI"\
        "VII"\
        "VIII"\
        "IX"\
        "X"\
        "XI"\
        "XII"\
        ""]
    ::msgcat::mcset bg MONTHS_FULL [list \
        "Януари"\
        "Февруари"\
        "Март"\
        "Април"\
        "Май"\
        "Юни"\
        "Юли"\
        "Август"\
        "Септември"\
        "Октомври"\
        "Ноември"\
        "Декември"\
        ""]
    ::msgcat::mcset bg BCE "пр.н.е."
    ::msgcat::mcset bg CE "н.е."
    ::msgcat::mcset bg DATE_FORMAT "%Y-%m-%e"
    ::msgcat::mcset bg TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset bg DATE_TIME_FORMAT "%Y-%m-%e %k:%M:%S %z"

::msgcat::mcset bg DAYS_OF_WEEK_ABBREV [list \
	"Нд"\
	"Пн"\
	"Вт"\
	"Ср"\
	"Чт"\
	"Пт"\
	"Сб"]
::msgcat::mcset bg DAYS_OF_WEEK_FULL [list \
	"Неделя"\
	"Понеделник"\
	"Вторник"\
	"Сряда"\
	"Четвъртък"\
	"Петък"\
	"Събота"]
::msgcat::mcset bg MONTHS_ABBREV [list \
	"I"\
	"II"\
	"III"\
	"IV"\
	"V"\
	"VI"\
	"VII"\
	"VIII"\
	"IX"\
	"X"\
	"XI"\
	"XII"\
	""]
::msgcat::mcset bg MONTHS_FULL [list \
	"Януари"\
	"Февруари"\
	"Март"\
	"Април"\
	"Май"\
	"Юни"\
	"Юли"\
	"Август"\
	"Септември"\
	"Октомври"\
	"Ноември"\
	"Декември"\
	""]
::msgcat::mcset bg BCE "пр.н.е."
::msgcat::mcset bg CE "н.е."
::msgcat::mcset bg DATE_FORMAT "%Y-%m-%e"
::msgcat::mcset bg TIME_FORMAT "%k:%M:%S"
::msgcat::mcset bg DATE_TIME_FORMAT "%Y-%m-%e %k:%M:%S %z"
}
Changes to library/msgs/bn.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset bn DAYS_OF_WEEK_ABBREV [list \
        "রবি"\
        "সোম"\
        "মঙগল"\
        "বুধ"\
        "বৃহস্পতি"\
        "শুক্র"\
        "শনি"]
    ::msgcat::mcset bn DAYS_OF_WEEK_FULL [list \
        "রবিবার"\
        "সোমবার"\
        "মঙগলবার"\
        "বুধবার"\
        "বৃহস্পতিবার"\
        "শুক্রবার"\
        "শনিবার"]
    ::msgcat::mcset bn MONTHS_ABBREV [list \
        "জানুয়ারী"\
        "ফেব্রুয়ারী"\
        "মার্চ"\
        "এপ্রিল"\
        "মে"\
        "জুন"\
        "জুলাই"\
        "আগস্ট"\
        "সেপ্টেম্বর"\
        "অক্টোবর"\
        "নভেম্বর"\
        "ডিসেম্বর"\
        ""]
    ::msgcat::mcset bn MONTHS_FULL [list \
        "জানুয়ারী"\
        "ফেব্রুয়ারী"\
        "মার্চ"\
        "এপ্রিল"\
        "মে"\
        "জুন"\
        "জুলাই"\
        "আগস্ট"\
        "সেপ্টেম্বর"\
        "অক্টোবর"\
        "নভেম্বর"\
        "ডিসেম্বর"\
        ""]
    ::msgcat::mcset bn AM "পূর্বাহ্ণ"
    ::msgcat::mcset bn PM "অপরাহ্ণ"

::msgcat::mcset bn DAYS_OF_WEEK_ABBREV [list \
	"রবি"\
	"সোম"\
	"মঙগল"\
	"বুধ"\
	"বৃহস্পতি"\
	"শুক্র"\
	"শনি"]
::msgcat::mcset bn DAYS_OF_WEEK_FULL [list \
	"রবিবার"\
	"সোমবার"\
	"মঙগলবার"\
	"বুধবার"\
	"বৃহস্পতিবার"\
	"শুক্রবার"\
	"শনিবার"]
::msgcat::mcset bn MONTHS_ABBREV [list \
	"জানুয়ারী"\
	"ফেব্রুয়ারী"\
	"মার্চ"\
	"এপ্রিল"\
	"মে"\
	"জুন"\
	"জুলাই"\
	"আগস্ট"\
	"সেপ্টেম্বর"\
	"অক্টোবর"\
	"নভেম্বর"\
	"ডিসেম্বর"\
	""]
::msgcat::mcset bn MONTHS_FULL [list \
	"জানুয়ারী"\
	"ফেব্রুয়ারী"\
	"মার্চ"\
	"এপ্রিল"\
	"মে"\
	"জুন"\
	"জুলাই"\
	"আগস্ট"\
	"সেপ্টেম্বর"\
	"অক্টোবর"\
	"নভেম্বর"\
	"ডিসেম্বর"\
	""]
::msgcat::mcset bn AM "পূর্বাহ্ণ"
::msgcat::mcset bn PM "অপরাহ্ণ"
}
Changes to library/msgs/bn_in.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset bn_IN DATE_FORMAT "%A %d %b %Y"
    ::msgcat::mcset bn_IN TIME_FORMAT_12 "%I:%M:%S  %z"
    ::msgcat::mcset bn_IN DATE_TIME_FORMAT "%A %d %b %Y %I:%M:%S  %z %z"

::msgcat::mcset bn_IN DATE_FORMAT "%A %d %b %Y"
::msgcat::mcset bn_IN TIME_FORMAT_12 "%I:%M:%S  %z"
::msgcat::mcset bn_IN DATE_TIME_FORMAT "%A %d %b %Y %I:%M:%S  %z %z"
}
Changes to library/msgs/ca.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ca DAYS_OF_WEEK_ABBREV [list \
        "dg."\
        "dl."\
        "dt."\
        "dc."\
        "dj."\
        "dv."\
        "ds."]
    ::msgcat::mcset ca DAYS_OF_WEEK_FULL [list \
        "diumenge"\
        "dilluns"\
        "dimarts"\
        "dimecres"\
        "dijous"\
        "divendres"\
        "dissabte"]
    ::msgcat::mcset ca MONTHS_ABBREV [list \
        "gen."\
        "feb."\
        "març"\
        "abr."\
        "maig"\
        "juny"\
        "jul."\
        "ag."\
        "set."\
        "oct."\
        "nov."\
        "des."\
        ""]
    ::msgcat::mcset ca MONTHS_FULL [list \
        "gener"\
        "febrer"\
        "març"\
        "abril"\
        "maig"\
        "juny"\
        "juliol"\
        "agost"\
        "setembre"\
        "octubre"\
        "novembre"\
        "desembre"\
        ""]
    ::msgcat::mcset ca DATE_FORMAT "%d/%m/%Y"
    ::msgcat::mcset ca TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset ca DATE_TIME_FORMAT "%d/%m/%Y %H:%M:%S %z"

::msgcat::mcset ca DAYS_OF_WEEK_ABBREV [list \
	"dg."\
	"dl."\
	"dt."\
	"dc."\
	"dj."\
	"dv."\
	"ds."]
::msgcat::mcset ca DAYS_OF_WEEK_FULL [list \
	"diumenge"\
	"dilluns"\
	"dimarts"\
	"dimecres"\
	"dijous"\
	"divendres"\
	"dissabte"]
::msgcat::mcset ca MONTHS_ABBREV [list \
	"gen."\
	"feb."\
	"març"\
	"abr."\
	"maig"\
	"juny"\
	"jul."\
	"ag."\
	"set."\
	"oct."\
	"nov."\
	"des."\
	""]
::msgcat::mcset ca MONTHS_FULL [list \
	"gener"\
	"febrer"\
	"març"\
	"abril"\
	"maig"\
	"juny"\
	"juliol"\
	"agost"\
	"setembre"\
	"octubre"\
	"novembre"\
	"desembre"\
	""]
::msgcat::mcset ca DATE_FORMAT "%d/%m/%Y"
::msgcat::mcset ca TIME_FORMAT "%H:%M:%S"
::msgcat::mcset ca DATE_TIME_FORMAT "%d/%m/%Y %H:%M:%S %z"
}
Changes to library/msgs/cs.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset cs DAYS_OF_WEEK_ABBREV [list \
        "Ne"\
        "Po"\
        "Út"\
        "St"\
        "Čt"\
        "Pá"\
        "So"]
    ::msgcat::mcset cs DAYS_OF_WEEK_FULL [list \
        "Neděle"\
        "Pondělí"\
        "Úterý"\
        "Středa"\
        "Čtvrtek"\
        "Pátek"\
        "Sobota"]
    ::msgcat::mcset cs MONTHS_ABBREV [list \
        "I"\
        "II"\
        "III"\
        "IV"\
        "V"\
        "VI"\
        "VII"\
        "VIII"\
        "IX"\
        "X"\
        "XI"\
        "XII"\
        ""]
    ::msgcat::mcset cs MONTHS_FULL [list \
        "leden"\
        "únor"\
        "březen"\
        "duben"\
        "květen"\
        "červen"\
        "červenec"\
        "srpen"\
        "září"\
        "říjen"\
        "listopad"\
        "prosinec"\
        ""]
    ::msgcat::mcset cs BCE "př.Kr."
    ::msgcat::mcset cs CE "po Kr."
    ::msgcat::mcset cs AM "dop."
    ::msgcat::mcset cs PM "odp."
    ::msgcat::mcset cs DATE_FORMAT "%e.%m.%Y"
    ::msgcat::mcset cs TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset cs DATE_TIME_FORMAT "%e.%m.%Y %k:%M:%S %z"

::msgcat::mcset cs DAYS_OF_WEEK_ABBREV [list \
	"Ne"\
	"Po"\
	"Út"\
	"St"\
	"Čt"\
	"Pá"\
	"So"]
::msgcat::mcset cs DAYS_OF_WEEK_FULL [list \
	"Neděle"\
	"Pondělí"\
	"Úterý"\
	"Středa"\
	"Čtvrtek"\
	"Pátek"\
	"Sobota"]
::msgcat::mcset cs MONTHS_ABBREV [list \
	"I"\
	"II"\
	"III"\
	"IV"\
	"V"\
	"VI"\
	"VII"\
	"VIII"\
	"IX"\
	"X"\
	"XI"\
	"XII"\
	""]
::msgcat::mcset cs MONTHS_FULL [list \
	"leden"\
	"únor"\
	"březen"\
	"duben"\
	"květen"\
	"červen"\
	"červenec"\
	"srpen"\
	"září"\
	"říjen"\
	"listopad"\
	"prosinec"\
	""]
::msgcat::mcset cs BCE "př.Kr."
::msgcat::mcset cs CE "po Kr."
::msgcat::mcset cs AM "dop."
::msgcat::mcset cs PM "odp."
::msgcat::mcset cs DATE_FORMAT "%e.%m.%Y"
::msgcat::mcset cs TIME_FORMAT "%k:%M:%S"
::msgcat::mcset cs DATE_TIME_FORMAT "%e.%m.%Y %k:%M:%S %z"
}
Changes to library/msgs/da.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset da DAYS_OF_WEEK_ABBREV [list \
        "sø"\
        "ma"\
        "ti"\
        "on"\
        "to"\
        "fr"\
        "lø"]
    ::msgcat::mcset da DAYS_OF_WEEK_FULL [list \
        "søndag"\
        "mandag"\
        "tirsdag"\
        "onsdag"\
        "torsdag"\
        "fredag"\
        "lørdag"]
    ::msgcat::mcset da MONTHS_ABBREV [list \
        "jan"\
        "feb"\
        "mar"\
        "apr"\
        "maj"\
        "jun"\
        "jul"\
        "aug"\
        "sep"\
        "okt"\
        "nov"\
        "dec"\
        ""]
    ::msgcat::mcset da MONTHS_FULL [list \
        "januar"\
        "februar"\
        "marts"\
        "april"\
        "maj"\
        "juni"\
        "juli"\
        "august"\
        "september"\
        "oktober"\
        "november"\
        "december"\
        ""]
    ::msgcat::mcset da BCE "f.Kr."
    ::msgcat::mcset da CE "e.Kr."
    ::msgcat::mcset da DATE_FORMAT "%d-%m-%Y"
    ::msgcat::mcset da TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset da DATE_TIME_FORMAT "%d-%m-%Y %H:%M:%S %z"

::msgcat::mcset da DAYS_OF_WEEK_ABBREV [list \
	"sø"\
	"ma"\
	"ti"\
	"on"\
	"to"\
	"fr"\
	"lø"]
::msgcat::mcset da DAYS_OF_WEEK_FULL [list \
	"søndag"\
	"mandag"\
	"tirsdag"\
	"onsdag"\
	"torsdag"\
	"fredag"\
	"lørdag"]
::msgcat::mcset da MONTHS_ABBREV [list \
	"jan"\
	"feb"\
	"mar"\
	"apr"\
	"maj"\
	"jun"\
	"jul"\
	"aug"\
	"sep"\
	"okt"\
	"nov"\
	"dec"\
	""]
::msgcat::mcset da MONTHS_FULL [list \
	"januar"\
	"februar"\
	"marts"\
	"april"\
	"maj"\
	"juni"\
	"juli"\
	"august"\
	"september"\
	"oktober"\
	"november"\
	"december"\
	""]
::msgcat::mcset da BCE "f.Kr."
::msgcat::mcset da CE "e.Kr."
::msgcat::mcset da DATE_FORMAT "%d-%m-%Y"
::msgcat::mcset da TIME_FORMAT "%H:%M:%S"
::msgcat::mcset da DATE_TIME_FORMAT "%d-%m-%Y %H:%M:%S %z"
}
Changes to library/msgs/de.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset de DAYS_OF_WEEK_ABBREV [list \
        "So"\
        "Mo"\
        "Di"\
        "Mi"\
        "Do"\
        "Fr"\
        "Sa"]
    ::msgcat::mcset de DAYS_OF_WEEK_FULL [list \
        "Sonntag"\
        "Montag"\
        "Dienstag"\
        "Mittwoch"\
        "Donnerstag"\
        "Freitag"\
        "Samstag"]
    ::msgcat::mcset de MONTHS_ABBREV [list \
        "Jan"\
        "Feb"\
        "Mrz"\
        "Apr"\
        "Mai"\
        "Jun"\
        "Jul"\
        "Aug"\
        "Sep"\
        "Okt"\
        "Nov"\
        "Dez"\
        ""]
    ::msgcat::mcset de MONTHS_FULL [list \
        "Januar"\
        "Februar"\
        "März"\
        "April"\
        "Mai"\
        "Juni"\
        "Juli"\
        "August"\
        "September"\
        "Oktober"\
        "November"\
        "Dezember"\
        ""]
    ::msgcat::mcset de BCE "v. Chr."
    ::msgcat::mcset de CE "n. Chr."
    ::msgcat::mcset de AM "vorm."
    ::msgcat::mcset de PM "nachm."
    ::msgcat::mcset de DATE_FORMAT "%d.%m.%Y"
    ::msgcat::mcset de TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset de DATE_TIME_FORMAT "%d.%m.%Y %H:%M:%S %z"

::msgcat::mcset de DAYS_OF_WEEK_ABBREV [list \
	"So"\
	"Mo"\
	"Di"\
	"Mi"\
	"Do"\
	"Fr"\
	"Sa"]
::msgcat::mcset de DAYS_OF_WEEK_FULL [list \
	"Sonntag"\
	"Montag"\
	"Dienstag"\
	"Mittwoch"\
	"Donnerstag"\
	"Freitag"\
	"Samstag"]
::msgcat::mcset de MONTHS_ABBREV [list \
	"Jan"\
	"Feb"\
	"Mrz"\
	"Apr"\
	"Mai"\
	"Jun"\
	"Jul"\
	"Aug"\
	"Sep"\
	"Okt"\
	"Nov"\
	"Dez"\
	""]
::msgcat::mcset de MONTHS_FULL [list \
	"Januar"\
	"Februar"\
	"März"\
	"April"\
	"Mai"\
	"Juni"\
	"Juli"\
	"August"\
	"September"\
	"Oktober"\
	"November"\
	"Dezember"\
	""]
::msgcat::mcset de BCE "v. Chr."
::msgcat::mcset de CE "n. Chr."
::msgcat::mcset de AM "vorm."
::msgcat::mcset de PM "nachm."
::msgcat::mcset de DATE_FORMAT "%d.%m.%Y"
::msgcat::mcset de TIME_FORMAT "%H:%M:%S"
::msgcat::mcset de DATE_TIME_FORMAT "%d.%m.%Y %H:%M:%S %z"
}
Changes to library/msgs/de_at.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset de_AT MONTHS_ABBREV [list \
        "Jän"\
        "Feb"\
        "Mär"\
        "Apr"\
        "Mai"\
        "Jun"\
        "Jul"\
        "Aug"\
        "Sep"\
        "Okt"\
        "Nov"\
        "Dez"\
        ""]
    ::msgcat::mcset de_AT MONTHS_FULL [list \
        "Jänner"\
        "Februar"\
        "März"\
        "April"\
        "Mai"\
        "Juni"\
        "Juli"\
        "August"\
        "September"\
        "Oktober"\
        "November"\
        "Dezember"\
        ""]
    ::msgcat::mcset de_AT DATE_FORMAT "%Y-%m-%d"
    ::msgcat::mcset de_AT TIME_FORMAT "%T"
    ::msgcat::mcset de_AT TIME_FORMAT_12 "%T"
    ::msgcat::mcset de_AT DATE_TIME_FORMAT "%a %d %b %Y %T %z"

::msgcat::mcset de_AT MONTHS_ABBREV [list \
	"Jän"\
	"Feb"\
	"Mär"\
	"Apr"\
	"Mai"\
	"Jun"\
	"Jul"\
	"Aug"\
	"Sep"\
	"Okt"\
	"Nov"\
	"Dez"\
	""]
::msgcat::mcset de_AT MONTHS_FULL [list \
	"Jänner"\
	"Februar"\
	"März"\
	"April"\
	"Mai"\
	"Juni"\
	"Juli"\
	"August"\
	"September"\
	"Oktober"\
	"November"\
	"Dezember"\
	""]
::msgcat::mcset de_AT DATE_FORMAT "%Y-%m-%d"
::msgcat::mcset de_AT TIME_FORMAT "%T"
::msgcat::mcset de_AT TIME_FORMAT_12 "%T"
::msgcat::mcset de_AT DATE_TIME_FORMAT "%a %d %b %Y %T %z"
}
Changes to library/msgs/de_be.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset de_BE DAYS_OF_WEEK_ABBREV [list \
        "Son"\
        "Mon"\
        "Die"\
        "Mit"\
        "Don"\
        "Fre"\
        "Sam"]
    ::msgcat::mcset de_BE DAYS_OF_WEEK_FULL [list \
        "Sonntag"\
        "Montag"\
        "Dienstag"\
        "Mittwoch"\
        "Donnerstag"\
        "Freitag"\
        "Samstag"]
    ::msgcat::mcset de_BE MONTHS_ABBREV [list \
        "Jan"\
        "Feb"\
        "Mär"\
        "Apr"\
        "Mai"\
        "Jun"\
        "Jul"\
        "Aug"\
        "Sep"\
        "Okt"\
        "Nov"\
        "Dez"\
        ""]
    ::msgcat::mcset de_BE MONTHS_FULL [list \
        "Januar"\
        "Februar"\
        "März"\
        "April"\
        "Mai"\
        "Juni"\
        "Juli"\
        "August"\
        "September"\
        "Oktober"\
        "November"\
        "Dezember"\
        ""]
    ::msgcat::mcset de_BE AM "vorm"
    ::msgcat::mcset de_BE PM "nachm"
    ::msgcat::mcset de_BE DATE_FORMAT "%Y-%m-%d"
    ::msgcat::mcset de_BE TIME_FORMAT "%T"
    ::msgcat::mcset de_BE TIME_FORMAT_12 "%T"
    ::msgcat::mcset de_BE DATE_TIME_FORMAT "%a %d %b %Y %T %z"

::msgcat::mcset de_BE DAYS_OF_WEEK_ABBREV [list \
	"Son"\
	"Mon"\
	"Die"\
	"Mit"\
	"Don"\
	"Fre"\
	"Sam"]
::msgcat::mcset de_BE DAYS_OF_WEEK_FULL [list \
	"Sonntag"\
	"Montag"\
	"Dienstag"\
	"Mittwoch"\
	"Donnerstag"\
	"Freitag"\
	"Samstag"]
::msgcat::mcset de_BE MONTHS_ABBREV [list \
	"Jan"\
	"Feb"\
	"Mär"\
	"Apr"\
	"Mai"\
	"Jun"\
	"Jul"\
	"Aug"\
	"Sep"\
	"Okt"\
	"Nov"\
	"Dez"\
	""]
::msgcat::mcset de_BE MONTHS_FULL [list \
	"Januar"\
	"Februar"\
	"März"\
	"April"\
	"Mai"\
	"Juni"\
	"Juli"\
	"August"\
	"September"\
	"Oktober"\
	"November"\
	"Dezember"\
	""]
::msgcat::mcset de_BE AM "vorm"
::msgcat::mcset de_BE PM "nachm"
::msgcat::mcset de_BE DATE_FORMAT "%Y-%m-%d"
::msgcat::mcset de_BE TIME_FORMAT "%T"
::msgcat::mcset de_BE TIME_FORMAT_12 "%T"
::msgcat::mcset de_BE DATE_TIME_FORMAT "%a %d %b %Y %T %z"
}
Changes to library/msgs/el.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset el DAYS_OF_WEEK_ABBREV [list \
        "Κυρ"\
        "Δευ"\
        "Τρι"\
        "Τετ"\
        "Πεμ"\
        "Παρ"\
        "Σαβ"]
    ::msgcat::mcset el DAYS_OF_WEEK_FULL [list \
        "Κυριακή"\
        "Δευτέρα"\
        "Τρίτη"\
        "Τετάρτη"\
        "Πέμπτη"\
        "Παρασκευή"\
        "Σάββατο"]
    ::msgcat::mcset el MONTHS_ABBREV [list \
        "Ιαν"\
        "Φεβ"\
        "Μαρ"\
        "Απρ"\
        "Μαϊ"\
        "Ιουν"\
        "Ιουλ"\
        "Αυγ"\
        "Σεπ"\
        "Οκτ"\
        "Νοε"\
        "Δεκ"\
        ""]
    ::msgcat::mcset el MONTHS_FULL [list \
        "Ιανουάριος"\
        "Φεβρουάριος"\
        "Μάρτιος"\
        "Απρίλιος"\
        "Μάϊος"\
        "Ιούνιος"\
        "Ιούλιος"\
        "Αύγουστος"\
        "Σεπτέμβριος"\
        "Οκτώβριος"\
        "Νοέμβριος"\
        "Δεκέμβριος"\
        ""]
    ::msgcat::mcset el AM "πμ"
    ::msgcat::mcset el PM "μμ"
    ::msgcat::mcset el DATE_FORMAT "%e/%m/%Y"
    ::msgcat::mcset el TIME_FORMAT_12 "%l:%M:%S %P"
    ::msgcat::mcset el DATE_TIME_FORMAT "%e/%m/%Y %l:%M:%S %P %z"

::msgcat::mcset el DAYS_OF_WEEK_ABBREV [list \
	"Κυρ"\
	"Δευ"\
	"Τρι"\
	"Τετ"\
	"Πεμ"\
	"Παρ"\
	"Σαβ"]
::msgcat::mcset el DAYS_OF_WEEK_FULL [list \
	"Κυριακή"\
	"Δευτέρα"\
	"Τρίτη"\
	"Τετάρτη"\
	"Πέμπτη"\
	"Παρασκευή"\
	"Σάββατο"]
::msgcat::mcset el MONTHS_ABBREV [list \
	"Ιαν"\
	"Φεβ"\
	"Μαρ"\
	"Απρ"\
	"Μαϊ"\
	"Ιουν"\
	"Ιουλ"\
	"Αυγ"\
	"Σεπ"\
	"Οκτ"\
	"Νοε"\
	"Δεκ"\
	""]
::msgcat::mcset el MONTHS_FULL [list \
	"Ιανουάριος"\
	"Φεβρουάριος"\
	"Μάρτιος"\
	"Απρίλιος"\
	"Μάϊος"\
	"Ιούνιος"\
	"Ιούλιος"\
	"Αύγουστος"\
	"Σεπτέμβριος"\
	"Οκτώβριος"\
	"Νοέμβριος"\
	"Δεκέμβριος"\
	""]
::msgcat::mcset el AM "πμ"
::msgcat::mcset el PM "μμ"
::msgcat::mcset el DATE_FORMAT "%e/%m/%Y"
::msgcat::mcset el TIME_FORMAT_12 "%l:%M:%S %P"
::msgcat::mcset el DATE_TIME_FORMAT "%e/%m/%Y %l:%M:%S %P %z"
}
Changes to library/msgs/en_au.msg.
1
2
3
4
5
6





7
1





2
3
4
5
6


-
-
-
-
-
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset en_AU DATE_FORMAT "%e/%m/%Y"
    ::msgcat::mcset en_AU TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset en_AU TIME_FORMAT_12 "%I:%M:%S %P %z"
    ::msgcat::mcset en_AU DATE_TIME_FORMAT "%e/%m/%Y %H:%M:%S %z"

::msgcat::mcset en_AU DATE_FORMAT "%e/%m/%Y"
::msgcat::mcset en_AU TIME_FORMAT "%H:%M:%S"
::msgcat::mcset en_AU TIME_FORMAT_12 "%I:%M:%S %P %z"
::msgcat::mcset en_AU DATE_TIME_FORMAT "%e/%m/%Y %H:%M:%S %z"
}
Changes to library/msgs/en_be.msg.
1
2
3
4
5
6





7
1





2
3
4
5
6


-
-
-
-
-
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset en_BE DATE_FORMAT "%d %b %Y"
    ::msgcat::mcset en_BE TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset en_BE TIME_FORMAT_12 "%k h %M min %S s %z"
    ::msgcat::mcset en_BE DATE_TIME_FORMAT "%d %b %Y %k:%M:%S %z"

::msgcat::mcset en_BE DATE_FORMAT "%d %b %Y"
::msgcat::mcset en_BE TIME_FORMAT "%k:%M:%S"
::msgcat::mcset en_BE TIME_FORMAT_12 "%k h %M min %S s %z"
::msgcat::mcset en_BE DATE_TIME_FORMAT "%d %b %Y %k:%M:%S %z"
}
Changes to library/msgs/en_bw.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset en_BW DATE_FORMAT "%d %B %Y"
    ::msgcat::mcset en_BW TIME_FORMAT_12 "%l:%M:%S %P"
    ::msgcat::mcset en_BW DATE_TIME_FORMAT "%d %B %Y %l:%M:%S %P %z"

::msgcat::mcset en_BW DATE_FORMAT "%d %B %Y"
::msgcat::mcset en_BW TIME_FORMAT_12 "%l:%M:%S %P"
::msgcat::mcset en_BW DATE_TIME_FORMAT "%d %B %Y %l:%M:%S %P %z"
}
Changes to library/msgs/en_ca.msg.
1
2
3
4
5
6





7
1





2
3
4
5
6


-
-
-
-
-
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset en_CA DATE_FORMAT "%d/%m/%y"
    ::msgcat::mcset en_CA TIME_FORMAT "%r"
    ::msgcat::mcset en_CA TIME_FORMAT_12 "%I:%M:%S %p"
    ::msgcat::mcset en_CA DATE_TIME_FORMAT "%a %d %b %Y %r %z"

::msgcat::mcset en_CA DATE_FORMAT "%d/%m/%y"
::msgcat::mcset en_CA TIME_FORMAT "%r"
::msgcat::mcset en_CA TIME_FORMAT_12 "%I:%M:%S %p"
::msgcat::mcset en_CA DATE_TIME_FORMAT "%a %d %b %Y %r %z"
}
Changes to library/msgs/en_gb.msg.
1
2
3
4
5
6





7
1





2
3
4
5
6


-
-
-
-
-
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset en_GB DATE_FORMAT "%d/%m/%y"
    ::msgcat::mcset en_GB TIME_FORMAT "%T"
    ::msgcat::mcset en_GB TIME_FORMAT_12 "%T"
    ::msgcat::mcset en_GB DATE_TIME_FORMAT "%a %d %b %Y %T %z"

::msgcat::mcset en_GB DATE_FORMAT "%d/%m/%y"
::msgcat::mcset en_GB TIME_FORMAT "%T"
::msgcat::mcset en_GB TIME_FORMAT_12 "%T"
::msgcat::mcset en_GB DATE_TIME_FORMAT "%a %d %b %Y %T %z"
}
Changes to library/msgs/en_hk.msg.
1
2
3
4
5
6
7






8
1






2
3
4
5
6
7


-
-
-
-
-
-
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset en_HK AM "AM"
    ::msgcat::mcset en_HK PM "PM"
    ::msgcat::mcset en_HK DATE_FORMAT "%B %e, %Y"
    ::msgcat::mcset en_HK TIME_FORMAT_12 "%l:%M:%S %P"
    ::msgcat::mcset en_HK DATE_TIME_FORMAT "%B %e, %Y %l:%M:%S %P %z"

::msgcat::mcset en_HK AM "AM"
::msgcat::mcset en_HK PM "PM"
::msgcat::mcset en_HK DATE_FORMAT "%B %e, %Y"
::msgcat::mcset en_HK TIME_FORMAT_12 "%l:%M:%S %P"
::msgcat::mcset en_HK DATE_TIME_FORMAT "%B %e, %Y %l:%M:%S %P %z"
}
Changes to library/msgs/en_ie.msg.
1
2
3
4
5
6





7
1





2
3
4
5
6


-
-
-
-
-
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset en_IE DATE_FORMAT "%d/%m/%y"
    ::msgcat::mcset en_IE TIME_FORMAT "%T"
    ::msgcat::mcset en_IE TIME_FORMAT_12 "%T"
    ::msgcat::mcset en_IE DATE_TIME_FORMAT "%a %d %b %Y %T %z"

::msgcat::mcset en_IE DATE_FORMAT "%d/%m/%y"
::msgcat::mcset en_IE TIME_FORMAT "%T"
::msgcat::mcset en_IE TIME_FORMAT_12 "%T"
::msgcat::mcset en_IE DATE_TIME_FORMAT "%a %d %b %Y %T %z"
}
Changes to library/msgs/en_in.msg.
1
2
3
4
5
6
7






8
1






2
3
4
5
6
7


-
-
-
-
-
-
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset en_IN AM "AM"
    ::msgcat::mcset en_IN PM "PM"
    ::msgcat::mcset en_IN DATE_FORMAT "%d %B %Y"
    ::msgcat::mcset en_IN TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset en_IN DATE_TIME_FORMAT "%d %B %Y %H:%M:%S %z"

::msgcat::mcset en_IN AM "AM"
::msgcat::mcset en_IN PM "PM"
::msgcat::mcset en_IN DATE_FORMAT "%d %B %Y"
::msgcat::mcset en_IN TIME_FORMAT "%H:%M:%S"
::msgcat::mcset en_IN DATE_TIME_FORMAT "%d %B %Y %H:%M:%S %z"
}
Changes to library/msgs/en_nz.msg.
1
2
3
4
5
6





7
1





2
3
4
5
6


-
-
-
-
-
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset en_NZ DATE_FORMAT "%e/%m/%Y"
    ::msgcat::mcset en_NZ TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset en_NZ TIME_FORMAT_12 "%I:%M:%S %P %z"
    ::msgcat::mcset en_NZ DATE_TIME_FORMAT "%e/%m/%Y %H:%M:%S %z"

::msgcat::mcset en_NZ DATE_FORMAT "%e/%m/%Y"
::msgcat::mcset en_NZ TIME_FORMAT "%H:%M:%S"
::msgcat::mcset en_NZ TIME_FORMAT_12 "%I:%M:%S %P %z"
::msgcat::mcset en_NZ DATE_TIME_FORMAT "%e/%m/%Y %H:%M:%S %z"
}
Changes to library/msgs/en_ph.msg.
1
2
3
4
5
6
7






8
1






2
3
4
5
6
7


-
-
-
-
-
-
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset en_PH AM "AM"
    ::msgcat::mcset en_PH PM "PM"
    ::msgcat::mcset en_PH DATE_FORMAT "%B %e, %Y"
    ::msgcat::mcset en_PH TIME_FORMAT_12 "%l:%M:%S %P"
    ::msgcat::mcset en_PH DATE_TIME_FORMAT "%B %e, %Y %l:%M:%S %P %z"

::msgcat::mcset en_PH AM "AM"
::msgcat::mcset en_PH PM "PM"
::msgcat::mcset en_PH DATE_FORMAT "%B %e, %Y"
::msgcat::mcset en_PH TIME_FORMAT_12 "%l:%M:%S %P"
::msgcat::mcset en_PH DATE_TIME_FORMAT "%B %e, %Y %l:%M:%S %P %z"
}
Changes to library/msgs/en_sg.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset en_SG DATE_FORMAT "%d %b %Y"
    ::msgcat::mcset en_SG TIME_FORMAT_12 "%P %I:%M:%S"
    ::msgcat::mcset en_SG DATE_TIME_FORMAT "%d %b %Y %P %I:%M:%S %z"

::msgcat::mcset en_SG DATE_FORMAT "%d %b %Y"
::msgcat::mcset en_SG TIME_FORMAT_12 "%P %I:%M:%S"
::msgcat::mcset en_SG DATE_TIME_FORMAT "%d %b %Y %P %I:%M:%S %z"
}
Changes to library/msgs/en_za.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset en_ZA DATE_FORMAT "%Y/%m/%d"
    ::msgcat::mcset en_ZA TIME_FORMAT_12 "%I:%M:%S"
    ::msgcat::mcset en_ZA DATE_TIME_FORMAT "%Y/%m/%d %I:%M:%S %z"

::msgcat::mcset en_ZA DATE_FORMAT "%Y/%m/%d"
::msgcat::mcset en_ZA TIME_FORMAT_12 "%I:%M:%S"
::msgcat::mcset en_ZA DATE_TIME_FORMAT "%Y/%m/%d %I:%M:%S %z"
}
Changes to library/msgs/en_zw.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset en_ZW DATE_FORMAT "%d %B %Y"
    ::msgcat::mcset en_ZW TIME_FORMAT_12 "%l:%M:%S %P"
    ::msgcat::mcset en_ZW DATE_TIME_FORMAT "%d %B %Y %l:%M:%S %P %z"

::msgcat::mcset en_ZW DATE_FORMAT "%d %B %Y"
::msgcat::mcset en_ZW TIME_FORMAT_12 "%l:%M:%S %P"
::msgcat::mcset en_ZW DATE_TIME_FORMAT "%d %B %Y %l:%M:%S %P %z"
}
Changes to library/msgs/eo.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset eo DAYS_OF_WEEK_ABBREV [list \
        "di"\
        "lu"\
        "ma"\
        "me"\
        "ĵa"\
        "ve"\
        "sa"]
    ::msgcat::mcset eo DAYS_OF_WEEK_FULL [list \
        "dimanĉo"\
        "lundo"\
        "mardo"\
        "merkredo"\
        "ĵaŭdo"\
        "vendredo"\
        "sabato"]
    ::msgcat::mcset eo MONTHS_ABBREV [list \
        "jan"\
        "feb"\
        "mar"\
        "apr"\
        "maj"\
        "jun"\
        "jul"\
        "aŭg"\
        "sep"\
        "okt"\
        "nov"\
        "dec"\
        ""]
    ::msgcat::mcset eo MONTHS_FULL [list \
        "januaro"\
        "februaro"\
        "marto"\
        "aprilo"\
        "majo"\
        "junio"\
        "julio"\
        "aŭgusto"\
        "septembro"\
        "oktobro"\
        "novembro"\
        "decembro"\
        ""]
    ::msgcat::mcset eo BCE "aK"
    ::msgcat::mcset eo CE "pK"
    ::msgcat::mcset eo AM "atm"
    ::msgcat::mcset eo PM "ptm"
    ::msgcat::mcset eo DATE_FORMAT "%Y-%b-%d"
    ::msgcat::mcset eo TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset eo DATE_TIME_FORMAT "%Y-%b-%d %H:%M:%S %z"

::msgcat::mcset eo DAYS_OF_WEEK_ABBREV [list \
	"di"\
	"lu"\
	"ma"\
	"me"\
	"ĵa"\
	"ve"\
	"sa"]
::msgcat::mcset eo DAYS_OF_WEEK_FULL [list \
	"dimanĉo"\
	"lundo"\
	"mardo"\
	"merkredo"\
	"ĵaŭdo"\
	"vendredo"\
	"sabato"]
::msgcat::mcset eo MONTHS_ABBREV [list \
	"jan"\
	"feb"\
	"mar"\
	"apr"\
	"maj"\
	"jun"\
	"jul"\
	"aŭg"\
	"sep"\
	"okt"\
	"nov"\
	"dec"\
	""]
::msgcat::mcset eo MONTHS_FULL [list \
	"januaro"\
	"februaro"\
	"marto"\
	"aprilo"\
	"majo"\
	"junio"\
	"julio"\
	"aŭgusto"\
	"septembro"\
	"oktobro"\
	"novembro"\
	"decembro"\
	""]
::msgcat::mcset eo BCE "aK"
::msgcat::mcset eo CE "pK"
::msgcat::mcset eo AM "atm"
::msgcat::mcset eo PM "ptm"
::msgcat::mcset eo DATE_FORMAT "%Y-%b-%d"
::msgcat::mcset eo TIME_FORMAT "%H:%M:%S"
::msgcat::mcset eo DATE_TIME_FORMAT "%Y-%b-%d %H:%M:%S %z"
}
Changes to library/msgs/es.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset es DAYS_OF_WEEK_ABBREV [list \
        "dom"\
        "lun"\
        "mar"\
        "mié"\
        "jue"\
        "vie"\
        "sáb"]
    ::msgcat::mcset es DAYS_OF_WEEK_FULL [list \
        "domingo"\
        "lunes"\
        "martes"\
        "miércoles"\
        "jueves"\
        "viernes"\
        "sábado"]
    ::msgcat::mcset es MONTHS_ABBREV [list \
        "ene"\
        "feb"\
        "mar"\
        "abr"\
        "may"\
        "jun"\
        "jul"\
        "ago"\
        "sep"\
        "oct"\
        "nov"\
        "dic"\
        ""]
    ::msgcat::mcset es MONTHS_FULL [list \
        "enero"\
        "febrero"\
        "marzo"\
        "abril"\
        "mayo"\
        "junio"\
        "julio"\
        "agosto"\
        "septiembre"\
        "octubre"\
        "noviembre"\
        "diciembre"\
        ""]
    ::msgcat::mcset es BCE "a.C."
    ::msgcat::mcset es CE "d.C."
    ::msgcat::mcset es DATE_FORMAT "%e de %B de %Y"
    ::msgcat::mcset es TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset es DATE_TIME_FORMAT "%e de %B de %Y %k:%M:%S %z"

::msgcat::mcset es DAYS_OF_WEEK_ABBREV [list \
	"dom"\
	"lun"\
	"mar"\
	"mié"\
	"jue"\
	"vie"\
	"sáb"]
::msgcat::mcset es DAYS_OF_WEEK_FULL [list \
	"domingo"\
	"lunes"\
	"martes"\
	"miércoles"\
	"jueves"\
	"viernes"\
	"sábado"]
::msgcat::mcset es MONTHS_ABBREV [list \
	"ene"\
	"feb"\
	"mar"\
	"abr"\
	"may"\
	"jun"\
	"jul"\
	"ago"\
	"sep"\
	"oct"\
	"nov"\
	"dic"\
	""]
::msgcat::mcset es MONTHS_FULL [list \
	"enero"\
	"febrero"\
	"marzo"\
	"abril"\
	"mayo"\
	"junio"\
	"julio"\
	"agosto"\
	"septiembre"\
	"octubre"\
	"noviembre"\
	"diciembre"\
	""]
::msgcat::mcset es BCE "a.C."
::msgcat::mcset es CE "d.C."
::msgcat::mcset es DATE_FORMAT "%e de %B de %Y"
::msgcat::mcset es TIME_FORMAT "%k:%M:%S"
::msgcat::mcset es DATE_TIME_FORMAT "%e de %B de %Y %k:%M:%S %z"
}
Changes to library/msgs/es_ar.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset es_AR DATE_FORMAT "%d/%m/%Y"
    ::msgcat::mcset es_AR TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset es_AR DATE_TIME_FORMAT "%d/%m/%Y %H:%M:%S %z"

::msgcat::mcset es_AR DATE_FORMAT "%d/%m/%Y"
::msgcat::mcset es_AR TIME_FORMAT "%H:%M:%S"
::msgcat::mcset es_AR DATE_TIME_FORMAT "%d/%m/%Y %H:%M:%S %z"
}
Changes to library/msgs/es_bo.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset es_BO DATE_FORMAT "%d-%m-%Y"
    ::msgcat::mcset es_BO TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset es_BO DATE_TIME_FORMAT "%d-%m-%Y %I:%M:%S %P %z"

::msgcat::mcset es_BO DATE_FORMAT "%d-%m-%Y"
::msgcat::mcset es_BO TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset es_BO DATE_TIME_FORMAT "%d-%m-%Y %I:%M:%S %P %z"
}
Changes to library/msgs/es_cl.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset es_CL DATE_FORMAT "%d-%m-%Y"
    ::msgcat::mcset es_CL TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset es_CL DATE_TIME_FORMAT "%d-%m-%Y %I:%M:%S %P %z"

::msgcat::mcset es_CL DATE_FORMAT "%d-%m-%Y"
::msgcat::mcset es_CL TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset es_CL DATE_TIME_FORMAT "%d-%m-%Y %I:%M:%S %P %z"
}
Changes to library/msgs/es_co.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset es_CO DATE_FORMAT "%e/%m/%Y"
    ::msgcat::mcset es_CO TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset es_CO DATE_TIME_FORMAT "%e/%m/%Y %I:%M:%S %P %z"

::msgcat::mcset es_CO DATE_FORMAT "%e/%m/%Y"
::msgcat::mcset es_CO TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset es_CO DATE_TIME_FORMAT "%e/%m/%Y %I:%M:%S %P %z"
}
Changes to library/msgs/es_cr.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset es_CR DATE_FORMAT "%d/%m/%Y"
    ::msgcat::mcset es_CR TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset es_CR DATE_TIME_FORMAT "%d/%m/%Y %I:%M:%S %P %z"

::msgcat::mcset es_CR DATE_FORMAT "%d/%m/%Y"
::msgcat::mcset es_CR TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset es_CR DATE_TIME_FORMAT "%d/%m/%Y %I:%M:%S %P %z"
}
Changes to library/msgs/es_do.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset es_DO DATE_FORMAT "%m/%d/%Y"
    ::msgcat::mcset es_DO TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset es_DO DATE_TIME_FORMAT "%m/%d/%Y %I:%M:%S %P %z"

::msgcat::mcset es_DO DATE_FORMAT "%m/%d/%Y"
::msgcat::mcset es_DO TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset es_DO DATE_TIME_FORMAT "%m/%d/%Y %I:%M:%S %P %z"
}
Changes to library/msgs/es_ec.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset es_EC DATE_FORMAT "%d/%m/%Y"
    ::msgcat::mcset es_EC TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset es_EC DATE_TIME_FORMAT "%d/%m/%Y %I:%M:%S %P %z"

::msgcat::mcset es_EC DATE_FORMAT "%d/%m/%Y"
::msgcat::mcset es_EC TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset es_EC DATE_TIME_FORMAT "%d/%m/%Y %I:%M:%S %P %z"
}
Changes to library/msgs/es_gt.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset es_GT DATE_FORMAT "%e/%m/%Y"
    ::msgcat::mcset es_GT TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset es_GT DATE_TIME_FORMAT "%e/%m/%Y %I:%M:%S %P %z"

::msgcat::mcset es_GT DATE_FORMAT "%e/%m/%Y"
::msgcat::mcset es_GT TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset es_GT DATE_TIME_FORMAT "%e/%m/%Y %I:%M:%S %P %z"
}
Changes to library/msgs/es_hn.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset es_HN DATE_FORMAT "%m-%d-%Y"
    ::msgcat::mcset es_HN TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset es_HN DATE_TIME_FORMAT "%m-%d-%Y %I:%M:%S %P %z"

::msgcat::mcset es_HN DATE_FORMAT "%m-%d-%Y"
::msgcat::mcset es_HN TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset es_HN DATE_TIME_FORMAT "%m-%d-%Y %I:%M:%S %P %z"
}
Changes to library/msgs/es_mx.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset es_MX DATE_FORMAT "%e/%m/%Y"
    ::msgcat::mcset es_MX TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset es_MX DATE_TIME_FORMAT "%e/%m/%Y %I:%M:%S %P %z"

::msgcat::mcset es_MX DATE_FORMAT "%e/%m/%Y"
::msgcat::mcset es_MX TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset es_MX DATE_TIME_FORMAT "%e/%m/%Y %I:%M:%S %P %z"
}
Changes to library/msgs/es_ni.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset es_NI DATE_FORMAT "%m-%d-%Y"
    ::msgcat::mcset es_NI TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset es_NI DATE_TIME_FORMAT "%m-%d-%Y %I:%M:%S %P %z"

::msgcat::mcset es_NI DATE_FORMAT "%m-%d-%Y"
::msgcat::mcset es_NI TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset es_NI DATE_TIME_FORMAT "%m-%d-%Y %I:%M:%S %P %z"
}
Changes to library/msgs/es_pa.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset es_PA DATE_FORMAT "%m/%d/%Y"
    ::msgcat::mcset es_PA TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset es_PA DATE_TIME_FORMAT "%m/%d/%Y %I:%M:%S %P %z"

::msgcat::mcset es_PA DATE_FORMAT "%m/%d/%Y"
::msgcat::mcset es_PA TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset es_PA DATE_TIME_FORMAT "%m/%d/%Y %I:%M:%S %P %z"
}
Changes to library/msgs/es_pe.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset es_PE DATE_FORMAT "%d/%m/%Y"
    ::msgcat::mcset es_PE TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset es_PE DATE_TIME_FORMAT "%d/%m/%Y %I:%M:%S %P %z"

::msgcat::mcset es_PE DATE_FORMAT "%d/%m/%Y"
::msgcat::mcset es_PE TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset es_PE DATE_TIME_FORMAT "%d/%m/%Y %I:%M:%S %P %z"
}
Changes to library/msgs/es_pr.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset es_PR DATE_FORMAT "%m-%d-%Y"
    ::msgcat::mcset es_PR TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset es_PR DATE_TIME_FORMAT "%m-%d-%Y %I:%M:%S %P %z"

::msgcat::mcset es_PR DATE_FORMAT "%m-%d-%Y"
::msgcat::mcset es_PR TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset es_PR DATE_TIME_FORMAT "%m-%d-%Y %I:%M:%S %P %z"
}
Changes to library/msgs/es_py.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset es_PY DATE_FORMAT "%d/%m/%Y"
    ::msgcat::mcset es_PY TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset es_PY DATE_TIME_FORMAT "%d/%m/%Y %I:%M:%S %P %z"

::msgcat::mcset es_PY DATE_FORMAT "%d/%m/%Y"
::msgcat::mcset es_PY TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset es_PY DATE_TIME_FORMAT "%d/%m/%Y %I:%M:%S %P %z"
}
Changes to library/msgs/es_sv.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset es_SV DATE_FORMAT "%m-%d-%Y"
    ::msgcat::mcset es_SV TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset es_SV DATE_TIME_FORMAT "%m-%d-%Y %I:%M:%S %P %z"

::msgcat::mcset es_SV DATE_FORMAT "%m-%d-%Y"
::msgcat::mcset es_SV TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset es_SV DATE_TIME_FORMAT "%m-%d-%Y %I:%M:%S %P %z"
}
Changes to library/msgs/es_uy.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset es_UY DATE_FORMAT "%d/%m/%Y"
    ::msgcat::mcset es_UY TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset es_UY DATE_TIME_FORMAT "%d/%m/%Y %I:%M:%S %P %z"

::msgcat::mcset es_UY DATE_FORMAT "%d/%m/%Y"
::msgcat::mcset es_UY TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset es_UY DATE_TIME_FORMAT "%d/%m/%Y %I:%M:%S %P %z"
}
Changes to library/msgs/es_ve.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset es_VE DATE_FORMAT "%d/%m/%Y"
    ::msgcat::mcset es_VE TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset es_VE DATE_TIME_FORMAT "%d/%m/%Y %I:%M:%S %P %z"

::msgcat::mcset es_VE DATE_FORMAT "%d/%m/%Y"
::msgcat::mcset es_VE TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset es_VE DATE_TIME_FORMAT "%d/%m/%Y %I:%M:%S %P %z"
}
Changes to library/msgs/et.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset et DAYS_OF_WEEK_ABBREV [list \
        "P"\
        "E"\
        "T"\
        "K"\
        "N"\
        "R"\
        "L"]
    ::msgcat::mcset et DAYS_OF_WEEK_FULL [list \
        "pühapäev"\
        "esmaspäev"\
        "teisipäev"\
        "kolmapäev"\
        "neljapäev"\
        "reede"\
        "laupäev"]
    ::msgcat::mcset et MONTHS_ABBREV [list \
        "Jaan"\
        "Veebr"\
        "Märts"\
        "Apr"\
        "Mai"\
        "Juuni"\
        "Juuli"\
        "Aug"\
        "Sept"\
        "Okt"\
        "Nov"\
        "Dets"\
        ""]
    ::msgcat::mcset et MONTHS_FULL [list \
        "Jaanuar"\
        "Veebruar"\
        "Märts"\
        "Aprill"\
        "Mai"\
        "Juuni"\
        "Juuli"\
        "August"\
        "September"\
        "Oktoober"\
        "November"\
        "Detsember"\
        ""]
    ::msgcat::mcset et BCE "e.m.a."
    ::msgcat::mcset et CE "m.a.j."
    ::msgcat::mcset et DATE_FORMAT "%e-%m-%Y"
    ::msgcat::mcset et TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset et DATE_TIME_FORMAT "%e-%m-%Y %k:%M:%S %z"

::msgcat::mcset et DAYS_OF_WEEK_ABBREV [list \
	"P"\
	"E"\
	"T"\
	"K"\
	"N"\
	"R"\
	"L"]
::msgcat::mcset et DAYS_OF_WEEK_FULL [list \
	"pühapäev"\
	"esmaspäev"\
	"teisipäev"\
	"kolmapäev"\
	"neljapäev"\
	"reede"\
	"laupäev"]
::msgcat::mcset et MONTHS_ABBREV [list \
	"Jaan"\
	"Veebr"\
	"Märts"\
	"Apr"\
	"Mai"\
	"Juuni"\
	"Juuli"\
	"Aug"\
	"Sept"\
	"Okt"\
	"Nov"\
	"Dets"\
	""]
::msgcat::mcset et MONTHS_FULL [list \
	"Jaanuar"\
	"Veebruar"\
	"Märts"\
	"Aprill"\
	"Mai"\
	"Juuni"\
	"Juuli"\
	"August"\
	"September"\
	"Oktoober"\
	"November"\
	"Detsember"\
	""]
::msgcat::mcset et BCE "e.m.a."
::msgcat::mcset et CE "m.a.j."
::msgcat::mcset et DATE_FORMAT "%e-%m-%Y"
::msgcat::mcset et TIME_FORMAT "%k:%M:%S"
::msgcat::mcset et DATE_TIME_FORMAT "%e-%m-%Y %k:%M:%S %z"
}
Changes to library/msgs/eu.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset eu DAYS_OF_WEEK_ABBREV [list \
        "igandea"\
        "astelehena"\
        "asteartea"\
        "asteazkena"\
        "osteguna"\
        "ostirala"\
        "larunbata"]
    ::msgcat::mcset eu DAYS_OF_WEEK_FULL [list \
        "igandea"\
        "astelehena"\
        "asteartea"\
        "asteazkena"\
        "osteguna"\
        "ostirala"\
        "larunbata"]
    ::msgcat::mcset eu MONTHS_ABBREV [list \
        "urt"\
        "ots"\
        "mar"\
        "api"\
        "mai"\
        "eka"\
        "uzt"\
        "abu"\
        "ira"\
        "urr"\
        "aza"\
        "abe"\
        ""]
    ::msgcat::mcset eu MONTHS_FULL [list \
        "urtarrila"\
        "otsaila"\
        "martxoa"\
        "apirila"\
        "maiatza"\
        "ekaina"\
        "uztaila"\
        "abuztua"\
        "iraila"\
        "urria"\
        "azaroa"\
        "abendua"\
        ""]

::msgcat::mcset eu DAYS_OF_WEEK_ABBREV [list \
	"igandea"\
	"astelehena"\
	"asteartea"\
	"asteazkena"\
	"osteguna"\
	"ostirala"\
	"larunbata"]
::msgcat::mcset eu DAYS_OF_WEEK_FULL [list \
	"igandea"\
	"astelehena"\
	"asteartea"\
	"asteazkena"\
	"osteguna"\
	"ostirala"\
	"larunbata"]
::msgcat::mcset eu MONTHS_ABBREV [list \
	"urt"\
	"ots"\
	"mar"\
	"api"\
	"mai"\
	"eka"\
	"uzt"\
	"abu"\
	"ira"\
	"urr"\
	"aza"\
	"abe"\
	""]
::msgcat::mcset eu MONTHS_FULL [list \
	"urtarrila"\
	"otsaila"\
	"martxoa"\
	"apirila"\
	"maiatza"\
	"ekaina"\
	"uztaila"\
	"abuztua"\
	"iraila"\
	"urria"\
	"azaroa"\
	"abendua"\
	""]
}
Changes to library/msgs/eu_es.msg.
1
2
3
4
5
6





7
1





2
3
4
5
6


-
-
-
-
-
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset eu_ES DATE_FORMAT "%a, %Yeko %bren %da"
    ::msgcat::mcset eu_ES TIME_FORMAT "%T"
    ::msgcat::mcset eu_ES TIME_FORMAT_12 "%T"
    ::msgcat::mcset eu_ES DATE_TIME_FORMAT "%y-%m-%d %T %z"

::msgcat::mcset eu_ES DATE_FORMAT "%a, %Yeko %bren %da"
::msgcat::mcset eu_ES TIME_FORMAT "%T"
::msgcat::mcset eu_ES TIME_FORMAT_12 "%T"
::msgcat::mcset eu_ES DATE_TIME_FORMAT "%y-%m-%d %T %z"
}
Changes to library/msgs/fa.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset fa DAYS_OF_WEEK_ABBREV [list \
        "ی∔"\
        "د∔"\
        "س∔"\
        "چ∔"\
        "پ∔"\
        "ج∔"\
        "ش∔"]
    ::msgcat::mcset fa DAYS_OF_WEEK_FULL [list \
        "یی‌شنبه"\
        "دوشنبه"\
        "سه‌شنبه"\
        "چهارشنبه"\
        "پنج‌شنبه"\
        "جمعه"\
        "شنبه"]
    ::msgcat::mcset fa MONTHS_ABBREV [list \
        "ژان"\
        "فور"\
        "مار"\
        "آور"\
        "مـه"\
        "ژون"\
        "ژوی"\
        "اوت"\
        "سپت"\
        "اكت"\
        "نوا"\
        "دسا"\
        ""]
    ::msgcat::mcset fa MONTHS_FULL [list \
        "ژانویه"\
        "فورویه"\
        "مارس"\
        "آوریل"\
        "مه"\
        "ژوئن"\
        "ژوئیه"\
        "اوت"\
        "سپتامبر"\
        "اكتبر"\
        "نوامبر"\
        "دسامبر"\
        ""]

::msgcat::mcset fa DAYS_OF_WEEK_ABBREV [list \
	"ی∔"\
	"د∔"\
	"س∔"\
	"چ∔"\
	"پ∔"\
	"ج∔"\
	"ش∔"]
::msgcat::mcset fa DAYS_OF_WEEK_FULL [list \
	"یی‌شنبه"\
	"دوشنبه"\
	"سه‌شنبه"\
	"چهارشنبه"\
	"پنج‌شنبه"\
	"جمعه"\
	"شنبه"]
::msgcat::mcset fa MONTHS_ABBREV [list \
	"ژان"\
	"فور"\
	"مار"\
	"آور"\
	"مـه"\
	"ژون"\
	"ژوی"\
	"اوت"\
	"سپت"\
	"اكت"\
	"نوا"\
	"دسا"\
	""]
::msgcat::mcset fa MONTHS_FULL [list \
	"ژانویه"\
	"فورویه"\
	"مارس"\
	"آوریل"\
	"مه"\
	"ژوئن"\
	"ژوئیه"\
	"اوت"\
	"سپتامبر"\
	"اكتبر"\
	"نوامبر"\
	"دسامبر"\
	""]
}
Changes to library/msgs/fa_in.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset fa_IN DAYS_OF_WEEK_ABBREV [list \
        "ی∔"\
        "د∔"\
        "س∔"\
        "چ∔"\
        "پ∔"\
        "ج∔"\
        "ش∔"]
    ::msgcat::mcset fa_IN DAYS_OF_WEEK_FULL [list \
        "یی‌شنبه"\
        "دوشنبه"\
        "سه‌شنبه"\
        "چهارشنبه"\
        "پنج‌شنبه"\
        "جمعه"\
        "شنبه"]
    ::msgcat::mcset fa_IN MONTHS_ABBREV [list \
        "ژان"\
        "فور"\
        "مار"\
        "آور"\
        "مـه"\
        "ژون"\
        "ژوی"\
        "اوت"\
        "سپت"\
        "اكت"\
        "نوا"\
        "دسا"\
        ""]
    ::msgcat::mcset fa_IN MONTHS_FULL [list \
        "ژانویه"\
        "فورویه"\
        "مارس"\
        "آوریل"\
        "مه"\
        "ژوئن"\
        "ژوئیه"\
        "اوت"\
        "سپتامبر"\
        "اكتبر"\
        "نوامبر"\
        "دسامبر"\
        ""]
    ::msgcat::mcset fa_IN AM "صبح"
    ::msgcat::mcset fa_IN PM "عصر"
    ::msgcat::mcset fa_IN DATE_FORMAT "%A %d %B %Y"
    ::msgcat::mcset fa_IN TIME_FORMAT_12 "%I:%M:%S  %z"
    ::msgcat::mcset fa_IN DATE_TIME_FORMAT "%A %d %B %Y %I:%M:%S  %z %z"

::msgcat::mcset fa_IN DAYS_OF_WEEK_ABBREV [list \
	"ی∔"\
	"د∔"\
	"س∔"\
	"چ∔"\
	"پ∔"\
	"ج∔"\
	"ش∔"]
::msgcat::mcset fa_IN DAYS_OF_WEEK_FULL [list \
	"یی‌شنبه"\
	"دوشنبه"\
	"سه‌شنبه"\
	"چهارشنبه"\
	"پنج‌شنبه"\
	"جمعه"\
	"شنبه"]
::msgcat::mcset fa_IN MONTHS_ABBREV [list \
	"ژان"\
	"فور"\
	"مار"\
	"آور"\
	"مـه"\
	"ژون"\
	"ژوی"\
	"اوت"\
	"سپت"\
	"اكت"\
	"نوا"\
	"دسا"\
	""]
::msgcat::mcset fa_IN MONTHS_FULL [list \
	"ژانویه"\
	"فورویه"\
	"مارس"\
	"آوریل"\
	"مه"\
	"ژوئن"\
	"ژوئیه"\
	"اوت"\
	"سپتامبر"\
	"اكتبر"\
	"نوامبر"\
	"دسامبر"\
	""]
::msgcat::mcset fa_IN AM "صبح"
::msgcat::mcset fa_IN PM "عصر"
::msgcat::mcset fa_IN DATE_FORMAT "%A %d %B %Y"
::msgcat::mcset fa_IN TIME_FORMAT_12 "%I:%M:%S  %z"
::msgcat::mcset fa_IN DATE_TIME_FORMAT "%A %d %B %Y %I:%M:%S  %z %z"
}
Changes to library/msgs/fa_ir.msg.
1
2
3
4
5
6
7
8







9
1







2
3
4
5
6
7
8


-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset fa_IR AM "صبح"
    ::msgcat::mcset fa_IR PM "عصر"
    ::msgcat::mcset fa_IR DATE_FORMAT "%d⁄%m⁄%Y"
    ::msgcat::mcset fa_IR TIME_FORMAT "%S:%M:%H"
    ::msgcat::mcset fa_IR TIME_FORMAT_12 "%S:%M:%l %P"
    ::msgcat::mcset fa_IR DATE_TIME_FORMAT "%d⁄%m⁄%Y %S:%M:%H %z"

::msgcat::mcset fa_IR AM "صبح"
::msgcat::mcset fa_IR PM "عصر"
::msgcat::mcset fa_IR DATE_FORMAT "%d⁄%m⁄%Y"
::msgcat::mcset fa_IR TIME_FORMAT "%S:%M:%H"
::msgcat::mcset fa_IR TIME_FORMAT_12 "%S:%M:%l %P"
::msgcat::mcset fa_IR DATE_TIME_FORMAT "%d⁄%m⁄%Y %S:%M:%H %z"
}
Changes to library/msgs/fi.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset fi DAYS_OF_WEEK_ABBREV [list \
        "su"\
        "ma"\
        "ti"\
        "ke"\
        "to"\
        "pe"\
        "la"]
    ::msgcat::mcset fi DAYS_OF_WEEK_FULL [list \
        "sunnuntai"\
        "maanantai"\
        "tiistai"\
        "keskiviikko"\
        "torstai"\
        "perjantai"\
        "lauantai"]
    ::msgcat::mcset fi MONTHS_ABBREV [list \
        "tammi"\
        "helmi"\
        "maalis"\
        "huhti"\
        "touko"\
        "kesä"\
        "heinä"\
        "elo"\
        "syys"\
        "loka"\
        "marras"\
        "joulu"\
        ""]
    ::msgcat::mcset fi MONTHS_FULL [list \
        "tammikuu"\
        "helmikuu"\
        "maaliskuu"\
        "huhtikuu"\
        "toukokuu"\
        "kesäkuu"\
        "heinäkuu"\
        "elokuu"\
        "syyskuu"\
        "lokakuu"\
        "marraskuu"\
        "joulukuu"\
        ""]
    ::msgcat::mcset fi DATE_FORMAT "%e.%m.%Y"
    ::msgcat::mcset fi TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset fi DATE_TIME_FORMAT "%e.%m.%Y %k:%M:%S %z"

::msgcat::mcset fi DAYS_OF_WEEK_ABBREV [list \
	"su"\
	"ma"\
	"ti"\
	"ke"\
	"to"\
	"pe"\
	"la"]
::msgcat::mcset fi DAYS_OF_WEEK_FULL [list \
	"sunnuntai"\
	"maanantai"\
	"tiistai"\
	"keskiviikko"\
	"torstai"\
	"perjantai"\
	"lauantai"]
::msgcat::mcset fi MONTHS_ABBREV [list \
	"tammi"\
	"helmi"\
	"maalis"\
	"huhti"\
	"touko"\
	"kesä"\
	"heinä"\
	"elo"\
	"syys"\
	"loka"\
	"marras"\
	"joulu"\
	""]
::msgcat::mcset fi MONTHS_FULL [list \
	"tammikuu"\
	"helmikuu"\
	"maaliskuu"\
	"huhtikuu"\
	"toukokuu"\
	"kesäkuu"\
	"heinäkuu"\
	"elokuu"\
	"syyskuu"\
	"lokakuu"\
	"marraskuu"\
	"joulukuu"\
	""]
::msgcat::mcset fi DATE_FORMAT "%e.%m.%Y"
::msgcat::mcset fi TIME_FORMAT "%k:%M:%S"
::msgcat::mcset fi DATE_TIME_FORMAT "%e.%m.%Y %k:%M:%S %z"
}
Changes to library/msgs/fo.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset fo DAYS_OF_WEEK_ABBREV [list \
        "sun"\
        "mán"\
        "týs"\
        "mik"\
        "hós"\
        "frí"\
        "ley"]
    ::msgcat::mcset fo DAYS_OF_WEEK_FULL [list \
        "sunnudagur"\
        "mánadagur"\
        "týsdagur"\
        "mikudagur"\
        "hósdagur"\
        "fríggjadagur"\
        "leygardagur"]
    ::msgcat::mcset fo MONTHS_ABBREV [list \
        "jan"\
        "feb"\
        "mar"\
        "apr"\
        "mai"\
        "jun"\
        "jul"\
        "aug"\
        "sep"\
        "okt"\
        "nov"\
        "des"\
        ""]
    ::msgcat::mcset fo MONTHS_FULL [list \
        "januar"\
        "februar"\
        "mars"\
        "apríl"\
        "mai"\
        "juni"\
        "juli"\
        "august"\
        "september"\
        "oktober"\
        "november"\
        "desember"\
        ""]

::msgcat::mcset fo DAYS_OF_WEEK_ABBREV [list \
	"sun"\
	"mán"\
	"týs"\
	"mik"\
	"hós"\
	"frí"\
	"ley"]
::msgcat::mcset fo DAYS_OF_WEEK_FULL [list \
	"sunnudagur"\
	"mánadagur"\
	"týsdagur"\
	"mikudagur"\
	"hósdagur"\
	"fríggjadagur"\
	"leygardagur"]
::msgcat::mcset fo MONTHS_ABBREV [list \
	"jan"\
	"feb"\
	"mar"\
	"apr"\
	"mai"\
	"jun"\
	"jul"\
	"aug"\
	"sep"\
	"okt"\
	"nov"\
	"des"\
	""]
::msgcat::mcset fo MONTHS_FULL [list \
	"januar"\
	"februar"\
	"mars"\
	"apríl"\
	"mai"\
	"juni"\
	"juli"\
	"august"\
	"september"\
	"oktober"\
	"november"\
	"desember"\
	""]
}
Changes to library/msgs/fo_fo.msg.
1
2
3
4
5
6





7
1





2
3
4
5
6


-
-
-
-
-
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset fo_FO DATE_FORMAT "%d/%m-%Y"
    ::msgcat::mcset fo_FO TIME_FORMAT "%T"
    ::msgcat::mcset fo_FO TIME_FORMAT_12 "%T"
    ::msgcat::mcset fo_FO DATE_TIME_FORMAT "%a %d %b %Y %T %z"

::msgcat::mcset fo_FO DATE_FORMAT "%d/%m-%Y"
::msgcat::mcset fo_FO TIME_FORMAT "%T"
::msgcat::mcset fo_FO TIME_FORMAT_12 "%T"
::msgcat::mcset fo_FO DATE_TIME_FORMAT "%a %d %b %Y %T %z"
}
Changes to library/msgs/fr.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset fr DAYS_OF_WEEK_ABBREV [list \
        "dim."\
        "lun."\
        "mar."\
        "mer."\
        "jeu."\
        "ven."\
        "sam."]
    ::msgcat::mcset fr DAYS_OF_WEEK_FULL [list \
        "dimanche"\
        "lundi"\
        "mardi"\
        "mercredi"\
        "jeudi"\
        "vendredi"\
        "samedi"]
    ::msgcat::mcset fr MONTHS_ABBREV [list \
        "janv."\
        "févr."\
        "mars"\
        "avr."\
        "mai"\
        "juin"\
        "juil."\
        "août"\
        "sept."\
        "oct."\
        "nov."\
        "déc."\
        ""]
    ::msgcat::mcset fr MONTHS_FULL [list \
        "janvier"\
        "février"\
        "mars"\
        "avril"\
        "mai"\
        "juin"\
        "juillet"\
        "août"\
        "septembre"\
        "octobre"\
        "novembre"\
        "décembre"\
        ""]
    ::msgcat::mcset fr BCE "av. J.-C."
    ::msgcat::mcset fr CE "ap. J.-C."
    ::msgcat::mcset fr DATE_FORMAT "%e %B %Y"
    ::msgcat::mcset fr TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset fr DATE_TIME_FORMAT "%e %B %Y %H:%M:%S %z"

::msgcat::mcset fr DAYS_OF_WEEK_ABBREV [list \
	"dim."\
	"lun."\
	"mar."\
	"mer."\
	"jeu."\
	"ven."\
	"sam."]
::msgcat::mcset fr DAYS_OF_WEEK_FULL [list \
	"dimanche"\
	"lundi"\
	"mardi"\
	"mercredi"\
	"jeudi"\
	"vendredi"\
	"samedi"]
::msgcat::mcset fr MONTHS_ABBREV [list \
	"janv."\
	"févr."\
	"mars"\
	"avr."\
	"mai"\
	"juin"\
	"juil."\
	"août"\
	"sept."\
	"oct."\
	"nov."\
	"déc."\
	""]
::msgcat::mcset fr MONTHS_FULL [list \
	"janvier"\
	"février"\
	"mars"\
	"avril"\
	"mai"\
	"juin"\
	"juillet"\
	"août"\
	"septembre"\
	"octobre"\
	"novembre"\
	"décembre"\
	""]
::msgcat::mcset fr BCE "av. J.-C."
::msgcat::mcset fr CE "ap. J.-C."
::msgcat::mcset fr DATE_FORMAT "%e %B %Y"
::msgcat::mcset fr TIME_FORMAT "%H:%M:%S"
::msgcat::mcset fr DATE_TIME_FORMAT "%e %B %Y %H:%M:%S %z"
}
Changes to library/msgs/fr_be.msg.
1
2
3
4
5
6





7
1





2
3
4
5
6


-
-
-
-
-
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset fr_BE DATE_FORMAT "%d/%m/%y"
    ::msgcat::mcset fr_BE TIME_FORMAT "%T"
    ::msgcat::mcset fr_BE TIME_FORMAT_12 "%T"
    ::msgcat::mcset fr_BE DATE_TIME_FORMAT "%a %d %b %Y %T %z"

::msgcat::mcset fr_BE DATE_FORMAT "%d/%m/%y"
::msgcat::mcset fr_BE TIME_FORMAT "%T"
::msgcat::mcset fr_BE TIME_FORMAT_12 "%T"
::msgcat::mcset fr_BE DATE_TIME_FORMAT "%a %d %b %Y %T %z"
}
Changes to library/msgs/fr_ca.msg.
1
2
3
4
5
6





7
1





2
3
4
5
6


-
-
-
-
-
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset fr_CA DATE_FORMAT "%Y-%m-%d"
    ::msgcat::mcset fr_CA TIME_FORMAT "%T"
    ::msgcat::mcset fr_CA TIME_FORMAT_12 "%T"
    ::msgcat::mcset fr_CA DATE_TIME_FORMAT "%a %d %b %Y %T %z"

::msgcat::mcset fr_CA DATE_FORMAT "%Y-%m-%d"
::msgcat::mcset fr_CA TIME_FORMAT "%T"
::msgcat::mcset fr_CA TIME_FORMAT_12 "%T"
::msgcat::mcset fr_CA DATE_TIME_FORMAT "%a %d %b %Y %T %z"
}
Changes to library/msgs/fr_ch.msg.
1
2
3
4
5
6





7
1





2
3
4
5
6


-
-
-
-
-
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset fr_CH DATE_FORMAT "%d. %m. %y"
    ::msgcat::mcset fr_CH TIME_FORMAT "%T"
    ::msgcat::mcset fr_CH TIME_FORMAT_12 "%T"
    ::msgcat::mcset fr_CH DATE_TIME_FORMAT "%a %d %b %Y %T %z"

::msgcat::mcset fr_CH DATE_FORMAT "%d. %m. %y"
::msgcat::mcset fr_CH TIME_FORMAT "%T"
::msgcat::mcset fr_CH TIME_FORMAT_12 "%T"
::msgcat::mcset fr_CH DATE_TIME_FORMAT "%a %d %b %Y %T %z"
}
Changes to library/msgs/ga.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ga DAYS_OF_WEEK_ABBREV [list \
        "Domh"\
        "Luan"\
        "Máirt"\
        "Céad"\
        "Déar"\
        "Aoine"\
        "Sath"]
    ::msgcat::mcset ga DAYS_OF_WEEK_FULL [list \
        "Dé Domhnaigh"\
        "Dé Luain"\
        "Dé Máirt"\
        "Dé Céadaoin"\
        "Déardaoin"\
        "Dé hAoine"\
        "Dé Sathairn"]
    ::msgcat::mcset ga MONTHS_ABBREV [list \
        "Ean"\
        "Feabh"\
        "Márta"\
        "Aib"\
        "Beal"\
        "Meith"\
        "Iúil"\
        "Lún"\
        "MFómh"\
        "DFómh"\
        "Samh"\
        "Noll"\
        ""]
    ::msgcat::mcset ga MONTHS_FULL [list \
        "Eanáir"\
        "Feabhra"\
        "Márta"\
        "Aibreán"\
        "Mí na Bealtaine"\
        "Meith"\
        "Iúil"\
        "Lúnasa"\
        "Meán Fómhair"\
        "Deireadh Fómhair"\
        "Mí na Samhna"\
        "Mí na Nollag"\
        ""]

::msgcat::mcset ga DAYS_OF_WEEK_ABBREV [list \
	"Domh"\
	"Luan"\
	"Máirt"\
	"Céad"\
	"Déar"\
	"Aoine"\
	"Sath"]
::msgcat::mcset ga DAYS_OF_WEEK_FULL [list \
	"Dé Domhnaigh"\
	"Dé Luain"\
	"Dé Máirt"\
	"Dé Céadaoin"\
	"Déardaoin"\
	"Dé hAoine"\
	"Dé Sathairn"]
::msgcat::mcset ga MONTHS_ABBREV [list \
	"Ean"\
	"Feabh"\
	"Márta"\
	"Aib"\
	"Beal"\
	"Meith"\
	"Iúil"\
	"Lún"\
	"MFómh"\
	"DFómh"\
	"Samh"\
	"Noll"\
	""]
::msgcat::mcset ga MONTHS_FULL [list \
	"Eanáir"\
	"Feabhra"\
	"Márta"\
	"Aibreán"\
	"Mí na Bealtaine"\
	"Meith"\
	"Iúil"\
	"Lúnasa"\
	"Meán Fómhair"\
	"Deireadh Fómhair"\
	"Mí na Samhna"\
	"Mí na Nollag"\
	""]
}
Changes to library/msgs/ga_ie.msg.
1
2
3
4
5
6





7
1





2
3
4
5
6


-
-
-
-
-
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ga_IE DATE_FORMAT "%d.%m.%y"
    ::msgcat::mcset ga_IE TIME_FORMAT "%T"
    ::msgcat::mcset ga_IE TIME_FORMAT_12 "%T"
    ::msgcat::mcset ga_IE DATE_TIME_FORMAT "%a %d %b %Y %T %z"

::msgcat::mcset ga_IE DATE_FORMAT "%d.%m.%y"
::msgcat::mcset ga_IE TIME_FORMAT "%T"
::msgcat::mcset ga_IE TIME_FORMAT_12 "%T"
::msgcat::mcset ga_IE DATE_TIME_FORMAT "%a %d %b %Y %T %z"
}
Changes to library/msgs/gl.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset gl DAYS_OF_WEEK_ABBREV [list \
        "Dom"\
        "Lun"\
        "Mar"\
        "Mér"\
        "Xov"\
        "Ven"\
        "Sáb"]
    ::msgcat::mcset gl DAYS_OF_WEEK_FULL [list \
        "Domingo"\
        "Luns"\
        "Martes"\
        "Mércores"\
        "Xoves"\
        "Venres"\
        "Sábado"]
    ::msgcat::mcset gl MONTHS_ABBREV [list \
        "Xan"\
        "Feb"\
        "Mar"\
        "Abr"\
        "Mai"\
        "Xuñ"\
        "Xul"\
        "Ago"\
        "Set"\
        "Out"\
        "Nov"\
        "Dec"\
        ""]
    ::msgcat::mcset gl MONTHS_FULL [list \
        "Xaneiro"\
        "Febreiro"\
        "Marzo"\
        "Abril"\
        "Maio"\
        "Xuño"\
        "Xullo"\
        "Agosto"\
        "Setembro"\
        "Outubro"\
        "Novembro"\
        "Decembro"\
        ""]

::msgcat::mcset gl DAYS_OF_WEEK_ABBREV [list \
	"Dom"\
	"Lun"\
	"Mar"\
	"Mér"\
	"Xov"\
	"Ven"\
	"Sáb"]
::msgcat::mcset gl DAYS_OF_WEEK_FULL [list \
	"Domingo"\
	"Luns"\
	"Martes"\
	"Mércores"\
	"Xoves"\
	"Venres"\
	"Sábado"]
::msgcat::mcset gl MONTHS_ABBREV [list \
	"Xan"\
	"Feb"\
	"Mar"\
	"Abr"\
	"Mai"\
	"Xuñ"\
	"Xul"\
	"Ago"\
	"Set"\
	"Out"\
	"Nov"\
	"Dec"\
	""]
::msgcat::mcset gl MONTHS_FULL [list \
	"Xaneiro"\
	"Febreiro"\
	"Marzo"\
	"Abril"\
	"Maio"\
	"Xuño"\
	"Xullo"\
	"Agosto"\
	"Setembro"\
	"Outubro"\
	"Novembro"\
	"Decembro"\
	""]
}
Changes to library/msgs/gl_es.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset gl_ES DATE_FORMAT "%d %B %Y"
    ::msgcat::mcset gl_ES TIME_FORMAT_12 "%l:%M:%S %P"
    ::msgcat::mcset gl_ES DATE_TIME_FORMAT "%d %B %Y %l:%M:%S %P %z"

::msgcat::mcset gl_ES DATE_FORMAT "%d %B %Y"
::msgcat::mcset gl_ES TIME_FORMAT_12 "%l:%M:%S %P"
::msgcat::mcset gl_ES DATE_TIME_FORMAT "%d %B %Y %l:%M:%S %P %z"
}
Changes to library/msgs/gv.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset gv DAYS_OF_WEEK_ABBREV [list \
        "Jed"\
        "Jel"\
        "Jem"\
        "Jerc"\
        "Jerd"\
        "Jeh"\
        "Jes"]
    ::msgcat::mcset gv DAYS_OF_WEEK_FULL [list \
        "Jedoonee"\
        "Jelhein"\
        "Jemayrt"\
        "Jercean"\
        "Jerdein"\
        "Jeheiney"\
        "Jesarn"]
    ::msgcat::mcset gv MONTHS_ABBREV [list \
        "J-guer"\
        "T-arree"\
        "Mayrnt"\
        "Avrril"\
        "Boaldyn"\
        "M-souree"\
        "J-souree"\
        "Luanistyn"\
        "M-fouyir"\
        "J-fouyir"\
        "M.Houney"\
        "M.Nollick"\
        ""]
    ::msgcat::mcset gv MONTHS_FULL [list \
        "Jerrey-geuree"\
        "Toshiaght-arree"\
        "Mayrnt"\
        "Averil"\
        "Boaldyn"\
        "Mean-souree"\
        "Jerrey-souree"\
        "Luanistyn"\
        "Mean-fouyir"\
        "Jerrey-fouyir"\
        "Mee Houney"\
        "Mee ny Nollick"\
        ""]

::msgcat::mcset gv DAYS_OF_WEEK_ABBREV [list \
	"Jed"\
	"Jel"\
	"Jem"\
	"Jerc"\
	"Jerd"\
	"Jeh"\
	"Jes"]
::msgcat::mcset gv DAYS_OF_WEEK_FULL [list \
	"Jedoonee"\
	"Jelhein"\
	"Jemayrt"\
	"Jercean"\
	"Jerdein"\
	"Jeheiney"\
	"Jesarn"]
::msgcat::mcset gv MONTHS_ABBREV [list \
	"J-guer"\
	"T-arree"\
	"Mayrnt"\
	"Avrril"\
	"Boaldyn"\
	"M-souree"\
	"J-souree"\
	"Luanistyn"\
	"M-fouyir"\
	"J-fouyir"\
	"M.Houney"\
	"M.Nollick"\
	""]
::msgcat::mcset gv MONTHS_FULL [list \
	"Jerrey-geuree"\
	"Toshiaght-arree"\
	"Mayrnt"\
	"Averil"\
	"Boaldyn"\
	"Mean-souree"\
	"Jerrey-souree"\
	"Luanistyn"\
	"Mean-fouyir"\
	"Jerrey-fouyir"\
	"Mee Houney"\
	"Mee ny Nollick"\
	""]
}
Changes to library/msgs/gv_gb.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset gv_GB DATE_FORMAT "%d %B %Y"
    ::msgcat::mcset gv_GB TIME_FORMAT_12 "%l:%M:%S %P"
    ::msgcat::mcset gv_GB DATE_TIME_FORMAT "%d %B %Y %l:%M:%S %P %z"

::msgcat::mcset gv_GB DATE_FORMAT "%d %B %Y"
::msgcat::mcset gv_GB TIME_FORMAT_12 "%l:%M:%S %P"
::msgcat::mcset gv_GB DATE_TIME_FORMAT "%d %B %Y %l:%M:%S %P %z"
}
Changes to library/msgs/he.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset he DAYS_OF_WEEK_ABBREV [list \
        "א"\
        "ב"\
        "ג"\
        "ד"\
        "ה"\
        "ו"\
        "ש"]
    ::msgcat::mcset he DAYS_OF_WEEK_FULL [list \
        "יום ראשון"\
        "יום שני"\
        "יום שלישי"\
        "יום רביעי"\
        "יום חמישי"\
        "יום שישי"\
        "שבת"]
    ::msgcat::mcset he MONTHS_ABBREV [list \
        "ינו"\
        "פבר"\
        "מרץ"\
        "אפר"\
        "מאי"\
        "יונ"\
        "יול"\
        "אוג"\
        "ספט"\
        "אוק"\
        "נוב"\
        "דצמ"\
        ""]
    ::msgcat::mcset he MONTHS_FULL [list \
        "ינואר"\
        "פברואר"\
        "מרץ"\
        "אפריל"\
        "מאי"\
        "יוני"\
        "יולי"\
        "אוגוסט"\
        "ספטמבר"\
        "אוקטובר"\
        "נובמבר"\
        "דצמבר"\
        ""]
    ::msgcat::mcset he BCE "לסה"נ"
    ::msgcat::mcset he CE "לפסה"נ"
    ::msgcat::mcset he DATE_FORMAT "%d/%m/%Y"
    ::msgcat::mcset he TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset he DATE_TIME_FORMAT "%d/%m/%Y %H:%M:%S %z"

::msgcat::mcset he DAYS_OF_WEEK_ABBREV [list \
	"א"\
	"ב"\
	"ג"\
	"ד"\
	"ה"\
	"ו"\
	"ש"]
::msgcat::mcset he DAYS_OF_WEEK_FULL [list \
	"יום ראשון"\
	"יום שני"\
	"יום שלישי"\
	"יום רביעי"\
	"יום חמישי"\
	"יום שישי"\
	"שבת"]
::msgcat::mcset he MONTHS_ABBREV [list \
	"ינו"\
	"פבר"\
	"מרץ"\
	"אפר"\
	"מאי"\
	"יונ"\
	"יול"\
	"אוג"\
	"ספט"\
	"אוק"\
	"נוב"\
	"דצמ"\
	""]
::msgcat::mcset he MONTHS_FULL [list \
	"ינואר"\
	"פברואר"\
	"מרץ"\
	"אפריל"\
	"מאי"\
	"יוני"\
	"יולי"\
	"אוגוסט"\
	"ספטמבר"\
	"אוקטובר"\
	"נובמבר"\
	"דצמבר"\
	""]
::msgcat::mcset he BCE "לסה"נ"
::msgcat::mcset he CE "לפסה"נ"
::msgcat::mcset he DATE_FORMAT "%d/%m/%Y"
::msgcat::mcset he TIME_FORMAT "%H:%M:%S"
::msgcat::mcset he DATE_TIME_FORMAT "%d/%m/%Y %H:%M:%S %z"
}
Changes to library/msgs/hi.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset hi DAYS_OF_WEEK_FULL [list \
        "रविवार"\
        "सोमवार"\
        "मंगलवार"\
        "बुधवार"\
        "गुरुवार"\
        "शुक्रवार"\
        "शनिवार"]
    ::msgcat::mcset hi MONTHS_ABBREV [list \
        "जनवरी"\
        "फ़रवरी"\
        "मार्च"\
        "अप्रेल"\
        "मई"\
        "जून"\
        "जुलाई"\
        "अगस्त"\
        "सितम्बर"\
        "अक्टूबर"\
        "नवम्बर"\
        "दिसम्बर"]
    ::msgcat::mcset hi MONTHS_FULL [list \
        "जनवरी"\
        "फ़रवरी"\
        "मार्च"\
        "अप्रेल"\
        "मई"\
        "जून"\
        "जुलाई"\
        "अगस्त"\
        "सितम्बर"\
        "अक्टूबर"\
        "नवम्बर"\
        "दिसम्बर"]
    ::msgcat::mcset hi AM "ईसापूर्व"
    ::msgcat::mcset hi PM "."

::msgcat::mcset hi DAYS_OF_WEEK_FULL [list \
	"रविवार"\
	"सोमवार"\
	"मंगलवार"\
	"बुधवार"\
	"गुरुवार"\
	"शुक्रवार"\
	"शनिवार"]
::msgcat::mcset hi MONTHS_ABBREV [list \
	"जनवरी"\
	"फ़रवरी"\
	"मार्च"\
	"अप्रेल"\
	"मई"\
	"जून"\
	"जुलाई"\
	"अगस्त"\
	"सितम्बर"\
	"अक्टूबर"\
	"नवम्बर"\
	"दिसम्बर"]
::msgcat::mcset hi MONTHS_FULL [list \
	"जनवरी"\
	"फ़रवरी"\
	"मार्च"\
	"अप्रेल"\
	"मई"\
	"जून"\
	"जुलाई"\
	"अगस्त"\
	"सितम्बर"\
	"अक्टूबर"\
	"नवम्बर"\
	"दिसम्बर"]
::msgcat::mcset hi AM "ईसापूर्व"
::msgcat::mcset hi PM "."
}
Changes to library/msgs/hi_in.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset hi_IN DATE_FORMAT "%d %M %Y"
    ::msgcat::mcset hi_IN TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset hi_IN DATE_TIME_FORMAT "%d %M %Y %I:%M:%S %P %z"

::msgcat::mcset hi_IN DATE_FORMAT "%d %M %Y"
::msgcat::mcset hi_IN TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset hi_IN DATE_TIME_FORMAT "%d %M %Y %I:%M:%S %P %z"
}
Changes to library/msgs/hr.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset hr DAYS_OF_WEEK_ABBREV [list \
        "ned"\
        "pon"\
        "uto"\
        "sri"\
        "čet"\
        "pet"\
        "sub"]
    ::msgcat::mcset hr DAYS_OF_WEEK_FULL [list \
        "nedjelja"\
        "ponedjeljak"\
        "utorak"\
        "srijeda"\
        "četvrtak"\
        "petak"\
        "subota"]
    ::msgcat::mcset hr MONTHS_ABBREV [list \
        "sij"\
        "vel"\
        "ožu"\
        "tra"\
        "svi"\
        "lip"\
        "srp"\
        "kol"\
        "ruj"\
        "lis"\
        "stu"\
        "pro"\
        ""]
    ::msgcat::mcset hr MONTHS_FULL [list \
        "siječanj"\
        "veljača"\
        "ožujak"\
        "travanj"\
        "svibanj"\
        "lipanj"\
        "srpanj"\
        "kolovoz"\
        "rujan"\
        "listopad"\
        "studeni"\
        "prosinac"\
        ""]
    ::msgcat::mcset hr DATE_FORMAT "%Y.%m.%d"
    ::msgcat::mcset hr TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset hr DATE_TIME_FORMAT "%Y.%m.%d %H:%M:%S %z"

::msgcat::mcset hr DAYS_OF_WEEK_ABBREV [list \
	"ned"\
	"pon"\
	"uto"\
	"sri"\
	"čet"\
	"pet"\
	"sub"]
::msgcat::mcset hr DAYS_OF_WEEK_FULL [list \
	"nedjelja"\
	"ponedjeljak"\
	"utorak"\
	"srijeda"\
	"četvrtak"\
	"petak"\
	"subota"]
::msgcat::mcset hr MONTHS_ABBREV [list \
	"sij"\
	"vel"\
	"ožu"\
	"tra"\
	"svi"\
	"lip"\
	"srp"\
	"kol"\
	"ruj"\
	"lis"\
	"stu"\
	"pro"\
	""]
::msgcat::mcset hr MONTHS_FULL [list \
	"siječanj"\
	"veljača"\
	"ožujak"\
	"travanj"\
	"svibanj"\
	"lipanj"\
	"srpanj"\
	"kolovoz"\
	"rujan"\
	"listopad"\
	"studeni"\
	"prosinac"\
	""]
::msgcat::mcset hr DATE_FORMAT "%Y.%m.%d"
::msgcat::mcset hr TIME_FORMAT "%H:%M:%S"
::msgcat::mcset hr DATE_TIME_FORMAT "%Y.%m.%d %H:%M:%S %z"
}
Changes to library/msgs/hu.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset hu DAYS_OF_WEEK_ABBREV [list \
        "V"\
        "H"\
        "K"\
        "Sze"\
        "Cs"\
        "P"\
        "Szo"]
    ::msgcat::mcset hu DAYS_OF_WEEK_FULL [list \
        "vasárnap"\
        "hétfő"\
        "kedd"\
        "szerda"\
        "csütörtök"\
        "péntek"\
        "szombat"]
    ::msgcat::mcset hu MONTHS_ABBREV [list \
        "jan."\
        "febr."\
        "márc."\
        "ápr."\
        "máj."\
        "jún."\
        "júl."\
        "aug."\
        "szept."\
        "okt."\
        "nov."\
        "dec."\
        ""]
    ::msgcat::mcset hu MONTHS_FULL [list \
        "január"\
        "február"\
        "március"\
        "április"\
        "május"\
        "június"\
        "július"\
        "augusztus"\
        "szeptember"\
        "október"\
        "november"\
        "december"\
        ""]
    ::msgcat::mcset hu BCE "i.e."
    ::msgcat::mcset hu CE "i.u."
    ::msgcat::mcset hu AM "DE"
    ::msgcat::mcset hu PM "DU"
    ::msgcat::mcset hu DATE_FORMAT "%Y.%m.%d."
    ::msgcat::mcset hu TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset hu DATE_TIME_FORMAT "%Y.%m.%d. %k:%M:%S %z"

::msgcat::mcset hu DAYS_OF_WEEK_ABBREV [list \
	"V"\
	"H"\
	"K"\
	"Sze"\
	"Cs"\
	"P"\
	"Szo"]
::msgcat::mcset hu DAYS_OF_WEEK_FULL [list \
	"vasárnap"\
	"hétfő"\
	"kedd"\
	"szerda"\
	"csütörtök"\
	"péntek"\
	"szombat"]
::msgcat::mcset hu MONTHS_ABBREV [list \
	"jan."\
	"febr."\
	"márc."\
	"ápr."\
	"máj."\
	"jún."\
	"júl."\
	"aug."\
	"szept."\
	"okt."\
	"nov."\
	"dec."\
	""]
::msgcat::mcset hu MONTHS_FULL [list \
	"január"\
	"február"\
	"március"\
	"április"\
	"május"\
	"június"\
	"július"\
	"augusztus"\
	"szeptember"\
	"október"\
	"november"\
	"december"\
	""]
::msgcat::mcset hu BCE "i.e."
::msgcat::mcset hu CE "i.u."
::msgcat::mcset hu AM "DE"
::msgcat::mcset hu PM "DU"
::msgcat::mcset hu DATE_FORMAT "%Y.%m.%d."
::msgcat::mcset hu TIME_FORMAT "%k:%M:%S"
::msgcat::mcset hu DATE_TIME_FORMAT "%Y.%m.%d. %k:%M:%S %z"
}
Changes to library/msgs/id.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset id DAYS_OF_WEEK_ABBREV [list \
        "Min"\
        "Sen"\
        "Sel"\
        "Rab"\
        "Kam"\
        "Jum"\
        "Sab"]
    ::msgcat::mcset id DAYS_OF_WEEK_FULL [list \
        "Minggu"\
        "Senin"\
        "Selasa"\
        "Rabu"\
        "Kamis"\
        "Jumat"\
        "Sabtu"]
    ::msgcat::mcset id MONTHS_ABBREV [list \
        "Jan"\
        "Peb"\
        "Mar"\
        "Apr"\
        "Mei"\
        "Jun"\
        "Jul"\
        "Agu"\
        "Sep"\
        "Okt"\
        "Nov"\
        "Des"\
        ""]
    ::msgcat::mcset id MONTHS_FULL [list \
        "Januari"\
        "Pebruari"\
        "Maret"\
        "April"\
        "Mei"\
        "Juni"\
        "Juli"\
        "Agustus"\
        "September"\
        "Oktober"\
        "November"\
        "Desember"\
        ""]

::msgcat::mcset id DAYS_OF_WEEK_ABBREV [list \
	"Min"\
	"Sen"\
	"Sel"\
	"Rab"\
	"Kam"\
	"Jum"\
	"Sab"]
::msgcat::mcset id DAYS_OF_WEEK_FULL [list \
	"Minggu"\
	"Senin"\
	"Selasa"\
	"Rabu"\
	"Kamis"\
	"Jumat"\
	"Sabtu"]
::msgcat::mcset id MONTHS_ABBREV [list \
	"Jan"\
	"Peb"\
	"Mar"\
	"Apr"\
	"Mei"\
	"Jun"\
	"Jul"\
	"Agu"\
	"Sep"\
	"Okt"\
	"Nov"\
	"Des"\
	""]
::msgcat::mcset id MONTHS_FULL [list \
	"Januari"\
	"Pebruari"\
	"Maret"\
	"April"\
	"Mei"\
	"Juni"\
	"Juli"\
	"Agustus"\
	"September"\
	"Oktober"\
	"November"\
	"Desember"\
	""]
}
Changes to library/msgs/id_id.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset id_ID DATE_FORMAT "%d %B %Y"
    ::msgcat::mcset id_ID TIME_FORMAT_12 "%l:%M:%S %P"
    ::msgcat::mcset id_ID DATE_TIME_FORMAT "%d %B %Y %l:%M:%S %P %z"

::msgcat::mcset id_ID DATE_FORMAT "%d %B %Y"
::msgcat::mcset id_ID TIME_FORMAT_12 "%l:%M:%S %P"
::msgcat::mcset id_ID DATE_TIME_FORMAT "%d %B %Y %l:%M:%S %P %z"
}
Changes to library/msgs/is.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset is DAYS_OF_WEEK_ABBREV [list \
        "sun."\
        "mán."\
        "þri."\
        "mið."\
        "fim."\
        "fös."\
        "lau."]
    ::msgcat::mcset is DAYS_OF_WEEK_FULL [list \
        "sunnudagur"\
        "mánudagur"\
        "þriðjudagur"\
        "miðvikudagur"\
        "fimmtudagur"\
        "föstudagur"\
        "laugardagur"]
    ::msgcat::mcset is MONTHS_ABBREV [list \
        "jan."\
        "feb."\
        "mar."\
        "apr."\
        "maí"\
        "jún."\
        "júl."\
        "ágú."\
        "sep."\
        "okt."\
        "nóv."\
        "des."\
        ""]
    ::msgcat::mcset is MONTHS_FULL [list \
        "janúar"\
        "febrúar"\
        "mars"\
        "apríl"\
        "maí"\
        "júní"\
        "júlí"\
        "ágúst"\
        "september"\
        "október"\
        "nóvember"\
        "desember"\
        ""]
    ::msgcat::mcset is DATE_FORMAT "%e.%m.%Y"
    ::msgcat::mcset is TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset is DATE_TIME_FORMAT "%e.%m.%Y %H:%M:%S %z"

::msgcat::mcset is DAYS_OF_WEEK_ABBREV [list \
	"sun."\
	"mán."\
	"þri."\
	"mið."\
	"fim."\
	"fös."\
	"lau."]
::msgcat::mcset is DAYS_OF_WEEK_FULL [list \
	"sunnudagur"\
	"mánudagur"\
	"þriðjudagur"\
	"miðvikudagur"\
	"fimmtudagur"\
	"föstudagur"\
	"laugardagur"]
::msgcat::mcset is MONTHS_ABBREV [list \
	"jan."\
	"feb."\
	"mar."\
	"apr."\
	"maí"\
	"jún."\
	"júl."\
	"ágú."\
	"sep."\
	"okt."\
	"nóv."\
	"des."\
	""]
::msgcat::mcset is MONTHS_FULL [list \
	"janúar"\
	"febrúar"\
	"mars"\
	"apríl"\
	"maí"\
	"júní"\
	"júlí"\
	"ágúst"\
	"september"\
	"október"\
	"nóvember"\
	"desember"\
	""]
::msgcat::mcset is DATE_FORMAT "%e.%m.%Y"
::msgcat::mcset is TIME_FORMAT "%H:%M:%S"
::msgcat::mcset is DATE_TIME_FORMAT "%e.%m.%Y %H:%M:%S %z"
}
Changes to library/msgs/it.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset it DAYS_OF_WEEK_ABBREV [list \
        "dom"\
        "lun"\
        "mar"\
        "mer"\
        "gio"\
        "ven"\
        "sab"]
    ::msgcat::mcset it DAYS_OF_WEEK_FULL [list \
        "domenica"\
        "lunedì"\
        "martedì"\
        "mercoledì"\
        "giovedì"\
        "venerdì"\
        "sabato"]
    ::msgcat::mcset it MONTHS_ABBREV [list \
        "gen"\
        "feb"\
        "mar"\
        "apr"\
        "mag"\
        "giu"\
        "lug"\
        "ago"\
        "set"\
        "ott"\
        "nov"\
        "dic"\
        ""]
    ::msgcat::mcset it MONTHS_FULL [list \
        "gennaio"\
        "febbraio"\
        "marzo"\
        "aprile"\
        "maggio"\
        "giugno"\
        "luglio"\
        "agosto"\
        "settembre"\
        "ottobre"\
        "novembre"\
        "dicembre"\
        ""]
    ::msgcat::mcset it BCE "aC"
    ::msgcat::mcset it CE "dC"
    ::msgcat::mcset it AM "m."
    ::msgcat::mcset it PM "p."
    ::msgcat::mcset it DATE_FORMAT "%d %B %Y"
    ::msgcat::mcset it TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset it DATE_TIME_FORMAT "%d %B %Y %H:%M:%S %z"

::msgcat::mcset it DAYS_OF_WEEK_ABBREV [list \
	"dom"\
	"lun"\
	"mar"\
	"mer"\
	"gio"\
	"ven"\
	"sab"]
::msgcat::mcset it DAYS_OF_WEEK_FULL [list \
	"domenica"\
	"lunedì"\
	"martedì"\
	"mercoledì"\
	"giovedì"\
	"venerdì"\
	"sabato"]
::msgcat::mcset it MONTHS_ABBREV [list \
	"gen"\
	"feb"\
	"mar"\
	"apr"\
	"mag"\
	"giu"\
	"lug"\
	"ago"\
	"set"\
	"ott"\
	"nov"\
	"dic"\
	""]
::msgcat::mcset it MONTHS_FULL [list \
	"gennaio"\
	"febbraio"\
	"marzo"\
	"aprile"\
	"maggio"\
	"giugno"\
	"luglio"\
	"agosto"\
	"settembre"\
	"ottobre"\
	"novembre"\
	"dicembre"\
	""]
::msgcat::mcset it BCE "aC"
::msgcat::mcset it CE "dC"
::msgcat::mcset it AM "m."
::msgcat::mcset it PM "p."
::msgcat::mcset it DATE_FORMAT "%d %B %Y"
::msgcat::mcset it TIME_FORMAT "%H:%M:%S"
::msgcat::mcset it DATE_TIME_FORMAT "%d %B %Y %H:%M:%S %z"
}
Changes to library/msgs/it_ch.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset it_CH DATE_FORMAT "%e. %B %Y"
    ::msgcat::mcset it_CH TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset it_CH DATE_TIME_FORMAT "%e. %B %Y %H:%M:%S %z"

::msgcat::mcset it_CH DATE_FORMAT "%e. %B %Y"
::msgcat::mcset it_CH TIME_FORMAT "%H:%M:%S"
::msgcat::mcset it_CH DATE_TIME_FORMAT "%e. %B %Y %H:%M:%S %z"
}
Changes to library/msgs/ja.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ja DAYS_OF_WEEK_ABBREV [list \
        "日"\
        "月"\
        "火"\
        "水"\
        "木"\
        "金"\
        "土"]
    ::msgcat::mcset ja DAYS_OF_WEEK_FULL [list \
        "日曜日"\
        "月曜日"\
        "火曜日"\
        "水曜日"\
        "木曜日"\
        "金曜日"\
        "土曜日"]
    ::msgcat::mcset ja MONTHS_FULL [list \
        "1月"\
        "2月"\
        "3月"\
        "4月"\
        "5月"\
        "6月"\
        "7月"\
        "8月"\
        "9月"\
        "10月"\
        "11月"\
        "12月"]
    ::msgcat::mcset ja BCE "紀元前"
    ::msgcat::mcset ja CE "西暦"
    ::msgcat::mcset ja AM "午前"
    ::msgcat::mcset ja PM "午後"
    ::msgcat::mcset ja DATE_FORMAT "%Y/%m/%d"
    ::msgcat::mcset ja TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset ja TIME_FORMAT_12 "%P %I:%M:%S"
    ::msgcat::mcset ja DATE_TIME_FORMAT "%Y/%m/%d %k:%M:%S %z"
    ::msgcat::mcset ja LOCALE_DATE_FORMAT "%EY年%m月%d日"
    ::msgcat::mcset ja LOCALE_TIME_FORMAT "%H時%M分%S秒"
    ::msgcat::mcset ja LOCALE_DATE_TIME_FORMAT "%EY年%m月%d日 (%a) %H時%M分%S秒 %z"
    ::msgcat::mcset ja LOCALE_ERAS "{-9223372036854775808 西暦 0} {-3061011600 明治 1867} {-1812186000 大正 1911} {-1357635600 昭和 1925} {600220800 平成 1988} {1556668800 令和 2018}"

::msgcat::mcset ja DAYS_OF_WEEK_ABBREV [list \
	"日"\
	"月"\
	"火"\
	"水"\
	"木"\
	"金"\
	"土"]
::msgcat::mcset ja DAYS_OF_WEEK_FULL [list \
	"日曜日"\
	"月曜日"\
	"火曜日"\
	"水曜日"\
	"木曜日"\
	"金曜日"\
	"土曜日"]
::msgcat::mcset ja MONTHS_FULL [list \
	"1月"\
	"2月"\
	"3月"\
	"4月"\
	"5月"\
	"6月"\
	"7月"\
	"8月"\
	"9月"\
	"10月"\
	"11月"\
	"12月"]
::msgcat::mcset ja BCE "紀元前"
::msgcat::mcset ja CE "西暦"
::msgcat::mcset ja AM "午前"
::msgcat::mcset ja PM "午後"
::msgcat::mcset ja DATE_FORMAT "%Y/%m/%d"
::msgcat::mcset ja TIME_FORMAT "%k:%M:%S"
::msgcat::mcset ja TIME_FORMAT_12 "%P %I:%M:%S"
::msgcat::mcset ja DATE_TIME_FORMAT "%Y/%m/%d %k:%M:%S %z"
::msgcat::mcset ja LOCALE_DATE_FORMAT "%EY年%m月%d日"
::msgcat::mcset ja LOCALE_TIME_FORMAT "%H時%M分%S秒"
::msgcat::mcset ja LOCALE_DATE_TIME_FORMAT "%EY年%m月%d日 (%a) %H時%M分%S秒 %z"
::msgcat::mcset ja LOCALE_ERAS "{-9223372036854775808 西暦 0} {-3061011600 明治 1867} {-1812186000 大正 1911} {-1357635600 昭和 1925} {600220800 平成 1988} {1556668800 令和 2018}"
}
Changes to library/msgs/kl.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset kl DAYS_OF_WEEK_ABBREV [list \
        "sab"\
        "ata"\
        "mar"\
        "pin"\
        "sis"\
        "tal"\
        "arf"]
    ::msgcat::mcset kl DAYS_OF_WEEK_FULL [list \
        "sabaat"\
        "ataasinngorneq"\
        "marlunngorneq"\
        "pingasunngorneq"\
        "sisamanngorneq"\
        "tallimanngorneq"\
        "arfininngorneq"]
    ::msgcat::mcset kl MONTHS_ABBREV [list \
        "jan"\
        "feb"\
        "mar"\
        "apr"\
        "maj"\
        "jun"\
        "jul"\
        "aug"\
        "sep"\
        "okt"\
        "nov"\
        "dec"\
        ""]
    ::msgcat::mcset kl MONTHS_FULL [list \
        "januari"\
        "februari"\
        "martsi"\
        "aprili"\
        "maji"\
        "juni"\
        "juli"\
        "augustusi"\
        "septemberi"\
        "oktoberi"\
        "novemberi"\
        "decemberi"\
        ""]

::msgcat::mcset kl DAYS_OF_WEEK_ABBREV [list \
	"sab"\
	"ata"\
	"mar"\
	"pin"\
	"sis"\
	"tal"\
	"arf"]
::msgcat::mcset kl DAYS_OF_WEEK_FULL [list \
	"sabaat"\
	"ataasinngorneq"\
	"marlunngorneq"\
	"pingasunngorneq"\
	"sisamanngorneq"\
	"tallimanngorneq"\
	"arfininngorneq"]
::msgcat::mcset kl MONTHS_ABBREV [list \
	"jan"\
	"feb"\
	"mar"\
	"apr"\
	"maj"\
	"jun"\
	"jul"\
	"aug"\
	"sep"\
	"okt"\
	"nov"\
	"dec"\
	""]
::msgcat::mcset kl MONTHS_FULL [list \
	"januari"\
	"februari"\
	"martsi"\
	"aprili"\
	"maji"\
	"juni"\
	"juli"\
	"augustusi"\
	"septemberi"\
	"oktoberi"\
	"novemberi"\
	"decemberi"\
	""]
}
Changes to library/msgs/kl_gl.msg.
1
2
3
4
5
6





7
1





2
3
4
5
6


-
-
-
-
-
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset kl_GL DATE_FORMAT "%d %b %Y"
    ::msgcat::mcset kl_GL TIME_FORMAT "%T"
    ::msgcat::mcset kl_GL TIME_FORMAT_12 "%T"
    ::msgcat::mcset kl_GL DATE_TIME_FORMAT "%a %d %b %Y %T %z"

::msgcat::mcset kl_GL DATE_FORMAT "%d %b %Y"
::msgcat::mcset kl_GL TIME_FORMAT "%T"
::msgcat::mcset kl_GL TIME_FORMAT_12 "%T"
::msgcat::mcset kl_GL DATE_TIME_FORMAT "%a %d %b %Y %T %z"
}
Changes to library/msgs/ko.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ko DAYS_OF_WEEK_ABBREV [list \
        "일"\
        "월"\
        "화"\
        "수"\
        "목"\
        "금"\
        "토"]
    ::msgcat::mcset ko DAYS_OF_WEEK_FULL [list \
        "일요일"\
        "월요일"\
        "화요일"\
        "수요일"\
        "목요일"\
        "금요일"\
        "토요일"]
    ::msgcat::mcset ko MONTHS_ABBREV [list \
        "1월"\
        "2월"\
        "3월"\
        "4월"\
        "5월"\
        "6월"\
        "7월"\
        "8월"\
        "9월"\
        "10월"\
        "11월"\
        "12월"\
        ""]
    ::msgcat::mcset ko MONTHS_FULL [list \
        "1월"\
        "2월"\
        "3월"\
        "4월"\
        "5월"\
        "6월"\
        "7월"\
        "8월"\
        "9월"\
        "10월"\
        "11월"\
        "12월"\
        ""]
    ::msgcat::mcset ko AM "오전"
    ::msgcat::mcset ko PM "오후"
    ::msgcat::mcset ko DATE_FORMAT "%Y-%m-%d"
    ::msgcat::mcset ko TIME_FORMAT_12 "%P %l:%M:%S"
    ::msgcat::mcset ko DATE_TIME_FORMAT "%Y-%m-%d %P %l:%M:%S %z"
    ::msgcat::mcset ko LOCALE_DATE_FORMAT "%Y년%B%Od일"
    ::msgcat::mcset ko LOCALE_TIME_FORMAT "%H시%M분%S초"
    ::msgcat::mcset ko LOCALE_DATE_TIME_FORMAT "%A %Y년%B%Od일%H시%M분%S초 %z"

::msgcat::mcset ko DAYS_OF_WEEK_ABBREV [list \
	"일"\
	"월"\
	"화"\
	"수"\
	"목"\
	"금"\
	"토"]
::msgcat::mcset ko DAYS_OF_WEEK_FULL [list \
	"일요일"\
	"월요일"\
	"화요일"\
	"수요일"\
	"목요일"\
	"금요일"\
	"토요일"]
::msgcat::mcset ko MONTHS_ABBREV [list \
	"1월"\
	"2월"\
	"3월"\
	"4월"\
	"5월"\
	"6월"\
	"7월"\
	"8월"\
	"9월"\
	"10월"\
	"11월"\
	"12월"\
	""]
::msgcat::mcset ko MONTHS_FULL [list \
	"1월"\
	"2월"\
	"3월"\
	"4월"\
	"5월"\
	"6월"\
	"7월"\
	"8월"\
	"9월"\
	"10월"\
	"11월"\
	"12월"\
	""]
::msgcat::mcset ko AM "오전"
::msgcat::mcset ko PM "오후"
::msgcat::mcset ko DATE_FORMAT "%Y-%m-%d"
::msgcat::mcset ko TIME_FORMAT_12 "%P %l:%M:%S"
::msgcat::mcset ko DATE_TIME_FORMAT "%Y-%m-%d %P %l:%M:%S %z"
::msgcat::mcset ko LOCALE_DATE_FORMAT "%Y년%B%Od일"
::msgcat::mcset ko LOCALE_TIME_FORMAT "%H시%M분%S초"
::msgcat::mcset ko LOCALE_DATE_TIME_FORMAT "%A %Y년%B%Od일%H시%M분%S초 %z"
}
Changes to library/msgs/ko_kr.msg.
1
2
3
4
5
6
7






8
1






2
3
4
5
6
7


-
-
-
-
-
-
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ko_KR BCE "기원전"
    ::msgcat::mcset ko_KR CE "서기"
    ::msgcat::mcset ko_KR DATE_FORMAT "%Y.%m.%d"
    ::msgcat::mcset ko_KR TIME_FORMAT_12 "%P %l:%M:%S"
    ::msgcat::mcset ko_KR DATE_TIME_FORMAT "%Y.%m.%d %P %l:%M:%S %z"

::msgcat::mcset ko_KR BCE "기원전"
::msgcat::mcset ko_KR CE "서기"
::msgcat::mcset ko_KR DATE_FORMAT "%Y.%m.%d"
::msgcat::mcset ko_KR TIME_FORMAT_12 "%P %l:%M:%S"
::msgcat::mcset ko_KR DATE_TIME_FORMAT "%Y.%m.%d %P %l:%M:%S %z"
}
Changes to library/msgs/kok.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset kok DAYS_OF_WEEK_FULL [list \
        "आदित्यवार"\
        "सोमवार"\
        "मंगळार"\
        "बुधवार"\
        "गुरुवार"\
        "शुक्रवार"\
        "शनिवार"]
    ::msgcat::mcset kok MONTHS_ABBREV [list \
        "जानेवारी"\
        "फेबृवारी"\
        "मार्च"\
        "एप्रिल"\
        "मे"\
        "जून"\
        "जुलै"\
        "ओगस्ट"\
        "सेप्टेंबर"\
        "ओक्टोबर"\
        "नोव्हेंबर"\
        "डिसेंबर"]
    ::msgcat::mcset kok MONTHS_FULL [list \
        "जानेवारी"\
        "फेब्रुवारी"\
        "मार्च"\
        "एप्रिल"\
        "मे"\
        "जून"\
        "जुलै"\
        "ओगस्ट"\
        "सेप्टेंबर"\
        "ओक्टोबर"\
        "नोव्हेंबर"\
        "डिसेंबर"]
    ::msgcat::mcset kok AM "क्रिस्तपूर्व"
    ::msgcat::mcset kok PM "क्रिस्तशखा"

::msgcat::mcset kok DAYS_OF_WEEK_FULL [list \
	"आदित्यवार"\
	"सोमवार"\
	"मंगळार"\
	"बुधवार"\
	"गुरुवार"\
	"शुक्रवार"\
	"शनिवार"]
::msgcat::mcset kok MONTHS_ABBREV [list \
	"जानेवारी"\
	"फेबृवारी"\
	"मार्च"\
	"एप्रिल"\
	"मे"\
	"जून"\
	"जुलै"\
	"ओगस्ट"\
	"सेप्टेंबर"\
	"ओक्टोबर"\
	"नोव्हेंबर"\
	"डिसेंबर"]
::msgcat::mcset kok MONTHS_FULL [list \
	"जानेवारी"\
	"फेब्रुवारी"\
	"मार्च"\
	"एप्रिल"\
	"मे"\
	"जून"\
	"जुलै"\
	"ओगस्ट"\
	"सेप्टेंबर"\
	"ओक्टोबर"\
	"नोव्हेंबर"\
	"डिसेंबर"]
::msgcat::mcset kok AM "क्रिस्तपूर्व"
::msgcat::mcset kok PM "क्रिस्तशखा"
}
Changes to library/msgs/kok_in.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset kok_IN DATE_FORMAT "%d %M %Y"
    ::msgcat::mcset kok_IN TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset kok_IN DATE_TIME_FORMAT "%d %M %Y %I:%M:%S %P %z"

::msgcat::mcset kok_IN DATE_FORMAT "%d %M %Y"
::msgcat::mcset kok_IN TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset kok_IN DATE_TIME_FORMAT "%d %M %Y %I:%M:%S %P %z"
}
Changes to library/msgs/kw.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset kw DAYS_OF_WEEK_ABBREV [list \
        "Sul"\
        "Lun"\
        "Mth"\
        "Mhr"\
        "Yow"\
        "Gwe"\
        "Sad"]
    ::msgcat::mcset kw DAYS_OF_WEEK_FULL [list \
        "De Sul"\
        "De Lun"\
        "De Merth"\
        "De Merher"\
        "De Yow"\
        "De Gwener"\
        "De Sadorn"]
    ::msgcat::mcset kw MONTHS_ABBREV [list \
        "Gen"\
        "Whe"\
        "Mer"\
        "Ebr"\
        "Me"\
        "Evn"\
        "Gor"\
        "Est"\
        "Gwn"\
        "Hed"\
        "Du"\
        "Kev"\
        ""]
    ::msgcat::mcset kw MONTHS_FULL [list \
        "Mys Genver"\
        "Mys Whevrel"\
        "Mys Merth"\
        "Mys Ebrel"\
        "Mys Me"\
        "Mys Evan"\
        "Mys Gortheren"\
        "Mye Est"\
        "Mys Gwyngala"\
        "Mys Hedra"\
        "Mys Du"\
        "Mys Kevardhu"\
        ""]

::msgcat::mcset kw DAYS_OF_WEEK_ABBREV [list \
	"Sul"\
	"Lun"\
	"Mth"\
	"Mhr"\
	"Yow"\
	"Gwe"\
	"Sad"]
::msgcat::mcset kw DAYS_OF_WEEK_FULL [list \
	"De Sul"\
	"De Lun"\
	"De Merth"\
	"De Merher"\
	"De Yow"\
	"De Gwener"\
	"De Sadorn"]
::msgcat::mcset kw MONTHS_ABBREV [list \
	"Gen"\
	"Whe"\
	"Mer"\
	"Ebr"\
	"Me"\
	"Evn"\
	"Gor"\
	"Est"\
	"Gwn"\
	"Hed"\
	"Du"\
	"Kev"\
	""]
::msgcat::mcset kw MONTHS_FULL [list \
	"Mys Genver"\
	"Mys Whevrel"\
	"Mys Merth"\
	"Mys Ebrel"\
	"Mys Me"\
	"Mys Evan"\
	"Mys Gortheren"\
	"Mye Est"\
	"Mys Gwyngala"\
	"Mys Hedra"\
	"Mys Du"\
	"Mys Kevardhu"\
	""]
}
Changes to library/msgs/kw_gb.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset kw_GB DATE_FORMAT "%d %B %Y"
    ::msgcat::mcset kw_GB TIME_FORMAT_12 "%l:%M:%S %P"
    ::msgcat::mcset kw_GB DATE_TIME_FORMAT "%d %B %Y %l:%M:%S %P %z"

::msgcat::mcset kw_GB DATE_FORMAT "%d %B %Y"
::msgcat::mcset kw_GB TIME_FORMAT_12 "%l:%M:%S %P"
::msgcat::mcset kw_GB DATE_TIME_FORMAT "%d %B %Y %l:%M:%S %P %z"
}
Changes to library/msgs/lt.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset lt DAYS_OF_WEEK_ABBREV [list \
        "Sk"\
        "Pr"\
        "An"\
        "Tr"\
        "Kt"\
        "Pn"\
        "Št"]
    ::msgcat::mcset lt DAYS_OF_WEEK_FULL [list \
        "Sekmadienis"\
        "Pirmadienis"\
        "Antradienis"\
        "Trečiadienis"\
        "Ketvirtadienis"\
        "Penktadienis"\
        "Šeštadienis"]
    ::msgcat::mcset lt MONTHS_ABBREV [list \
        "Sau"\
        "Vas"\
        "Kov"\
        "Bal"\
        "Geg"\
        "Bir"\
        "Lie"\
        "Rgp"\
        "Rgs"\
        "Spa"\
        "Lap"\
        "Grd"\
        ""]
    ::msgcat::mcset lt MONTHS_FULL [list \
        "Sausio"\
        "Vasario"\
        "Kovo"\
        "Balandžio"\
        "Gegužės"\
        "Birželio"\
        "Liepos"\
        "Rugpjūčio"\
        "Rugsėjo"\
        "Spalio"\
        "Lapkričio"\
        "Gruodžio"\
        ""]
    ::msgcat::mcset lt BCE "pr.Kr."
    ::msgcat::mcset lt CE "po.Kr."
    ::msgcat::mcset lt DATE_FORMAT "%Y.%m.%e"
    ::msgcat::mcset lt TIME_FORMAT "%H.%M.%S"
    ::msgcat::mcset lt DATE_TIME_FORMAT "%Y.%m.%e %H.%M.%S %z"

::msgcat::mcset lt DAYS_OF_WEEK_ABBREV [list \
	"Sk"\
	"Pr"\
	"An"\
	"Tr"\
	"Kt"\
	"Pn"\
	"Št"]
::msgcat::mcset lt DAYS_OF_WEEK_FULL [list \
	"Sekmadienis"\
	"Pirmadienis"\
	"Antradienis"\
	"Trečiadienis"\
	"Ketvirtadienis"\
	"Penktadienis"\
	"Šeštadienis"]
::msgcat::mcset lt MONTHS_ABBREV [list \
	"Sau"\
	"Vas"\
	"Kov"\
	"Bal"\
	"Geg"\
	"Bir"\
	"Lie"\
	"Rgp"\
	"Rgs"\
	"Spa"\
	"Lap"\
	"Grd"\
	""]
::msgcat::mcset lt MONTHS_FULL [list \
	"Sausio"\
	"Vasario"\
	"Kovo"\
	"Balandžio"\
	"Gegužės"\
	"Birželio"\
	"Liepos"\
	"Rugpjūčio"\
	"Rugsėjo"\
	"Spalio"\
	"Lapkričio"\
	"Gruodžio"\
	""]
::msgcat::mcset lt BCE "pr.Kr."
::msgcat::mcset lt CE "po.Kr."
::msgcat::mcset lt DATE_FORMAT "%Y.%m.%e"
::msgcat::mcset lt TIME_FORMAT "%H.%M.%S"
::msgcat::mcset lt DATE_TIME_FORMAT "%Y.%m.%e %H.%M.%S %z"
}
Changes to library/msgs/lv.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset lv DAYS_OF_WEEK_ABBREV [list \
        "Sv"\
        "P"\
        "O"\
        "T"\
        "C"\
        "Pk"\
        "S"]
    ::msgcat::mcset lv DAYS_OF_WEEK_FULL [list \
        "svētdiena"\
        "pirmdiena"\
        "otrdiena"\
        "trešdiena"\
        "ceturdien"\
        "piektdiena"\
        "sestdiena"]
    ::msgcat::mcset lv MONTHS_ABBREV [list \
        "Jan"\
        "Feb"\
        "Mar"\
        "Apr"\
        "Maijs"\
        "Jūn"\
        "Jūl"\
        "Aug"\
        "Sep"\
        "Okt"\
        "Nov"\
        "Dec"\
        ""]
    ::msgcat::mcset lv MONTHS_FULL [list \
        "janvāris"\
        "februāris"\
        "marts"\
        "aprīlis"\
        "maijs"\
        "jūnijs"\
        "jūlijs"\
        "augusts"\
        "septembris"\
        "oktobris"\
        "novembris"\
        "decembris"\
        ""]
    ::msgcat::mcset lv BCE "pmē"
    ::msgcat::mcset lv CE "mē"
    ::msgcat::mcset lv DATE_FORMAT "%Y.%e.%m"
    ::msgcat::mcset lv TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset lv DATE_TIME_FORMAT "%Y.%e.%m %H:%M:%S %z"

::msgcat::mcset lv DAYS_OF_WEEK_ABBREV [list \
	"Sv"\
	"P"\
	"O"\
	"T"\
	"C"\
	"Pk"\
	"S"]
::msgcat::mcset lv DAYS_OF_WEEK_FULL [list \
	"svētdiena"\
	"pirmdiena"\
	"otrdiena"\
	"trešdiena"\
	"ceturdien"\
	"piektdiena"\
	"sestdiena"]
::msgcat::mcset lv MONTHS_ABBREV [list \
	"Jan"\
	"Feb"\
	"Mar"\
	"Apr"\
	"Maijs"\
	"Jūn"\
	"Jūl"\
	"Aug"\
	"Sep"\
	"Okt"\
	"Nov"\
	"Dec"\
	""]
::msgcat::mcset lv MONTHS_FULL [list \
	"janvāris"\
	"februāris"\
	"marts"\
	"aprīlis"\
	"maijs"\
	"jūnijs"\
	"jūlijs"\
	"augusts"\
	"septembris"\
	"oktobris"\
	"novembris"\
	"decembris"\
	""]
::msgcat::mcset lv BCE "pmē"
::msgcat::mcset lv CE "mē"
::msgcat::mcset lv DATE_FORMAT "%Y.%e.%m"
::msgcat::mcset lv TIME_FORMAT "%H:%M:%S"
::msgcat::mcset lv DATE_TIME_FORMAT "%Y.%e.%m %H:%M:%S %z"
}
Changes to library/msgs/mk.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset mk DAYS_OF_WEEK_ABBREV [list \
        "нед."\
        "пон."\
        "вт."\
        "сре."\
        "чет."\
        "пет."\
        "саб."]
    ::msgcat::mcset mk DAYS_OF_WEEK_FULL [list \
        "недела"\
        "понеделник"\
        "вторник"\
        "среда"\
        "четврток"\
        "петок"\
        "сабота"]
    ::msgcat::mcset mk MONTHS_ABBREV [list \
        "јан."\
        "фев."\
        "мар."\
        "апр."\
        "мај."\
        "јун."\
        "јул."\
        "авг."\
        "септ."\
        "окт."\
        "ноем."\
        "декем."\
        ""]
    ::msgcat::mcset mk MONTHS_FULL [list \
        "јануари"\
        "февруари"\
        "март"\
        "април"\
        "мај"\
        "јуни"\
        "јули"\
        "август"\
        "септември"\
        "октомври"\
        "ноември"\
        "декември"\
        ""]
    ::msgcat::mcset mk BCE "пр.н.е."
    ::msgcat::mcset mk CE "ае."
    ::msgcat::mcset mk DATE_FORMAT "%e.%m.%Y"
    ::msgcat::mcset mk TIME_FORMAT "%H:%M:%S %z"
    ::msgcat::mcset mk DATE_TIME_FORMAT "%e.%m.%Y %H:%M:%S %z %z"

::msgcat::mcset mk DAYS_OF_WEEK_ABBREV [list \
	"нед."\
	"пон."\
	"вт."\
	"сре."\
	"чет."\
	"пет."\
	"саб."]
::msgcat::mcset mk DAYS_OF_WEEK_FULL [list \
	"недела"\
	"понеделник"\
	"вторник"\
	"среда"\
	"четврток"\
	"петок"\
	"сабота"]
::msgcat::mcset mk MONTHS_ABBREV [list \
	"јан."\
	"фев."\
	"мар."\
	"апр."\
	"мај."\
	"јун."\
	"јул."\
	"авг."\
	"септ."\
	"окт."\
	"ноем."\
	"декем."\
	""]
::msgcat::mcset mk MONTHS_FULL [list \
	"јануари"\
	"февруари"\
	"март"\
	"април"\
	"мај"\
	"јуни"\
	"јули"\
	"август"\
	"септември"\
	"октомври"\
	"ноември"\
	"декември"\
	""]
::msgcat::mcset mk BCE "пр.н.е."
::msgcat::mcset mk CE "ае."
::msgcat::mcset mk DATE_FORMAT "%e.%m.%Y"
::msgcat::mcset mk TIME_FORMAT "%H:%M:%S %z"
::msgcat::mcset mk DATE_TIME_FORMAT "%e.%m.%Y %H:%M:%S %z %z"
}
Changes to library/msgs/mr.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset mr DAYS_OF_WEEK_FULL [list \
        "रविवार"\
        "सोमवार"\
        "मंगळवार"\
        "मंगळवार"\
        "गुरुवार"\
        "शुक्रवार"\
        "शनिवार"]
    ::msgcat::mcset mr MONTHS_ABBREV [list \
        "जानेवारी"\
        "फेबृवारी"\
        "मार्च"\
        "एप्रिल"\
        "मे"\
        "जून"\
        "जुलै"\
        "ओगस्ट"\
        "सेप्टेंबर"\
        "ओक्टोबर"\
        "नोव्हेंबर"\
        "डिसेंबर"]
    ::msgcat::mcset mr MONTHS_FULL [list \
        "जानेवारी"\
        "फेबृवारी"\
        "मार्च"\
        "एप्रिल"\
        "मे"\
        "जून"\
        "जुलै"\
        "ओगस्ट"\
        "सेप्टेंबर"\
        "ओक्टोबर"\
        "नोव्हेंबर"\
        "डिसेंबर"]
    ::msgcat::mcset mr AM "BC"
    ::msgcat::mcset mr PM "AD"

::msgcat::mcset mr DAYS_OF_WEEK_FULL [list \
	"रविवार"\
	"सोमवार"\
	"मंगळवार"\
	"मंगळवार"\
	"गुरुवार"\
	"शुक्रवार"\
	"शनिवार"]
::msgcat::mcset mr MONTHS_ABBREV [list \
	"जानेवारी"\
	"फेबृवारी"\
	"मार्च"\
	"एप्रिल"\
	"मे"\
	"जून"\
	"जुलै"\
	"ओगस्ट"\
	"सेप्टेंबर"\
	"ओक्टोबर"\
	"नोव्हेंबर"\
	"डिसेंबर"]
::msgcat::mcset mr MONTHS_FULL [list \
	"जानेवारी"\
	"फेबृवारी"\
	"मार्च"\
	"एप्रिल"\
	"मे"\
	"जून"\
	"जुलै"\
	"ओगस्ट"\
	"सेप्टेंबर"\
	"ओक्टोबर"\
	"नोव्हेंबर"\
	"डिसेंबर"]
::msgcat::mcset mr AM "BC"
::msgcat::mcset mr PM "AD"
}
Changes to library/msgs/mr_in.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset mr_IN DATE_FORMAT "%d %M %Y"
    ::msgcat::mcset mr_IN TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset mr_IN DATE_TIME_FORMAT "%d %M %Y %I:%M:%S %P %z"

::msgcat::mcset mr_IN DATE_FORMAT "%d %M %Y"
::msgcat::mcset mr_IN TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset mr_IN DATE_TIME_FORMAT "%d %M %Y %I:%M:%S %P %z"
}
Changes to library/msgs/ms.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ms DAYS_OF_WEEK_ABBREV [list \
        "Aha"\
        "Isn"\
        "Sei"\
        "Rab"\
        "Kha"\
        "Jum"\
        "Sab"]
    ::msgcat::mcset ms DAYS_OF_WEEK_FULL [list \
        "Ahad"\
        "Isnin"\
        "Selasa"\
        "Rahu"\
        "Khamis"\
        "Jumaat"\
        "Sabtu"]
    ::msgcat::mcset ms MONTHS_ABBREV [list \
        "Jan"\
        "Feb"\
        "Mac"\
        "Apr"\
        "Mei"\
        "Jun"\
        "Jul"\
        "Ogos"\
        "Sep"\
        "Okt"\
        "Nov"\
        "Dis"\
        ""]
    ::msgcat::mcset ms MONTHS_FULL [list \
        "Januari"\
        "Februari"\
        "Mac"\
        "April"\
        "Mei"\
        "Jun"\
        "Julai"\
        "Ogos"\
        "September"\
        "Oktober"\
        "November"\
        "Disember"\
        ""]

::msgcat::mcset ms DAYS_OF_WEEK_ABBREV [list \
	"Aha"\
	"Isn"\
	"Sei"\
	"Rab"\
	"Kha"\
	"Jum"\
	"Sab"]
::msgcat::mcset ms DAYS_OF_WEEK_FULL [list \
	"Ahad"\
	"Isnin"\
	"Selasa"\
	"Rahu"\
	"Khamis"\
	"Jumaat"\
	"Sabtu"]
::msgcat::mcset ms MONTHS_ABBREV [list \
	"Jan"\
	"Feb"\
	"Mac"\
	"Apr"\
	"Mei"\
	"Jun"\
	"Jul"\
	"Ogos"\
	"Sep"\
	"Okt"\
	"Nov"\
	"Dis"\
	""]
::msgcat::mcset ms MONTHS_FULL [list \
	"Januari"\
	"Februari"\
	"Mac"\
	"April"\
	"Mei"\
	"Jun"\
	"Julai"\
	"Ogos"\
	"September"\
	"Oktober"\
	"November"\
	"Disember"\
	""]
}
Changes to library/msgs/ms_my.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ms_MY DATE_FORMAT "%A %d %b %Y"
    ::msgcat::mcset ms_MY TIME_FORMAT_12 "%I:%M:%S  %z"
    ::msgcat::mcset ms_MY DATE_TIME_FORMAT "%A %d %b %Y %I:%M:%S  %z %z"

::msgcat::mcset ms_MY DATE_FORMAT "%A %d %b %Y"
::msgcat::mcset ms_MY TIME_FORMAT_12 "%I:%M:%S  %z"
::msgcat::mcset ms_MY DATE_TIME_FORMAT "%A %d %b %Y %I:%M:%S  %z %z"
}
Changes to library/msgs/mt.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset mt DAYS_OF_WEEK_ABBREV [list \
        "Ħad"\
        "Tne"\
        "Tli"\
        "Erb"\
        "Ħam"\
        "Ġim"]
    ::msgcat::mcset mt MONTHS_ABBREV [list \
        "Jan"\
        "Fra"\
        "Mar"\
        "Apr"\
        "Mej"\
        "Ġun"\
        "Lul"\
        "Awi"\
        "Set"\
        "Ott"\
        "Nov"]
    ::msgcat::mcset mt BCE "QK"
    ::msgcat::mcset mt CE ""
    ::msgcat::mcset mt DATE_FORMAT "%A, %e ta %B, %Y"
    ::msgcat::mcset mt TIME_FORMAT_12 "%l:%M:%S %P"
    ::msgcat::mcset mt DATE_TIME_FORMAT "%A, %e ta %B, %Y %l:%M:%S %P %z"

::msgcat::mcset mt DAYS_OF_WEEK_ABBREV [list \
	"Ħad"\
	"Tne"\
	"Tli"\
	"Erb"\
	"Ħam"\
	"Ġim"]
::msgcat::mcset mt MONTHS_ABBREV [list \
	"Jan"\
	"Fra"\
	"Mar"\
	"Apr"\
	"Mej"\
	"Ġun"\
	"Lul"\
	"Awi"\
	"Set"\
	"Ott"\
	"Nov"]
::msgcat::mcset mt BCE "QK"
::msgcat::mcset mt CE ""
::msgcat::mcset mt DATE_FORMAT "%A, %e ta %B, %Y"
::msgcat::mcset mt TIME_FORMAT_12 "%l:%M:%S %P"
::msgcat::mcset mt DATE_TIME_FORMAT "%A, %e ta %B, %Y %l:%M:%S %P %z"
}
Changes to library/msgs/nb.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset nb DAYS_OF_WEEK_ABBREV [list \
        "sø"\
        "ma"\
        "ti"\
        "on"\
        "to"\
        "fr"\
        "lø"]
    ::msgcat::mcset nb DAYS_OF_WEEK_FULL [list \
        "søndag"\
        "mandag"\
        "tirsdag"\
        "onsdag"\
        "torsdag"\
        "fredag"\
        "lørdag"]
    ::msgcat::mcset nb MONTHS_ABBREV [list \
        "jan"\
        "feb"\
        "mar"\
        "apr"\
        "mai"\
        "jun"\
        "jul"\
        "aug"\
        "sep"\
        "okt"\
        "nov"\
        "des"\
        ""]
    ::msgcat::mcset nb MONTHS_FULL [list \
        "januar"\
        "februar"\
        "mars"\
        "april"\
        "mai"\
        "juni"\
        "juli"\
        "august"\
        "september"\
        "oktober"\
        "november"\
        "desember"\
        ""]
    ::msgcat::mcset nb BCE "f.Kr."
    ::msgcat::mcset nb CE "e.Kr."
    ::msgcat::mcset nb DATE_FORMAT "%e. %B %Y"
    ::msgcat::mcset nb TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset nb DATE_TIME_FORMAT "%e. %B %Y %H:%M:%S %z"

::msgcat::mcset nb DAYS_OF_WEEK_ABBREV [list \
	"sø"\
	"ma"\
	"ti"\
	"on"\
	"to"\
	"fr"\
	"lø"]
::msgcat::mcset nb DAYS_OF_WEEK_FULL [list \
	"søndag"\
	"mandag"\
	"tirsdag"\
	"onsdag"\
	"torsdag"\
	"fredag"\
	"lørdag"]
::msgcat::mcset nb MONTHS_ABBREV [list \
	"jan"\
	"feb"\
	"mar"\
	"apr"\
	"mai"\
	"jun"\
	"jul"\
	"aug"\
	"sep"\
	"okt"\
	"nov"\
	"des"\
	""]
::msgcat::mcset nb MONTHS_FULL [list \
	"januar"\
	"februar"\
	"mars"\
	"april"\
	"mai"\
	"juni"\
	"juli"\
	"august"\
	"september"\
	"oktober"\
	"november"\
	"desember"\
	""]
::msgcat::mcset nb BCE "f.Kr."
::msgcat::mcset nb CE "e.Kr."
::msgcat::mcset nb DATE_FORMAT "%e. %B %Y"
::msgcat::mcset nb TIME_FORMAT "%H:%M:%S"
::msgcat::mcset nb DATE_TIME_FORMAT "%e. %B %Y %H:%M:%S %z"
}
Changes to library/msgs/nl.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset nl DAYS_OF_WEEK_ABBREV [list \
        "zo"\
        "ma"\
        "di"\
        "wo"\
        "do"\
        "vr"\
        "za"]
    ::msgcat::mcset nl DAYS_OF_WEEK_FULL [list \
        "zondag"\
        "maandag"\
        "dinsdag"\
        "woensdag"\
        "donderdag"\
        "vrijdag"\
        "zaterdag"]
    ::msgcat::mcset nl MONTHS_ABBREV [list \
        "jan"\
        "feb"\
        "mrt"\
        "apr"\
        "mei"\
        "jun"\
        "jul"\
        "aug"\
        "sep"\
        "okt"\
        "nov"\
        "dec"\
        ""]
    ::msgcat::mcset nl MONTHS_FULL [list \
        "januari"\
        "februari"\
        "maart"\
        "april"\
        "mei"\
        "juni"\
        "juli"\
        "augustus"\
        "september"\
        "oktober"\
        "november"\
        "december"\
        ""]
    ::msgcat::mcset nl DATE_FORMAT "%e %B %Y"
    ::msgcat::mcset nl TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset nl DATE_TIME_FORMAT "%e %B %Y %k:%M:%S %z"

::msgcat::mcset nl DAYS_OF_WEEK_ABBREV [list \
	"zo"\
	"ma"\
	"di"\
	"wo"\
	"do"\
	"vr"\
	"za"]
::msgcat::mcset nl DAYS_OF_WEEK_FULL [list \
	"zondag"\
	"maandag"\
	"dinsdag"\
	"woensdag"\
	"donderdag"\
	"vrijdag"\
	"zaterdag"]
::msgcat::mcset nl MONTHS_ABBREV [list \
	"jan"\
	"feb"\
	"mrt"\
	"apr"\
	"mei"\
	"jun"\
	"jul"\
	"aug"\
	"sep"\
	"okt"\
	"nov"\
	"dec"\
	""]
::msgcat::mcset nl MONTHS_FULL [list \
	"januari"\
	"februari"\
	"maart"\
	"april"\
	"mei"\
	"juni"\
	"juli"\
	"augustus"\
	"september"\
	"oktober"\
	"november"\
	"december"\
	""]
::msgcat::mcset nl DATE_FORMAT "%e %B %Y"
::msgcat::mcset nl TIME_FORMAT "%k:%M:%S"
::msgcat::mcset nl DATE_TIME_FORMAT "%e %B %Y %k:%M:%S %z"
}
Changes to library/msgs/nl_be.msg.
1
2
3
4
5
6





7
1





2
3
4
5
6


-
-
-
-
-
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset nl_BE DATE_FORMAT "%d-%m-%y"
    ::msgcat::mcset nl_BE TIME_FORMAT "%T"
    ::msgcat::mcset nl_BE TIME_FORMAT_12 "%T"
    ::msgcat::mcset nl_BE DATE_TIME_FORMAT "%a %d %b %Y %T %z"

::msgcat::mcset nl_BE DATE_FORMAT "%d-%m-%y"
::msgcat::mcset nl_BE TIME_FORMAT "%T"
::msgcat::mcset nl_BE TIME_FORMAT_12 "%T"
::msgcat::mcset nl_BE DATE_TIME_FORMAT "%a %d %b %Y %T %z"
}
Changes to library/msgs/nn.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset nn DAYS_OF_WEEK_ABBREV [list \
        "su"\
        "må"\
        "ty"\
        "on"\
        "to"\
        "fr"\
        "lau"]
    ::msgcat::mcset nn DAYS_OF_WEEK_FULL [list \
        "sundag"\
        "måndag"\
        "tysdag"\
        "onsdag"\
        "torsdag"\
        "fredag"\
        "laurdag"]
    ::msgcat::mcset nn MONTHS_ABBREV [list \
        "jan"\
        "feb"\
        "mar"\
        "apr"\
        "mai"\
        "jun"\
        "jul"\
        "aug"\
        "sep"\
        "okt"\
        "nov"\
        "des"\
        ""]
    ::msgcat::mcset nn MONTHS_FULL [list \
        "januar"\
        "februar"\
        "mars"\
        "april"\
        "mai"\
        "juni"\
        "juli"\
        "august"\
        "september"\
        "oktober"\
        "november"\
        "desember"\
        ""]
    ::msgcat::mcset nn BCE "f.Kr."
    ::msgcat::mcset nn CE "e.Kr."
    ::msgcat::mcset nn DATE_FORMAT "%e. %B %Y"
    ::msgcat::mcset nn TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset nn DATE_TIME_FORMAT "%e. %B %Y %H:%M:%S %z"

::msgcat::mcset nn DAYS_OF_WEEK_ABBREV [list \
	"su"\
	"må"\
	"ty"\
	"on"\
	"to"\
	"fr"\
	"lau"]
::msgcat::mcset nn DAYS_OF_WEEK_FULL [list \
	"sundag"\
	"måndag"\
	"tysdag"\
	"onsdag"\
	"torsdag"\
	"fredag"\
	"laurdag"]
::msgcat::mcset nn MONTHS_ABBREV [list \
	"jan"\
	"feb"\
	"mar"\
	"apr"\
	"mai"\
	"jun"\
	"jul"\
	"aug"\
	"sep"\
	"okt"\
	"nov"\
	"des"\
	""]
::msgcat::mcset nn MONTHS_FULL [list \
	"januar"\
	"februar"\
	"mars"\
	"april"\
	"mai"\
	"juni"\
	"juli"\
	"august"\
	"september"\
	"oktober"\
	"november"\
	"desember"\
	""]
::msgcat::mcset nn BCE "f.Kr."
::msgcat::mcset nn CE "e.Kr."
::msgcat::mcset nn DATE_FORMAT "%e. %B %Y"
::msgcat::mcset nn TIME_FORMAT "%H:%M:%S"
::msgcat::mcset nn DATE_TIME_FORMAT "%e. %B %Y %H:%M:%S %z"
}
Changes to library/msgs/pl.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset pl DAYS_OF_WEEK_ABBREV [list \
        "N"\
        "Pn"\
        "Wt"\
        "Śr"\
        "Cz"\
        "Pt"\
        "So"]
    ::msgcat::mcset pl DAYS_OF_WEEK_FULL [list \
        "niedziela"\
        "poniedziałek"\
        "wtorek"\
        "środa"\
        "czwartek"\
        "piątek"\
        "sobota"]
    ::msgcat::mcset pl MONTHS_ABBREV [list \
        "sty"\
        "lut"\
        "mar"\
        "kwi"\
        "maj"\
        "cze"\
        "lip"\
        "sie"\
        "wrz"\
        "paź"\
        "lis"\
        "gru"\
        ""]
    ::msgcat::mcset pl MONTHS_FULL [list \
        "styczeń"\
        "luty"\
        "marzec"\
        "kwiecień"\
        "maj"\
        "czerwiec"\
        "lipiec"\
        "sierpień"\
        "wrzesień"\
        "październik"\
        "listopad"\
        "grudzień"\
        ""]
    ::msgcat::mcset pl BCE "p.n.e."
    ::msgcat::mcset pl CE "n.e."
    ::msgcat::mcset pl DATE_FORMAT "%Y-%m-%d"
    ::msgcat::mcset pl TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset pl DATE_TIME_FORMAT "%Y-%m-%d %H:%M:%S %z"

::msgcat::mcset pl DAYS_OF_WEEK_ABBREV [list \
	"N"\
	"Pn"\
	"Wt"\
	"Śr"\
	"Cz"\
	"Pt"\
	"So"]
::msgcat::mcset pl DAYS_OF_WEEK_FULL [list \
	"niedziela"\
	"poniedziałek"\
	"wtorek"\
	"środa"\
	"czwartek"\
	"piątek"\
	"sobota"]
::msgcat::mcset pl MONTHS_ABBREV [list \
	"sty"\
	"lut"\
	"mar"\
	"kwi"\
	"maj"\
	"cze"\
	"lip"\
	"sie"\
	"wrz"\
	"paź"\
	"lis"\
	"gru"\
	""]
::msgcat::mcset pl MONTHS_FULL [list \
	"styczeń"\
	"luty"\
	"marzec"\
	"kwiecień"\
	"maj"\
	"czerwiec"\
	"lipiec"\
	"sierpień"\
	"wrzesień"\
	"październik"\
	"listopad"\
	"grudzień"\
	""]
::msgcat::mcset pl BCE "p.n.e."
::msgcat::mcset pl CE "n.e."
::msgcat::mcset pl DATE_FORMAT "%Y-%m-%d"
::msgcat::mcset pl TIME_FORMAT "%H:%M:%S"
::msgcat::mcset pl DATE_TIME_FORMAT "%Y-%m-%d %H:%M:%S %z"
}
Changes to library/msgs/pt.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset pt DAYS_OF_WEEK_ABBREV [list \
        "Dom"\
        "Seg"\
        "Ter"\
        "Qua"\
        "Qui"\
        "Sex"\
        "Sáb"]
    ::msgcat::mcset pt DAYS_OF_WEEK_FULL [list \
        "Domingo"\
        "Segunda-feira"\
        "Terça-feira"\
        "Quarta-feira"\
        "Quinta-feira"\
        "Sexta-feira"\
        "Sábado"]
    ::msgcat::mcset pt MONTHS_ABBREV [list \
        "Jan"\
        "Fev"\
        "Mar"\
        "Abr"\
        "Mai"\
        "Jun"\
        "Jul"\
        "Ago"\
        "Set"\
        "Out"\
        "Nov"\
        "Dez"\
        ""]
    ::msgcat::mcset pt MONTHS_FULL [list \
        "Janeiro"\
        "Fevereiro"\
        "Março"\
        "Abril"\
        "Maio"\
        "Junho"\
        "Julho"\
        "Agosto"\
        "Setembro"\
        "Outubro"\
        "Novembro"\
        "Dezembro"\
        ""]
    ::msgcat::mcset pt DATE_FORMAT "%d-%m-%Y"
    ::msgcat::mcset pt TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset pt DATE_TIME_FORMAT "%d-%m-%Y %k:%M:%S %z"

::msgcat::mcset pt DAYS_OF_WEEK_ABBREV [list \
	"Dom"\
	"Seg"\
	"Ter"\
	"Qua"\
	"Qui"\
	"Sex"\
	"Sáb"]
::msgcat::mcset pt DAYS_OF_WEEK_FULL [list \
	"Domingo"\
	"Segunda-feira"\
	"Terça-feira"\
	"Quarta-feira"\
	"Quinta-feira"\
	"Sexta-feira"\
	"Sábado"]
::msgcat::mcset pt MONTHS_ABBREV [list \
	"Jan"\
	"Fev"\
	"Mar"\
	"Abr"\
	"Mai"\
	"Jun"\
	"Jul"\
	"Ago"\
	"Set"\
	"Out"\
	"Nov"\
	"Dez"\
	""]
::msgcat::mcset pt MONTHS_FULL [list \
	"Janeiro"\
	"Fevereiro"\
	"Março"\
	"Abril"\
	"Maio"\
	"Junho"\
	"Julho"\
	"Agosto"\
	"Setembro"\
	"Outubro"\
	"Novembro"\
	"Dezembro"\
	""]
::msgcat::mcset pt DATE_FORMAT "%d-%m-%Y"
::msgcat::mcset pt TIME_FORMAT "%k:%M:%S"
::msgcat::mcset pt DATE_TIME_FORMAT "%d-%m-%Y %k:%M:%S %z"
}
Changes to library/msgs/pt_br.msg.
1
2
3
4
5
6





7
1





2
3
4
5
6


-
-
-
-
-
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset pt_BR DATE_FORMAT "%d-%m-%Y"
    ::msgcat::mcset pt_BR TIME_FORMAT "%T"
    ::msgcat::mcset pt_BR TIME_FORMAT_12 "%T"
    ::msgcat::mcset pt_BR DATE_TIME_FORMAT "%a %d %b %Y %T %z"

::msgcat::mcset pt_BR DATE_FORMAT "%d-%m-%Y"
::msgcat::mcset pt_BR TIME_FORMAT "%T"
::msgcat::mcset pt_BR TIME_FORMAT_12 "%T"
::msgcat::mcset pt_BR DATE_TIME_FORMAT "%a %d %b %Y %T %z"
}
Changes to library/msgs/ro.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ro DAYS_OF_WEEK_ABBREV [list \
        "D"\
        "L"\
        "Ma"\
        "Mi"\
        "J"\
        "V"\
        "S"]
    ::msgcat::mcset ro DAYS_OF_WEEK_FULL [list \
        "duminică"\
        "luni"\
        "marţi"\
        "miercuri"\
        "joi"\
        "vineri"\
        "sîmbătă"]
    ::msgcat::mcset ro MONTHS_ABBREV [list \
        "Ian"\
        "Feb"\
        "Mar"\
        "Apr"\
        "Mai"\
        "Iun"\
        "Iul"\
        "Aug"\
        "Sep"\
        "Oct"\
        "Nov"\
        "Dec"\
        ""]
    ::msgcat::mcset ro MONTHS_FULL [list \
        "ianuarie"\
        "februarie"\
        "martie"\
        "aprilie"\
        "mai"\
        "iunie"\
        "iulie"\
        "august"\
        "septembrie"\
        "octombrie"\
        "noiembrie"\
        "decembrie"\
        ""]
    ::msgcat::mcset ro BCE "d.C."
    ::msgcat::mcset ro CE "î.d.C."
    ::msgcat::mcset ro DATE_FORMAT "%d.%m.%Y"
    ::msgcat::mcset ro TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset ro DATE_TIME_FORMAT "%d.%m.%Y %H:%M:%S %z"

::msgcat::mcset ro DAYS_OF_WEEK_ABBREV [list \
	"D"\
	"L"\
	"Ma"\
	"Mi"\
	"J"\
	"V"\
	"S"]
::msgcat::mcset ro DAYS_OF_WEEK_FULL [list \
	"duminică"\
	"luni"\
	"marţi"\
	"miercuri"\
	"joi"\
	"vineri"\
	"sîmbătă"]
::msgcat::mcset ro MONTHS_ABBREV [list \
	"Ian"\
	"Feb"\
	"Mar"\
	"Apr"\
	"Mai"\
	"Iun"\
	"Iul"\
	"Aug"\
	"Sep"\
	"Oct"\
	"Nov"\
	"Dec"\
	""]
::msgcat::mcset ro MONTHS_FULL [list \
	"ianuarie"\
	"februarie"\
	"martie"\
	"aprilie"\
	"mai"\
	"iunie"\
	"iulie"\
	"august"\
	"septembrie"\
	"octombrie"\
	"noiembrie"\
	"decembrie"\
	""]
::msgcat::mcset ro BCE "d.C."
::msgcat::mcset ro CE "î.d.C."
::msgcat::mcset ro DATE_FORMAT "%d.%m.%Y"
::msgcat::mcset ro TIME_FORMAT "%H:%M:%S"
::msgcat::mcset ro DATE_TIME_FORMAT "%d.%m.%Y %H:%M:%S %z"
}
Changes to library/msgs/ru.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ru DAYS_OF_WEEK_ABBREV [list \
        "Вс"\
        "Пн"\
        "Вт"\
        "Ср"\
        "Чт"\
        "Пт"\
        "Сб"]
    ::msgcat::mcset ru DAYS_OF_WEEK_FULL [list \
        "воскресенье"\
        "понедельник"\
        "вторник"\
        "среда"\
        "четверг"\
        "пятница"\
        "суббота"]
    ::msgcat::mcset ru MONTHS_ABBREV [list \
        "янв"\
        "фев"\
        "мар"\
        "апр"\
        "май"\
        "июн"\
        "июл"\
        "авг"\
        "сен"\
        "окт"\
        "ноя"\
        "дек"\
        ""]
    ::msgcat::mcset ru MONTHS_FULL [list \
        "Январь"\
        "Февраль"\
        "Март"\
        "Апрель"\
        "Май"\
        "Июнь"\
        "Июль"\
        "Август"\
        "Сентябрь"\
        "Октябрь"\
        "Ноябрь"\
        "Декабрь"\
        ""]
    ::msgcat::mcset ru BCE "до н.э."
    ::msgcat::mcset ru CE "н.э."
    ::msgcat::mcset ru DATE_FORMAT "%d.%m.%Y"
    ::msgcat::mcset ru TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset ru DATE_TIME_FORMAT "%d.%m.%Y %k:%M:%S %z"

::msgcat::mcset ru DAYS_OF_WEEK_ABBREV [list \
	"Вс"\
	"Пн"\
	"Вт"\
	"Ср"\
	"Чт"\
	"Пт"\
	"Сб"]
::msgcat::mcset ru DAYS_OF_WEEK_FULL [list \
	"воскресенье"\
	"понедельник"\
	"вторник"\
	"среда"\
	"четверг"\
	"пятница"\
	"суббота"]
::msgcat::mcset ru MONTHS_ABBREV [list \
	"янв"\
	"фев"\
	"мар"\
	"апр"\
	"май"\
	"июн"\
	"июл"\
	"авг"\
	"сен"\
	"окт"\
	"ноя"\
	"дек"\
	""]
::msgcat::mcset ru MONTHS_FULL [list \
	"Январь"\
	"Февраль"\
	"Март"\
	"Апрель"\
	"Май"\
	"Июнь"\
	"Июль"\
	"Август"\
	"Сентябрь"\
	"Октябрь"\
	"Ноябрь"\
	"Декабрь"\
	""]
::msgcat::mcset ru BCE "до н.э."
::msgcat::mcset ru CE "н.э."
::msgcat::mcset ru DATE_FORMAT "%d.%m.%Y"
::msgcat::mcset ru TIME_FORMAT "%k:%M:%S"
::msgcat::mcset ru DATE_TIME_FORMAT "%d.%m.%Y %k:%M:%S %z"
}
Changes to library/msgs/ru_ua.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ru_UA DATE_FORMAT "%d.%m.%Y"
    ::msgcat::mcset ru_UA TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset ru_UA DATE_TIME_FORMAT "%d.%m.%Y %k:%M:%S %z"

::msgcat::mcset ru_UA DATE_FORMAT "%d.%m.%Y"
::msgcat::mcset ru_UA TIME_FORMAT "%k:%M:%S"
::msgcat::mcset ru_UA DATE_TIME_FORMAT "%d.%m.%Y %k:%M:%S %z"
}
Changes to library/msgs/sh.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset sh DAYS_OF_WEEK_ABBREV [list \
        "Ned"\
        "Pon"\
        "Uto"\
        "Sre"\
        "Čet"\
        "Pet"\
        "Sub"]
    ::msgcat::mcset sh DAYS_OF_WEEK_FULL [list \
        "Nedelja"\
        "Ponedeljak"\
        "Utorak"\
        "Sreda"\
        "Četvrtak"\
        "Petak"\
        "Subota"]
    ::msgcat::mcset sh MONTHS_ABBREV [list \
        "Jan"\
        "Feb"\
        "Mar"\
        "Apr"\
        "Maj"\
        "Jun"\
        "Jul"\
        "Avg"\
        "Sep"\
        "Okt"\
        "Nov"\
        "Dec"\
        ""]
    ::msgcat::mcset sh MONTHS_FULL [list \
        "Januar"\
        "Februar"\
        "Mart"\
        "April"\
        "Maj"\
        "Juni"\
        "Juli"\
        "Avgust"\
        "Septembar"\
        "Oktobar"\
        "Novembar"\
        "Decembar"\
        ""]
    ::msgcat::mcset sh BCE "p. n. e."
    ::msgcat::mcset sh CE "n. e."
    ::msgcat::mcset sh DATE_FORMAT "%d.%m.%Y."
    ::msgcat::mcset sh TIME_FORMAT "%k.%M.%S"
    ::msgcat::mcset sh DATE_TIME_FORMAT "%d.%m.%Y. %k.%M.%S %z"

::msgcat::mcset sh DAYS_OF_WEEK_ABBREV [list \
	"Ned"\
	"Pon"\
	"Uto"\
	"Sre"\
	"Čet"\
	"Pet"\
	"Sub"]
::msgcat::mcset sh DAYS_OF_WEEK_FULL [list \
	"Nedelja"\
	"Ponedeljak"\
	"Utorak"\
	"Sreda"\
	"Četvrtak"\
	"Petak"\
	"Subota"]
::msgcat::mcset sh MONTHS_ABBREV [list \
	"Jan"\
	"Feb"\
	"Mar"\
	"Apr"\
	"Maj"\
	"Jun"\
	"Jul"\
	"Avg"\
	"Sep"\
	"Okt"\
	"Nov"\
	"Dec"\
	""]
::msgcat::mcset sh MONTHS_FULL [list \
	"Januar"\
	"Februar"\
	"Mart"\
	"April"\
	"Maj"\
	"Juni"\
	"Juli"\
	"Avgust"\
	"Septembar"\
	"Oktobar"\
	"Novembar"\
	"Decembar"\
	""]
::msgcat::mcset sh BCE "p. n. e."
::msgcat::mcset sh CE "n. e."
::msgcat::mcset sh DATE_FORMAT "%d.%m.%Y."
::msgcat::mcset sh TIME_FORMAT "%k.%M.%S"
::msgcat::mcset sh DATE_TIME_FORMAT "%d.%m.%Y. %k.%M.%S %z"
}
Changes to library/msgs/sk.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset sk DAYS_OF_WEEK_ABBREV [list \
        "Ne"\
        "Po"\
        "Ut"\
        "St"\
        "Št"\
        "Pa"\
        "So"]
    ::msgcat::mcset sk DAYS_OF_WEEK_FULL [list \
        "Nedeľe"\
        "Pondelok"\
        "Utorok"\
        "Streda"\
        "Štvrtok"\
        "Piatok"\
        "Sobota"]
    ::msgcat::mcset sk MONTHS_ABBREV [list \
        "jan"\
        "feb"\
        "mar"\
        "apr"\
        "máj"\
        "jún"\
        "júl"\
        "aug"\
        "sep"\
        "okt"\
        "nov"\
        "dec"\
        ""]
    ::msgcat::mcset sk MONTHS_FULL [list \
        "január"\
        "február"\
        "marec"\
        "apríl"\
        "máj"\
        "jún"\
        "júl"\
        "august"\
        "september"\
        "október"\
        "november"\
        "december"\
        ""]
    ::msgcat::mcset sk BCE "pred n.l."
    ::msgcat::mcset sk CE "n.l."
    ::msgcat::mcset sk DATE_FORMAT "%e.%m.%Y"
    ::msgcat::mcset sk TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset sk DATE_TIME_FORMAT "%e.%m.%Y %k:%M:%S %z"

::msgcat::mcset sk DAYS_OF_WEEK_ABBREV [list \
	"Ne"\
	"Po"\
	"Ut"\
	"St"\
	"Št"\
	"Pa"\
	"So"]
::msgcat::mcset sk DAYS_OF_WEEK_FULL [list \
	"Nedeľe"\
	"Pondelok"\
	"Utorok"\
	"Streda"\
	"Štvrtok"\
	"Piatok"\
	"Sobota"]
::msgcat::mcset sk MONTHS_ABBREV [list \
	"jan"\
	"feb"\
	"mar"\
	"apr"\
	"máj"\
	"jún"\
	"júl"\
	"aug"\
	"sep"\
	"okt"\
	"nov"\
	"dec"\
	""]
::msgcat::mcset sk MONTHS_FULL [list \
	"január"\
	"február"\
	"marec"\
	"apríl"\
	"máj"\
	"jún"\
	"júl"\
	"august"\
	"september"\
	"október"\
	"november"\
	"december"\
	""]
::msgcat::mcset sk BCE "pred n.l."
::msgcat::mcset sk CE "n.l."
::msgcat::mcset sk DATE_FORMAT "%e.%m.%Y"
::msgcat::mcset sk TIME_FORMAT "%k:%M:%S"
::msgcat::mcset sk DATE_TIME_FORMAT "%e.%m.%Y %k:%M:%S %z"
}
Changes to library/msgs/sl.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset sl DAYS_OF_WEEK_ABBREV [list \
        "Ned"\
        "Pon"\
        "Tor"\
        "Sre"\
        "Čet"\
        "Pet"\
        "Sob"]
    ::msgcat::mcset sl DAYS_OF_WEEK_FULL [list \
        "Nedelja"\
        "Ponedeljek"\
        "Torek"\
        "Sreda"\
        "Četrtek"\
        "Petek"\
        "Sobota"]
    ::msgcat::mcset sl MONTHS_ABBREV [list \
        "jan"\
        "feb"\
        "mar"\
        "apr"\
        "maj"\
        "jun"\
        "jul"\
        "avg"\
        "sep"\
        "okt"\
        "nov"\
        "dec"\
        ""]
    ::msgcat::mcset sl MONTHS_FULL [list \
        "januar"\
        "februar"\
        "marec"\
        "april"\
        "maj"\
        "junij"\
        "julij"\
        "avgust"\
        "september"\
        "oktober"\
        "november"\
        "december"\
        ""]
    ::msgcat::mcset sl BCE "pr.n.š."
    ::msgcat::mcset sl CE "po Kr."
    ::msgcat::mcset sl DATE_FORMAT "%Y.%m.%e"
    ::msgcat::mcset sl TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset sl DATE_TIME_FORMAT "%Y.%m.%e %k:%M:%S %z"

::msgcat::mcset sl DAYS_OF_WEEK_ABBREV [list \
	"Ned"\
	"Pon"\
	"Tor"\
	"Sre"\
	"Čet"\
	"Pet"\
	"Sob"]
::msgcat::mcset sl DAYS_OF_WEEK_FULL [list \
	"Nedelja"\
	"Ponedeljek"\
	"Torek"\
	"Sreda"\
	"Četrtek"\
	"Petek"\
	"Sobota"]
::msgcat::mcset sl MONTHS_ABBREV [list \
	"jan"\
	"feb"\
	"mar"\
	"apr"\
	"maj"\
	"jun"\
	"jul"\
	"avg"\
	"sep"\
	"okt"\
	"nov"\
	"dec"\
	""]
::msgcat::mcset sl MONTHS_FULL [list \
	"januar"\
	"februar"\
	"marec"\
	"april"\
	"maj"\
	"junij"\
	"julij"\
	"avgust"\
	"september"\
	"oktober"\
	"november"\
	"december"\
	""]
::msgcat::mcset sl BCE "pr.n.š."
::msgcat::mcset sl CE "po Kr."
::msgcat::mcset sl DATE_FORMAT "%Y.%m.%e"
::msgcat::mcset sl TIME_FORMAT "%k:%M:%S"
::msgcat::mcset sl DATE_TIME_FORMAT "%Y.%m.%e %k:%M:%S %z"
}
Changes to library/msgs/sq.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset sq DAYS_OF_WEEK_ABBREV [list \
        "Die"\
        "Hën"\
        "Mar"\
        "Mër"\
        "Enj"\
        "Pre"\
        "Sht"]
    ::msgcat::mcset sq DAYS_OF_WEEK_FULL [list \
        "e diel"\
        "e hënë"\
        "e martë"\
        "e mërkurë"\
        "e enjte"\
        "e premte"\
        "e shtunë"]
    ::msgcat::mcset sq MONTHS_ABBREV [list \
        "Jan"\
        "Shk"\
        "Mar"\
        "Pri"\
        "Maj"\
        "Qer"\
        "Kor"\
        "Gsh"\
        "Sht"\
        "Tet"\
        "Nën"\
        "Dhj"\
        ""]
    ::msgcat::mcset sq MONTHS_FULL [list \
        "janar"\
        "shkurt"\
        "mars"\
        "prill"\
        "maj"\
        "qershor"\
        "korrik"\
        "gusht"\
        "shtator"\
        "tetor"\
        "nëntor"\
        "dhjetor"\
        ""]
    ::msgcat::mcset sq BCE "p.e.r."
    ::msgcat::mcset sq CE "n.e.r."
    ::msgcat::mcset sq AM "PD"
    ::msgcat::mcset sq PM "MD"
    ::msgcat::mcset sq DATE_FORMAT "%Y-%m-%d"
    ::msgcat::mcset sq TIME_FORMAT_12 "%l:%M:%S.%P"
    ::msgcat::mcset sq DATE_TIME_FORMAT "%Y-%m-%d %l:%M:%S.%P %z"

::msgcat::mcset sq DAYS_OF_WEEK_ABBREV [list \
	"Die"\
	"Hën"\
	"Mar"\
	"Mër"\
	"Enj"\
	"Pre"\
	"Sht"]
::msgcat::mcset sq DAYS_OF_WEEK_FULL [list \
	"e diel"\
	"e hënë"\
	"e martë"\
	"e mërkurë"\
	"e enjte"\
	"e premte"\
	"e shtunë"]
::msgcat::mcset sq MONTHS_ABBREV [list \
	"Jan"\
	"Shk"\
	"Mar"\
	"Pri"\
	"Maj"\
	"Qer"\
	"Kor"\
	"Gsh"\
	"Sht"\
	"Tet"\
	"Nën"\
	"Dhj"\
	""]
::msgcat::mcset sq MONTHS_FULL [list \
	"janar"\
	"shkurt"\
	"mars"\
	"prill"\
	"maj"\
	"qershor"\
	"korrik"\
	"gusht"\
	"shtator"\
	"tetor"\
	"nëntor"\
	"dhjetor"\
	""]
::msgcat::mcset sq BCE "p.e.r."
::msgcat::mcset sq CE "n.e.r."
::msgcat::mcset sq AM "PD"
::msgcat::mcset sq PM "MD"
::msgcat::mcset sq DATE_FORMAT "%Y-%m-%d"
::msgcat::mcset sq TIME_FORMAT_12 "%l:%M:%S.%P"
::msgcat::mcset sq DATE_TIME_FORMAT "%Y-%m-%d %l:%M:%S.%P %z"
}
Changes to library/msgs/sr.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset sr DAYS_OF_WEEK_ABBREV [list \
        "Нед"\
        "Пон"\
        "Уто"\
        "Сре"\
        "Чет"\
        "Пет"\
        "Суб"]
    ::msgcat::mcset sr DAYS_OF_WEEK_FULL [list \
        "Недеља"\
        "Понедељак"\
        "Уторак"\
        "Среда"\
        "Четвртак"\
        "Петак"\
        "Субота"]
    ::msgcat::mcset sr MONTHS_ABBREV [list \
        "Јан"\
        "Феб"\
        "Мар"\
        "Апр"\
        "Мај"\
        "Јун"\
        "Јул"\
        "Авг"\
        "Сеп"\
        "Окт"\
        "Нов"\
        "Дец"\
        ""]
    ::msgcat::mcset sr MONTHS_FULL [list \
        "Јануар"\
        "Фебруар"\
        "Март"\
        "Април"\
        "Мај"\
        "Јуни"\
        "Јули"\
        "Август"\
        "Септембар"\
        "Октобар"\
        "Новембар"\
        "Децембар"\
        ""]
    ::msgcat::mcset sr BCE "п. н. е."
    ::msgcat::mcset sr CE "н. е"
    ::msgcat::mcset sr DATE_FORMAT "%Y.%m.%e"
    ::msgcat::mcset sr TIME_FORMAT "%k.%M.%S"
    ::msgcat::mcset sr DATE_TIME_FORMAT "%Y.%m.%e %k.%M.%S %z"

::msgcat::mcset sr DAYS_OF_WEEK_ABBREV [list \
	"Нед"\
	"Пон"\
	"Уто"\
	"Сре"\
	"Чет"\
	"Пет"\
	"Суб"]
::msgcat::mcset sr DAYS_OF_WEEK_FULL [list \
	"Недеља"\
	"Понедељак"\
	"Уторак"\
	"Среда"\
	"Четвртак"\
	"Петак"\
	"Субота"]
::msgcat::mcset sr MONTHS_ABBREV [list \
	"Јан"\
	"Феб"\
	"Мар"\
	"Апр"\
	"Мај"\
	"Јун"\
	"Јул"\
	"Авг"\
	"Сеп"\
	"Окт"\
	"Нов"\
	"Дец"\
	""]
::msgcat::mcset sr MONTHS_FULL [list \
	"Јануар"\
	"Фебруар"\
	"Март"\
	"Април"\
	"Мај"\
	"Јуни"\
	"Јули"\
	"Август"\
	"Септембар"\
	"Октобар"\
	"Новембар"\
	"Децембар"\
	""]
::msgcat::mcset sr BCE "п. н. е."
::msgcat::mcset sr CE "н. е"
::msgcat::mcset sr DATE_FORMAT "%Y.%m.%e"
::msgcat::mcset sr TIME_FORMAT "%k.%M.%S"
::msgcat::mcset sr DATE_TIME_FORMAT "%Y.%m.%e %k.%M.%S %z"
}
Changes to library/msgs/sv.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset sv DAYS_OF_WEEK_ABBREV [list \
        "sö"\
        "må"\
        "ti"\
        "on"\
        "to"\
        "fr"\
        "lö"]
    ::msgcat::mcset sv DAYS_OF_WEEK_FULL [list \
        "söndag"\
        "måndag"\
        "tisdag"\
        "onsdag"\
        "torsdag"\
        "fredag"\
        "lördag"]
    ::msgcat::mcset sv MONTHS_ABBREV [list \
        "jan"\
        "feb"\
        "mar"\
        "apr"\
        "maj"\
        "jun"\
        "jul"\
        "aug"\
        "sep"\
        "okt"\
        "nov"\
        "dec"\
        ""]
    ::msgcat::mcset sv MONTHS_FULL [list \
        "januari"\
        "februari"\
        "mars"\
        "april"\
        "maj"\
        "juni"\
        "juli"\
        "augusti"\
        "september"\
        "oktober"\
        "november"\
        "december"\
        ""]
    ::msgcat::mcset sv BCE "f.Kr."
    ::msgcat::mcset sv CE "e.Kr."
    ::msgcat::mcset sv DATE_FORMAT "%Y-%m-%d"
    ::msgcat::mcset sv TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset sv DATE_TIME_FORMAT "%Y-%m-%d %H:%M:%S %z"

::msgcat::mcset sv DAYS_OF_WEEK_ABBREV [list \
	"sö"\
	"må"\
	"ti"\
	"on"\
	"to"\
	"fr"\
	"lö"]
::msgcat::mcset sv DAYS_OF_WEEK_FULL [list \
	"söndag"\
	"måndag"\
	"tisdag"\
	"onsdag"\
	"torsdag"\
	"fredag"\
	"lördag"]
::msgcat::mcset sv MONTHS_ABBREV [list \
	"jan"\
	"feb"\
	"mar"\
	"apr"\
	"maj"\
	"jun"\
	"jul"\
	"aug"\
	"sep"\
	"okt"\
	"nov"\
	"dec"\
	""]
::msgcat::mcset sv MONTHS_FULL [list \
	"januari"\
	"februari"\
	"mars"\
	"april"\
	"maj"\
	"juni"\
	"juli"\
	"augusti"\
	"september"\
	"oktober"\
	"november"\
	"december"\
	""]
::msgcat::mcset sv BCE "f.Kr."
::msgcat::mcset sv CE "e.Kr."
::msgcat::mcset sv DATE_FORMAT "%Y-%m-%d"
::msgcat::mcset sv TIME_FORMAT "%H:%M:%S"
::msgcat::mcset sv DATE_TIME_FORMAT "%Y-%m-%d %H:%M:%S %z"
}
Changes to library/msgs/sw.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset sw DAYS_OF_WEEK_ABBREV [list \
        "Jpi"\
        "Jtt"\
        "Jnn"\
        "Jtn"\
        "Alh"\
        "Iju"\
        "Jmo"]
    ::msgcat::mcset sw DAYS_OF_WEEK_FULL [list \
        "Jumapili"\
        "Jumatatu"\
        "Jumanne"\
        "Jumatano"\
        "Alhamisi"\
        "Ijumaa"\
        "Jumamosi"]
    ::msgcat::mcset sw MONTHS_ABBREV [list \
        "Jan"\
        "Feb"\
        "Mar"\
        "Apr"\
        "Mei"\
        "Jun"\
        "Jul"\
        "Ago"\
        "Sep"\
        "Okt"\
        "Nov"\
        "Des"\
        ""]
    ::msgcat::mcset sw MONTHS_FULL [list \
        "Januari"\
        "Februari"\
        "Machi"\
        "Aprili"\
        "Mei"\
        "Juni"\
        "Julai"\
        "Agosti"\
        "Septemba"\
        "Oktoba"\
        "Novemba"\
        "Desemba"\
        ""]
    ::msgcat::mcset sw BCE "KK"
    ::msgcat::mcset sw CE "BK"

::msgcat::mcset sw DAYS_OF_WEEK_ABBREV [list \
	"Jpi"\
	"Jtt"\
	"Jnn"\
	"Jtn"\
	"Alh"\
	"Iju"\
	"Jmo"]
::msgcat::mcset sw DAYS_OF_WEEK_FULL [list \
	"Jumapili"\
	"Jumatatu"\
	"Jumanne"\
	"Jumatano"\
	"Alhamisi"\
	"Ijumaa"\
	"Jumamosi"]
::msgcat::mcset sw MONTHS_ABBREV [list \
	"Jan"\
	"Feb"\
	"Mar"\
	"Apr"\
	"Mei"\
	"Jun"\
	"Jul"\
	"Ago"\
	"Sep"\
	"Okt"\
	"Nov"\
	"Des"\
	""]
::msgcat::mcset sw MONTHS_FULL [list \
	"Januari"\
	"Februari"\
	"Machi"\
	"Aprili"\
	"Mei"\
	"Juni"\
	"Julai"\
	"Agosti"\
	"Septemba"\
	"Oktoba"\
	"Novemba"\
	"Desemba"\
	""]
::msgcat::mcset sw BCE "KK"
::msgcat::mcset sw CE "BK"
}
Changes to library/msgs/ta.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ta DAYS_OF_WEEK_FULL [list \
        "ஞாயிறு"\
        "திங்கள்"\
        "செவ்வாய்"\
        "புதன்"\
        "வியாழன்"\
        "வெள்ளி"\
        "சனி"]
    ::msgcat::mcset ta MONTHS_ABBREV [list \
        "ஜனவரி"\
        "பெப்ரவரி"\
        "மார்ச்"\
        "ஏப்ரல்"\
        "மே"\
        "ஜூன்"\
        "ஜூலை"\
        "ஆகஸ்ட்"\
        "செப்டம்பர்"\
        "அக்டோபர்"\
        "நவம்பர்"\
        "டிசம்பர்r"]
    ::msgcat::mcset ta MONTHS_FULL [list \
        "ஜனவரி"\
        "பெப்ரவரி"\
        "மார்ச்"\
        "ஏப்ரல்"\
        "மே"\
        "ஜூன்"\
        "ஜூலை"\
        "ஆகஸ்ட்"\
        "செப்டம்பர்"\
        "அக்டோபர்"\
        "நவம்பர்"\
        "டிசம்பர்r"]
    ::msgcat::mcset ta AM "கிமு"
    ::msgcat::mcset ta PM "கிபி"

::msgcat::mcset ta DAYS_OF_WEEK_FULL [list \
	"ஞாயிறு"\
	"திங்கள்"\
	"செவ்வாய்"\
	"புதன்"\
	"வியாழன்"\
	"வெள்ளி"\
	"சனி"]
::msgcat::mcset ta MONTHS_ABBREV [list \
	"ஜனவரி"\
	"பெப்ரவரி"\
	"மார்ச்"\
	"ஏப்ரல்"\
	"மே"\
	"ஜூன்"\
	"ஜூலை"\
	"ஆகஸ்ட்"\
	"செப்டம்பர்"\
	"அக்டோபர்"\
	"நவம்பர்"\
	"டிசம்பர்r"]
::msgcat::mcset ta MONTHS_FULL [list \
	"ஜனவரி"\
	"பெப்ரவரி"\
	"மார்ச்"\
	"ஏப்ரல்"\
	"மே"\
	"ஜூன்"\
	"ஜூலை"\
	"ஆகஸ்ட்"\
	"செப்டம்பர்"\
	"அக்டோபர்"\
	"நவம்பர்"\
	"டிசம்பர்r"]
::msgcat::mcset ta AM "கிமு"
::msgcat::mcset ta PM "கிபி"
}
Changes to library/msgs/ta_in.msg.
1
2
3
4
5




6
1




2
3
4
5


-
-
-
-
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ta_IN DATE_FORMAT "%d %M %Y"
    ::msgcat::mcset ta_IN TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset ta_IN DATE_TIME_FORMAT "%d %M %Y %I:%M:%S %P %z"

::msgcat::mcset ta_IN DATE_FORMAT "%d %M %Y"
::msgcat::mcset ta_IN TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset ta_IN DATE_TIME_FORMAT "%d %M %Y %I:%M:%S %P %z"
}
Changes to library/msgs/te.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset te DAYS_OF_WEEK_ABBREV [list \
        "ఆది"\
        "సోమ"\
        "మంగళ"\
        "బుధ"\
        "గురు"\
        "శుక్ర"\
        "శని"]
    ::msgcat::mcset te DAYS_OF_WEEK_FULL [list \
        "ఆదివారం"\
        "సోమవారం"\
        "మంగళవారం"\
        "బుధవారం"\
        "గురువారం"\
        "శుక్రవారం"\
        "శనివారం"]
    ::msgcat::mcset te MONTHS_ABBREV [list \
        "జనవరి"\
        "ఫిబ్రవరి"\
        "మార్చి"\
        "ఏప్రిల్"\
        "మే"\
        "జూన్"\
        "జూలై"\
        "ఆగస్టు"\
        "సెప్టెంబర్"\
        "అక్టోబర్"\
        "నవంబర్"\
        "డిసెంబర్"\
        ""]
    ::msgcat::mcset te MONTHS_FULL [list \
        "జనవరి"\
        "ఫిబ్రవరి"\
        "మార్చి"\
        "ఏప్రిల్"\
        "మే"\
        "జూన్"\
        "జూలై"\
        "ఆగస్టు"\
        "సెప్టెంబర్"\
        "అక్టోబర్"\
        "నవంబర్"\
        "డిసెంబర్"\
        ""]

::msgcat::mcset te DAYS_OF_WEEK_ABBREV [list \
	"ఆది"\
	"సోమ"\
	"మంగళ"\
	"బుధ"\
	"గురు"\
	"శుక్ర"\
	"శని"]
::msgcat::mcset te DAYS_OF_WEEK_FULL [list \
	"ఆదివారం"\
	"సోమవారం"\
	"మంగళవారం"\
	"బుధవారం"\
	"గురువారం"\
	"శుక్రవారం"\
	"శనివారం"]
::msgcat::mcset te MONTHS_ABBREV [list \
	"జనవరి"\
	"ఫిబ్రవరి"\
	"మార్చి"\
	"ఏప్రిల్"\
	"మే"\
	"జూన్"\
	"జూలై"\
	"ఆగస్టు"\
	"సెప్టెంబర్"\
	"అక్టోబర్"\
	"నవంబర్"\
	"డిసెంబర్"\
	""]
::msgcat::mcset te MONTHS_FULL [list \
	"జనవరి"\
	"ఫిబ్రవరి"\
	"మార్చి"\
	"ఏప్రిల్"\
	"మే"\
	"జూన్"\
	"జూలై"\
	"ఆగస్టు"\
	"సెప్టెంబర్"\
	"అక్టోబర్"\
	"నవంబర్"\
	"డిసెంబర్"\
	""]
}
Changes to library/msgs/te_in.msg.
1
2
3
4
5
6
7






8
1






2
3
4
5
6
7


-
-
-
-
-
-
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset te_IN AM "పూర్వాహ్న"
    ::msgcat::mcset te_IN PM "అపరాహ్న"
    ::msgcat::mcset te_IN DATE_FORMAT "%d/%m/%Y"
    ::msgcat::mcset te_IN TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset te_IN DATE_TIME_FORMAT "%d/%m/%Y %I:%M:%S %P %z"

::msgcat::mcset te_IN AM "పూర్వాహ్న"
::msgcat::mcset te_IN PM "అపరాహ్న"
::msgcat::mcset te_IN DATE_FORMAT "%d/%m/%Y"
::msgcat::mcset te_IN TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset te_IN DATE_TIME_FORMAT "%d/%m/%Y %I:%M:%S %P %z"
}
Changes to library/msgs/th.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset th DAYS_OF_WEEK_ABBREV [list \
        "อา."\
        "จ."\
        "อ."\
        "พ."\
        "พฤ."\
        "ศ."\
        "ส."]
    ::msgcat::mcset th DAYS_OF_WEEK_FULL [list \
        "วันอาทิตย์"\
        "วันจันทร์"\
        "วันอังคาร"\
        "วันพุธ"\
        "วันพฤหัสบดี"\
        "วันศุกร์"\
        "วันเสาร์"]
    ::msgcat::mcset th MONTHS_ABBREV [list \
        "ม.ค."\
        "ก.พ."\
        "มี.ค."\
        "เม.ย."\
        "พ.ค."\
        "มิ.ย."\
        "ก.ค."\
        "ส.ค."\
        "ก.ย."\
        "ต.ค."\
        "พ.ย."\
        "ธ.ค."\
        ""]
    ::msgcat::mcset th MONTHS_FULL [list \
        "มกราคม"\
        "กุมภาพันธ์"\
        "มีนาคม"\
        "เมษายน"\
        "พฤษภาคม"\
        "มิถุนายน"\
        "กรกฎาคม"\
        "สิงหาคม"\
        "กันยายน"\
        "ตุลาคม"\
        "พฤศจิกายน"\
        "ธันวาคม"\
        ""]
    ::msgcat::mcset th BCE "ลที่"
    ::msgcat::mcset th CE "ค.ศ."
    ::msgcat::mcset th AM "ก่อนเที่ยง"
    ::msgcat::mcset th PM "หลังเที่ยง"
    ::msgcat::mcset th DATE_FORMAT "%e/%m/%Y"
    ::msgcat::mcset th TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset th DATE_TIME_FORMAT "%e/%m/%Y %k:%M:%S %z"

::msgcat::mcset th DAYS_OF_WEEK_ABBREV [list \
	"อา."\
	"จ."\
	"อ."\
	"พ."\
	"พฤ."\
	"ศ."\
	"ส."]
::msgcat::mcset th DAYS_OF_WEEK_FULL [list \
	"วันอาทิตย์"\
	"วันจันทร์"\
	"วันอังคาร"\
	"วันพุธ"\
	"วันพฤหัสบดี"\
	"วันศุกร์"\
	"วันเสาร์"]
::msgcat::mcset th MONTHS_ABBREV [list \
	"ม.ค."\
	"ก.พ."\
	"มี.ค."\
	"เม.ย."\
	"พ.ค."\
	"มิ.ย."\
	"ก.ค."\
	"ส.ค."\
	"ก.ย."\
	"ต.ค."\
	"พ.ย."\
	"ธ.ค."\
	""]
::msgcat::mcset th MONTHS_FULL [list \
	"มกราคม"\
	"กุมภาพันธ์"\
	"มีนาคม"\
	"เมษายน"\
	"พฤษภาคม"\
	"มิถุนายน"\
	"กรกฎาคม"\
	"สิงหาคม"\
	"กันยายน"\
	"ตุลาคม"\
	"พฤศจิกายน"\
	"ธันวาคม"\
	""]
::msgcat::mcset th BCE "ลที่"
::msgcat::mcset th CE "ค.ศ."
::msgcat::mcset th AM "ก่อนเที่ยง"
::msgcat::mcset th PM "หลังเที่ยง"
::msgcat::mcset th DATE_FORMAT "%e/%m/%Y"
::msgcat::mcset th TIME_FORMAT "%k:%M:%S"
::msgcat::mcset th DATE_TIME_FORMAT "%e/%m/%Y %k:%M:%S %z"
}
Changes to library/msgs/tr.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset tr DAYS_OF_WEEK_ABBREV [list \
        "Paz"\
        "Pzt"\
        "Sal"\
        "Çar"\
        "Per"\
        "Cum"\
        "Cmt"]
    ::msgcat::mcset tr DAYS_OF_WEEK_FULL [list \
        "Pazar"\
        "Pazartesi"\
        "Salı"\
        "Çarşamba"\
        "Perşembe"\
        "Cuma"\
        "Cumartesi"]
    ::msgcat::mcset tr MONTHS_ABBREV [list \
        "Oca"\
        "Şub"\
        "Mar"\
        "Nis"\
        "May"\
        "Haz"\
        "Tem"\
        "Ağu"\
        "Eyl"\
        "Eki"\
        "Kas"\
        "Ara"\
        ""]
    ::msgcat::mcset tr MONTHS_FULL [list \
        "Ocak"\
        "Şubat"\
        "Mart"\
        "Nisan"\
        "Mayıs"\
        "Haziran"\
        "Temmuz"\
        "Ağustos"\
        "Eylül"\
        "Ekim"\
        "Kasım"\
        "Aralık"\
        ""]
    ::msgcat::mcset tr DATE_FORMAT "%d.%m.%Y"
    ::msgcat::mcset tr TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset tr DATE_TIME_FORMAT "%d.%m.%Y %H:%M:%S %z"

::msgcat::mcset tr DAYS_OF_WEEK_ABBREV [list \
	"Paz"\
	"Pzt"\
	"Sal"\
	"Çar"\
	"Per"\
	"Cum"\
	"Cmt"]
::msgcat::mcset tr DAYS_OF_WEEK_FULL [list \
	"Pazar"\
	"Pazartesi"\
	"Salı"\
	"Çarşamba"\
	"Perşembe"\
	"Cuma"\
	"Cumartesi"]
::msgcat::mcset tr MONTHS_ABBREV [list \
	"Oca"\
	"Şub"\
	"Mar"\
	"Nis"\
	"May"\
	"Haz"\
	"Tem"\
	"Ağu"\
	"Eyl"\
	"Eki"\
	"Kas"\
	"Ara"\
	""]
::msgcat::mcset tr MONTHS_FULL [list \
	"Ocak"\
	"Şubat"\
	"Mart"\
	"Nisan"\
	"Mayıs"\
	"Haziran"\
	"Temmuz"\
	"Ağustos"\
	"Eylül"\
	"Ekim"\
	"Kasım"\
	"Aralık"\
	""]
::msgcat::mcset tr DATE_FORMAT "%d.%m.%Y"
::msgcat::mcset tr TIME_FORMAT "%H:%M:%S"
::msgcat::mcset tr DATE_TIME_FORMAT "%d.%m.%Y %H:%M:%S %z"
}
Changes to library/msgs/uk.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset uk DAYS_OF_WEEK_ABBREV [list \
        "нд"\
        "пн"\
        "вт"\
        "ср"\
        "чт"\
        "пт"\
        "сб"]
    ::msgcat::mcset uk DAYS_OF_WEEK_FULL [list \
        "неділя"\
        "понеділок"\
        "вівторок"\
        "середа"\
        "четвер"\
        "п'ятниця"\
        "субота"]
    ::msgcat::mcset uk MONTHS_ABBREV [list \
        "січ"\
        "лют"\
        "бер"\
        "квіт"\
        "трав"\
        "черв"\
        "лип"\
        "серп"\
        "вер"\
        "жовт"\
        "лист"\
        "груд"\
        ""]
    ::msgcat::mcset uk MONTHS_FULL [list \
        "січня"\
        "лютого"\
        "березня"\
        "квітня"\
        "травня"\
        "червня"\
        "липня"\
        "серпня"\
        "вересня"\
        "жовтня"\
        "листопада"\
        "грудня"\
        ""]
    ::msgcat::mcset uk BCE "до н.е."
    ::msgcat::mcset uk CE "після н.е."
    ::msgcat::mcset uk DATE_FORMAT "%e/%m/%Y"
    ::msgcat::mcset uk TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset uk DATE_TIME_FORMAT "%e/%m/%Y %k:%M:%S %z"

::msgcat::mcset uk DAYS_OF_WEEK_ABBREV [list \
	"нд"\
	"пн"\
	"вт"\
	"ср"\
	"чт"\
	"пт"\
	"сб"]
::msgcat::mcset uk DAYS_OF_WEEK_FULL [list \
	"неділя"\
	"понеділок"\
	"вівторок"\
	"середа"\
	"четвер"\
	"п'ятниця"\
	"субота"]
::msgcat::mcset uk MONTHS_ABBREV [list \
	"січ"\
	"лют"\
	"бер"\
	"квіт"\
	"трав"\
	"черв"\
	"лип"\
	"серп"\
	"вер"\
	"жовт"\
	"лист"\
	"груд"\
	""]
::msgcat::mcset uk MONTHS_FULL [list \
	"січня"\
	"лютого"\
	"березня"\
	"квітня"\
	"травня"\
	"червня"\
	"липня"\
	"серпня"\
	"вересня"\
	"жовтня"\
	"листопада"\
	"грудня"\
	""]
::msgcat::mcset uk BCE "до н.е."
::msgcat::mcset uk CE "після н.е."
::msgcat::mcset uk DATE_FORMAT "%e/%m/%Y"
::msgcat::mcset uk TIME_FORMAT "%k:%M:%S"
::msgcat::mcset uk DATE_TIME_FORMAT "%e/%m/%Y %k:%M:%S %z"
}
Changes to library/msgs/vi.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset vi DAYS_OF_WEEK_ABBREV [list \
        "Th 2"\
        "Th 3"\
        "Th 4"\
        "Th 5"\
        "Th 6"\
        "Th 7"\
        "CN"]
    ::msgcat::mcset vi DAYS_OF_WEEK_FULL [list \
        "Thứ hai"\
        "Thứ ba"\
        "Thứ tư"\
        "Thứ năm"\
        "Thứ sáu"\
        "Thứ bảy"\
        "Chủ nhật"]
    ::msgcat::mcset vi MONTHS_ABBREV [list \
        "Thg 1"\
        "Thg 2"\
        "Thg 3"\
        "Thg 4"\
        "Thg 5"\
        "Thg 6"\
        "Thg 7"\
        "Thg 8"\
        "Thg 9"\
        "Thg 10"\
        "Thg 11"\
        "Thg 12"\
        ""]
    ::msgcat::mcset vi MONTHS_FULL [list \
        "Tháng một"\
        "Tháng hai"\
        "Tháng ba"\
        "Tháng tư"\
        "Tháng năm"\
        "Tháng sáu"\
        "Tháng bảy"\
        "Tháng tám"\
        "Tháng chín"\
        "Tháng mười"\
        "Tháng mười một"\
        "Tháng mười hai"\
        ""]
    ::msgcat::mcset vi DATE_FORMAT "%d %b %Y"
    ::msgcat::mcset vi TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset vi DATE_TIME_FORMAT "%d %b %Y %H:%M:%S %z"

::msgcat::mcset vi DAYS_OF_WEEK_ABBREV [list \
	"Th 2"\
	"Th 3"\
	"Th 4"\
	"Th 5"\
	"Th 6"\
	"Th 7"\
	"CN"]
::msgcat::mcset vi DAYS_OF_WEEK_FULL [list \
	"Thứ hai"\
	"Thứ ba"\
	"Thứ tư"\
	"Thứ năm"\
	"Thứ sáu"\
	"Thứ bảy"\
	"Chủ nhật"]
::msgcat::mcset vi MONTHS_ABBREV [list \
	"Thg 1"\
	"Thg 2"\
	"Thg 3"\
	"Thg 4"\
	"Thg 5"\
	"Thg 6"\
	"Thg 7"\
	"Thg 8"\
	"Thg 9"\
	"Thg 10"\
	"Thg 11"\
	"Thg 12"\
	""]
::msgcat::mcset vi MONTHS_FULL [list \
	"Tháng một"\
	"Tháng hai"\
	"Tháng ba"\
	"Tháng tư"\
	"Tháng năm"\
	"Tháng sáu"\
	"Tháng bảy"\
	"Tháng tám"\
	"Tháng chín"\
	"Tháng mười"\
	"Tháng mười một"\
	"Tháng mười hai"\
	""]
::msgcat::mcset vi DATE_FORMAT "%d %b %Y"
::msgcat::mcset vi TIME_FORMAT "%H:%M:%S"
::msgcat::mcset vi DATE_TIME_FORMAT "%d %b %Y %H:%M:%S %z"
}
Changes to library/msgs/zh.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset zh DAYS_OF_WEEK_ABBREV [list \
        "星期日"\
        "星期一"\
        "星期二"\
        "星期三"\
        "星期四"\
        "星期五"\
        "星期六"]
    ::msgcat::mcset zh DAYS_OF_WEEK_FULL [list \
        "星期日"\
        "星期一"\
        "星期二"\
        "星期三"\
        "星期四"\
        "星期五"\
        "星期六"]
    ::msgcat::mcset zh MONTHS_ABBREV [list \
        "一月"\
        "二月"\
        "三月"\
        "四月"\
        "五月"\
        "六月"\
        "七月"\
        "八月"\
        "九月"\
        "十月"\
        "十一月"\
        "十二月"\
        ""]
    ::msgcat::mcset zh MONTHS_FULL [list \
        "一月"\
        "二月"\
        "三月"\
        "四月"\
        "五月"\
        "六月"\
        "七月"\
        "八月"\
        "九月"\
        "十月"\
        "十一月"\
        "十二月"\
        ""]
    ::msgcat::mcset zh BCE "公元前"
    ::msgcat::mcset zh CE "公元"
    ::msgcat::mcset zh AM "上午"
    ::msgcat::mcset zh PM "下午"
    ::msgcat::mcset zh LOCALE_NUMERALS "〇 一 二 三 四 五 六 七 八 九 十 十一 十二 十三 十四 十五 十六 十七 十八 十九 二十 廿一 廿二 廿三 廿四 廿五 廿六 廿七 廿八 廿九 三十 卅一 卅二 卅三 卅四 卅五 卅六 卅七 卅八 卅九 四十 四十一 四十二 四十三 四十四 四十五 四十六 四十七 四十八 四十九 五十 五十一 五十二 五十三 五十四 五十五 五十六 五十七 五十八 五十九 六十 六十一 六十二 六十三 六十四 六十五 六十六 六十七 六十八 六十九 七十 七十一 七十二 七十三 七十四 七十五 七十六 七十七 七十八 七十九 八十 八十一 八十二 八十三 八十四 八十五 八十六 八十七 八十八 八十九 九十 九十一 九十二 九十三 九十四 九十五 九十六 九十七 九十八 九十九"
    ::msgcat::mcset zh LOCALE_DATE_FORMAT "公元%Y年%B%Od日"
    ::msgcat::mcset zh LOCALE_TIME_FORMAT "%OH时%OM分%OS秒"
    ::msgcat::mcset zh LOCALE_DATE_TIME_FORMAT "%A %Y年%B%Od日%OH时%OM分%OS秒 %z"

::msgcat::mcset zh DAYS_OF_WEEK_ABBREV [list \
	"星期日"\
	"星期一"\
	"星期二"\
	"星期三"\
	"星期四"\
	"星期五"\
	"星期六"]
::msgcat::mcset zh DAYS_OF_WEEK_FULL [list \
	"星期日"\
	"星期一"\
	"星期二"\
	"星期三"\
	"星期四"\
	"星期五"\
	"星期六"]
::msgcat::mcset zh MONTHS_ABBREV [list \
	"一月"\
	"二月"\
	"三月"\
	"四月"\
	"五月"\
	"六月"\
	"七月"\
	"八月"\
	"九月"\
	"十月"\
	"十一月"\
	"十二月"\
	""]
::msgcat::mcset zh MONTHS_FULL [list \
	"一月"\
	"二月"\
	"三月"\
	"四月"\
	"五月"\
	"六月"\
	"七月"\
	"八月"\
	"九月"\
	"十月"\
	"十一月"\
	"十二月"\
	""]
::msgcat::mcset zh BCE "公元前"
::msgcat::mcset zh CE "公元"
::msgcat::mcset zh AM "上午"
::msgcat::mcset zh PM "下午"
::msgcat::mcset zh LOCALE_NUMERALS "〇 一 二 三 四 五 六 七 八 九 十 十一 十二 十三 十四 十五 十六 十七 十八 十九 二十 廿一 廿二 廿三 廿四 廿五 廿六 廿七 廿八 廿九 三十 卅一 卅二 卅三 卅四 卅五 卅六 卅七 卅八 卅九 四十 四十一 四十二 四十三 四十四 四十五 四十六 四十七 四十八 四十九 五十 五十一 五十二 五十三 五十四 五十五 五十六 五十七 五十八 五十九 六十 六十一 六十二 六十三 六十四 六十五 六十六 六十七 六十八 六十九 七十 七十一 七十二 七十三 七十四 七十五 七十六 七十七 七十八 七十九 八十 八十一 八十二 八十三 八十四 八十五 八十六 八十七 八十八 八十九 九十 九十一 九十二 九十三 九十四 九十五 九十六 九十七 九十八 九十九"
::msgcat::mcset zh LOCALE_DATE_FORMAT "公元%Y年%B%Od日"
::msgcat::mcset zh LOCALE_TIME_FORMAT "%OH时%OM分%OS秒"
::msgcat::mcset zh LOCALE_DATE_TIME_FORMAT "%A %Y年%B%Od日%OH时%OM分%OS秒 %z"
}
Changes to library/msgs/zh_cn.msg.
1
2
3
4
5
6





7
1





2
3
4
5
6


-
-
-
-
-
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset zh_CN DATE_FORMAT "%Y-%m-%e"
    ::msgcat::mcset zh_CN TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset zh_CN TIME_FORMAT_12 "%P%I时%M分%S秒"
    ::msgcat::mcset zh_CN DATE_TIME_FORMAT "%Y-%m-%e %k:%M:%S %z"

::msgcat::mcset zh_CN DATE_FORMAT "%Y-%m-%e"
::msgcat::mcset zh_CN TIME_FORMAT "%k:%M:%S"
::msgcat::mcset zh_CN TIME_FORMAT_12 "%P%I时%M分%S秒"
::msgcat::mcset zh_CN DATE_TIME_FORMAT "%Y-%m-%e %k:%M:%S %z"
}
Changes to library/msgs/zh_hk.msg.
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
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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset zh_HK DAYS_OF_WEEK_ABBREV [list \
        "日"\
        "一"\
        "二"\
        "三"\
        "四"\
        "五"\
        "六"]
    ::msgcat::mcset zh_HK MONTHS_ABBREV [list \
        "1月"\
        "2月"\
        "3月"\
        "4月"\
        "5月"\
        "6月"\
        "7月"\
        "8月"\
        "9月"\
        "10月"\
        "11月"\
        "12月"\
        ""]
    ::msgcat::mcset zh_HK DATE_FORMAT "%Y年%m月%e日"
    ::msgcat::mcset zh_HK TIME_FORMAT_12 "%P%I:%M:%S"
    ::msgcat::mcset zh_HK DATE_TIME_FORMAT "%Y年%m月%e日 %P%I:%M:%S %z"

::msgcat::mcset zh_HK DAYS_OF_WEEK_ABBREV [list \
	"日"\
	"一"\
	"二"\
	"三"\
	"四"\
	"五"\
	"六"]
::msgcat::mcset zh_HK MONTHS_ABBREV [list \
	"1月"\
	"2月"\
	"3月"\
	"4月"\
	"5月"\
	"6月"\
	"7月"\
	"8月"\
	"9月"\
	"10月"\
	"11月"\
	"12月"\
	""]
::msgcat::mcset zh_HK DATE_FORMAT "%Y年%m月%e日"
::msgcat::mcset zh_HK TIME_FORMAT_12 "%P%I:%M:%S"
::msgcat::mcset zh_HK DATE_TIME_FORMAT "%Y年%m月%e日 %P%I:%M:%S %z"
}
Changes to library/msgs/zh_sg.msg.
1
2
3
4
5
6
7






8
1






2
3
4
5
6
7


-
-
-
-
-
-
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset zh_SG AM "上午"
    ::msgcat::mcset zh_SG PM "中午"
    ::msgcat::mcset zh_SG DATE_FORMAT "%d %B %Y"
    ::msgcat::mcset zh_SG TIME_FORMAT_12 "%P %I:%M:%S"
    ::msgcat::mcset zh_SG DATE_TIME_FORMAT "%d %B %Y %P %I:%M:%S %z"

::msgcat::mcset zh_SG AM "上午"
::msgcat::mcset zh_SG PM "中午"
::msgcat::mcset zh_SG DATE_FORMAT "%d %B %Y"
::msgcat::mcset zh_SG TIME_FORMAT_12 "%P %I:%M:%S"
::msgcat::mcset zh_SG DATE_TIME_FORMAT "%d %B %Y %P %I:%M:%S %z"
}
Changes to library/msgs/zh_tw.msg.
1
2
3
4
5
6
7






8
1






2
3
4
5
6
7


-
-
-
-
-
-
+
+
+
+
+
+
-
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset zh_TW BCE "民國前"
    ::msgcat::mcset zh_TW CE "民國"
    ::msgcat::mcset zh_TW DATE_FORMAT "%Y/%m/%e"
    ::msgcat::mcset zh_TW TIME_FORMAT_12 "%P %I:%M:%S"
    ::msgcat::mcset zh_TW DATE_TIME_FORMAT "%Y/%m/%e %P %I:%M:%S %z"

::msgcat::mcset zh_TW BCE "民國前"
::msgcat::mcset zh_TW CE "民國"
::msgcat::mcset zh_TW DATE_FORMAT "%Y/%m/%e"
::msgcat::mcset zh_TW TIME_FORMAT_12 "%P %I:%M:%S"
::msgcat::mcset zh_TW DATE_TIME_FORMAT "%Y/%m/%e %P %I:%M:%S %z"
}
Changes to library/opt/optparse.tcl.







1
2
3
4
5
6
7
1
2
3
4
5
6
7
8
9
10
11
12
13
14
+
+
+
+
+
+
+







# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# optparse.tcl --
#
#       (private) Option parsing package
#       Primarily used internally by the safe:: code.
#
#	WARNING: This code will go away in a future release
#	of Tcl.  It is NOT supported and you should not rely
Changes to library/opt/pkgIndex.tcl.







1
2
3
4
5
6
7
1
2
3
4
5
6
7
8
9
10
11
12
13
14
+
+
+
+
+
+
+







# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex -direct" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
Changes to library/package.tcl.
1
2
3
4
5
6
7
8
9
10
11







12
13
14
15
16
17
18
1
2
3
4
5
6
7
8
9
10

11
12
13
14
15
16
17
18
19
20
21
22
23
24










-
+
+
+
+
+
+
+







# package.tcl --
#
# utility procs formerly in init.tcl which can be loaded on demand
# for package management.
#
# Copyright © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1998 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

namespace eval tcl::Pkg {}

# ::tcl::Pkg::CompareExtension --
#
# Used internally by pkg_mkIndex to compare the extension of a file to a given
# extension. On Windows, it uses a case-insensitive comparison because the
Changes to library/parray.tcl.
1
2
3
4
5
6
7
8
9







10
11
12
13
14
15
16
1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
16
17
18
19
20
21
22








-
+
+
+
+
+
+
+







# parray:
# Print the contents of a global array on stdout.
#
# Copyright © 1991-1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

proc parray {a {pattern *}} {
    upvar 1 $a array
    if {![array exists array]} {
	return -code error "\"$a\" isn't an array"
    }
    set maxl 0
Changes to library/platform/platform.tcl.






1

2
3
4
5
6
7
8
1
2
3
4
5
6

7
8
9
10
11
12
13
14
+
+
+
+
+
+
-
+







# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# -*- tcl -*-

# ### ### ### ######### ######### #########
## Overview

# Heuristics to assemble a platform identifier from publicly available
# information. The identifier describes the platform of the currently
# running tcl shell. This is a mixture of the runtime environment and
# of build-time properties of the executable itself.
Changes to library/platform/shell.tcl.



1
2




3
4
5
6
7
8
9
1
2
3


4
5
6
7
8
9
10
11
12
13
14
+
+
+
-
-
+
+
+
+







# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.

# -*- tcl -*-
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# ### ### ### ######### ######### #########
## Overview

# Higher-level commands which invoke the functionality of this package
# for an arbitrary tcl shell (tclsh, wish, ...). This is required by a
# repository as while the tcl shell executing packages uses the same
# platform in general as a repository application there can be
Changes to library/safe.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
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
+
+
+
+
+
+
+
+
+
+
+
+








-
+
-
-
-
-
-
-




-







# Copyright © 1996-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.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# safe.tcl --
#
# This file provide a safe loading/sourcing mechanism for safe interpreters.
# It implements a virtual path mecanism to hide the real pathnames from the
# child. It runs in a parent interpreter and sets up data structure and
# aliases that will be invoked when used from a child interpreter.
#
# See the safe.n man page for details.
#

# Copyright © 1996-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.

#
# The implementation is based on namespaces. These naming conventions are
# followed:
# Private procs starts with uppercase.
# Public  procs are exported and starts with lowercase
#

# Needed utilities package
package require opt 0.4.9

# Create the safe namespace
namespace eval ::safe {
    # Exported API:
Changes to library/tclIndex.
Changes to library/tcltest/pkgIndex.tcl.







1
2
3
4
5
6
7
1
2
3
4
5
6
7
8
9
10
11
12
13
14
+
+
+
+
+
+
+







# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex -direct" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
Changes to library/tcltest/tcltest.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
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
+
+
+
+
+
+
+
+
+
+
+
+
+











-
-
-
-
-
-







# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
# Copyright © 2000 Ajuba Solutions
# Contributions from Don Porter, NIST, 2002.  (not subject to US copyright)
# All rights reserved.
#
# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# tcltest.tcl --
#
#	This file contains support code for the Tcl test suite.  It
#       defines the tcltest namespace and finds and defines the output
#       directory, constraints available, output and error channels,
#	etc. used by Tcl tests.  See the tcltest man page for more
#	details.
#
#       This design was based on the Tcl testing approach designed and
#       initially implemented by Mary Ann May-Pumphrey of Sun
#	Microsystems.
#
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
# Copyright © 2000 Ajuba Solutions
# Contributions from Don Porter, NIST, 2002.  (not subject to US copyright)
# All rights reserved.

namespace eval tcltest {

    # When the version number changes, be sure to update the pkgIndex.tcl file,
    # and the install directory in the Makefiles.  When the minor version
    # changes (new feature) be sure to update the man page as well.
    variable Version 2.5.8
399
400
401
402
403
404
405
406

407
408
409
410
411
412
413
406
407
408
409
410
411
412

413
414
415
416
417
418
419
420







-
+







	    stderr -
	    stdout {
		set outputChannel $filename
	    }
	    default {
		set outputChannel [open $filename a]
		if {$fullutf} {
		    fconfigure $outputChannel -profile tcl8 -encoding utf-8
		    fconfigure $outputChannel -encoding utf-8
		}
		set ChannelsWeOpened($outputChannel) 1

		# If we created the file in [temporaryDirectory], then
		# [cleanupTests] will delete it, unless we claim it was
		# already there.
		set outdir [normalizePath [file dirname \
447
448
449
450
451
452
453
454

455
456
457
458
459
460
461
454
455
456
457
458
459
460

461
462
463
464
465
466
467
468







-
+







	    stderr -
	    stdout {
		set errorChannel $filename
	    }
	    default {
		set errorChannel [open $filename a]
		if {$fullutf} {
		    fconfigure $errorChannel -profile tcl8 -encoding utf-8
		    fconfigure $errorChannel -encoding utf-8
		}
		set ChannelsWeOpened($errorChannel) 1

		# If we created the file in [temporaryDirectory], then
		# [cleanupTests] will delete it, unless we claim it was
		# already there.
		set outdir [normalizePath [file dirname \
794
795
796
797
798
799
800
801

802
803
804
805
806
807
808
801
802
803
804
805
806
807

808
809
810
811
812
813
814
815







-
+







    proc ReadLoadScript {args} {
	variable Option
	variable fullutf

	if {$Option(-loadfile) eq {}} {return}
	set tmp [open $Option(-loadfile) r]
	if {$fullutf} {
	    fconfigure $tmp -profile tcl8 -encoding utf-8
	    fconfigure $tmp -encoding utf-8
	}
	loadScript [read $tmp]
	close $tmp
    }
    Option -loadfile {} {
	Read the script to load the tested commands from the specified file.
    } AcceptLoadFile loadFile
1135
1136
1137
1138
1139
1140
1141

1142
1143
1144
1145
1146
1147
1148
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156







+







    if {$n2 eq {}} {return}
    if {![info exists testConstraints($n2)]} {
	if {[catch {testConstraint $n2 [eval [ConstraintInitializer $n2]]}]} {
	    testConstraint $n2 0
	}
    }
}


# tcltest::Asciify --
#
#       Transforms the passed string to contain only printable ascii characters.
#       Useful for printing to terminals. Non-printables are mapped to
#       \x, \u or \U sequences, except \n.
#
1379
1380
1381
1382
1383
1384
1385
1386

1387
1388
1389
1390
1391
1392
1393
1387
1388
1389
1390
1391
1392
1393

1394
1395
1396
1397
1398
1399
1400
1401







-
+








    ConstraintInitializer stdio {
	variable fullutf

	set code 0
	if {![catch {set f [open "|[list [interpreter]]" w]}]} {
	    if {$fullutf} {
		fconfigure $f -profile tcl8 -encoding utf-8
		fconfigure $f -encoding utf-8
	    }
	    if {![catch {puts $f exit}]} {
		if {![catch {close $f}]} {
		    set code 1
		}
	    }
	}
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
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







-
+











-
+







	1 {
	    # Only the string to be printed is specified
	    append outData [lindex $args 0]\n
	    return
	    # return [Puts [lindex $args 0]]
	}
	2 {
	    # Either -nonewline or channel has been specified
	    # Either -nonewline or channelId has been specified
	    if {[lindex $args 0] eq "-nonewline"} {
		append outData [lindex $args end]
		return
		# return [Puts -nonewline [lindex $args end]]
	    } else {
		set channel [lindex $args 0]
		set newline \n
	    }
	}
	3 {
	    if {[lindex $args 0] eq "-nonewline"} {
		# Both -nonewline and channel are specified, unless
		# Both -nonewline and channelId are specified, unless
		# it's an error.  -nonewline is supposed to be argv[0].
		set channel [lindex $args 1]
		set newline ""
	    }
	}
    }

2231
2232
2233
2234
2235
2236
2237
2238

2239
2240
2241
2242
2243
2244
2245
2239
2240
2241
2242
2243
2244
2245

2246
2247
2248
2249
2250
2251
2252
2253







-
+







	    set testFile [dict get $testFrame file]
	    set testLine [dict get $testFrame line]
	} else {
	    set testFile [file normalize [uplevel 1 {info script}]]
	    if {[file readable $testFile]} {
		set testFd [open $testFile r]
		if {$fullutf} {
		    fconfigure $testFd -profile tcl8 -encoding utf-8
		    fconfigure $testFd -encoding utf-8
		}
		set testLine [expr {[lsearch -regexp \
			[split [read $testFd] "\n"] \
			"^\[ \t\]*test [string map {. \\.} $name] "] + 1}]
		close $testFd
	    }
	}
2262
2263
2264
2265
2266
2267
2268
2269
2270

2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2270
2271
2272
2273
2274
2275
2276


2277



2278
2279
2280
2281
2282
2283
2284







-
-
+
-
-
-







	    puts [outputChannel] "---- errorCode(setup): $errorCodeRes(setup)"
	}
    }
    if {$processTest && $scriptFailure} {
	if {$scriptCompare} {
	    puts [outputChannel] "---- Error testing result: $scriptMatch"
	} else {
	    if {[catch {
		puts [outputChannel] "---- Result was:\n[Asciify $actualAnswer]"
	    puts [outputChannel] "---- Result was:\n[Asciify $actualAnswer]"
	    } errMsg]} {
		puts [outputChannel] "\n---- Result was:\n<error printing result: $errMsg>"
	    }
	    puts [outputChannel] "---- Result should have been\
		    ($match matching):\n[Asciify $result]"
	}
    }
    if {$errorCodeFailure} {
	puts [outputChannel] "---- Error code was: '$errorCodeRes(body)'"
	puts [outputChannel] "---- Error code should have been: '$errorCode'"
2948
2949
2950
2951
2952
2953
2954
2955

2956
2957
2958
2959
2960
2961
2962
2952
2953
2954
2955
2956
2957
2958

2959
2960
2961
2962
2963
2964
2965
2966







-
+







		lappend childargv $opt $value
	    }
	    set cmd [linsert $childargv 0 | $shell $file]
	    if {[catch {
		incr numTestFiles
		set pipeFd [open $cmd "r"]
		if {$fullutf} {
		    fconfigure $pipeFd -profile tcl8 -encoding utf-8
		    fconfigure $pipeFd -encoding utf-8
		}
		while {[gets $pipeFd line] >= 0} {
		    if {[regexp [join {
			    {^([^:]+):\t}
			    {Total\t([0-9]+)\t}
			    {Passed\t([0-9]+)\t}
			    {Skipped\t([0-9]+)\t}
3150
3151
3152
3153
3154
3155
3156
3157

3158
3159
3160
3161
3162
3163
3164
3154
3155
3156
3157
3158
3159
3160

3161
3162
3163
3164
3165
3166
3167
3168







-
+








    DebugPuts 3 "[lindex [info level 0] 0]:\
	     putting ``$contents'' into $fullName"

    set fd [open $fullName w]
    fconfigure $fd -translation lf
    if {$fullutf} {
	fconfigure $fd -profile tcl8 -encoding utf-8
	fconfigure $fd -encoding utf-8
    }
    if {[string index $contents end] eq "\n"} {
	puts -nonewline $fd $contents
    } else {
	puts $fd $contents
    }
    close $fd
3303
3304
3305
3306
3307
3308
3309
3310

3311
3312
3313
3314
3315
3316
3317
3307
3308
3309
3310
3311
3312
3313

3314
3315
3316
3317
3318
3319
3320
3321







-
+







    FillFilesExisted
    if {[llength [info level 0]] == 2} {
	set directory [temporaryDirectory]
    }
    set fullName [file join $directory $name]
    set f [open $fullName]
    if {$fullutf} {
	fconfigure $f -profile tcl8 -encoding utf-8
	fconfigure $f -encoding utf-8
    }
    set data [read -nonewline $f]
    close $f
    return $data
}

# tcltest::bytestring --
Changes to library/tm.tcl.
1



2


3
4
5
6

7
8
9
10
11
12
13

1
2
3
4
5
6
7
8
9

10
11
12
13
14
15
16
17
-
+
+
+

+
+



-
+







# -*- tcl -*-
# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# Searching for Tcl Modules. Defines a procedure, declares it as the primary
# command for finding packages, however also uses the former 'package unknown'
# command as a fallback.
#

# Locates all possible packages in a directory via a less restricted glob. The
# targeted directory is derived from the name of the requested package, i.e.
# the TM scan will look only at directories which can contain the requested
# package. It will register all packages it found in the directory so that
# future requests have a higher chance of being fulfilled by the ifneeded
# database without having to come to us again.
#
Changes to library/word.tcl.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# word.tcl --
#
# This file defines various procedures for computing word boundaries in
# strings. This file is primarily needed so Tk text and entry widgets behave
# properly for different platforms.
#
# Copyright © 1996 Sun Microsystems, Inc.
# Copyright © 1998 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# word.tcl --
#
# This file defines various procedures for computing word boundaries in
# strings. This file is primarily needed so Tk text and entry widgets behave
# properly for different platforms.

# The following variables are used to determine which characters are
# interpreted as word characters. See bug [f1253530cdd8]. Will
# probably be removed in Tcl 9.

if {![info exists ::tcl_wordchars]} {
    set ::tcl_wordchars {\w}
Deleted libtommath/appveyor.yml.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20




















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
version: 1.3.0-{build}
branches:
  only:
  - master
  - develop
  - /^release/
  - /^travis/
image:
- Visual Studio 2019
- Visual Studio 2017
- Visual Studio 2015
build_script:
- cmd: >-
    if "Visual Studio 2019"=="%APPVEYOR_BUILD_WORKER_IMAGE%" call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvars64.bat"
        if "Visual Studio 2017"=="%APPVEYOR_BUILD_WORKER_IMAGE%" call "C:\Program Files (x86)\Microsoft Visual Studio\2017\Community\VC\Auxiliary\Build\vcvars64.bat"
        if "Visual Studio 2015"=="%APPVEYOR_BUILD_WORKER_IMAGE%" call "C:\Program Files\Microsoft SDKs\Windows\v7.1\Bin\SetEnv.cmd" /x64
        if "Visual Studio 2015"=="%APPVEYOR_BUILD_WORKER_IMAGE%" call "C:\Program Files (x86)\Microsoft Visual Studio 14.0\VC\vcvarsall.bat" x86_amd64
        nmake -f makefile.msvc all
test_script:
- cmd: test.exe
Changes to libtommath/bn_mp_root_n.c.
14
15
16
17
18
19
20
21

22
23
24
25
26
27
28
14
15
16
17
18
19
20

21
22
23
24
25
26
27
28







-
+







 */
mp_err mp_root_n(const mp_int *a, int b, mp_int *c)
{
   mp_int t1, t2, t3, a_;
   int    ilog2;
   mp_err err;

   if ((unsigned)b > (unsigned)MP_MIN(MP_DIGIT_MAX, INT_MAX)) {
   if (b < 0 || (unsigned)b > (unsigned)MP_DIGIT_MAX) {
      return MP_VAL;
   }

   /* input must be positive if b is even */
   if (((b & 1) == 0) && mp_isneg(a)) {
      return MP_VAL;
   }
Deleted libtommath/helper.pl.
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
































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#!/usr/bin/env perl

use strict;
use warnings;

use Getopt::Long;
use File::Find 'find';
use File::Basename 'basename';
use File::Glob 'bsd_glob';

sub read_file {
  my $f = shift;
  open my $fh, "<", $f or die "FATAL: read_rawfile() cannot open file '$f': $!";
  binmode $fh;
  return do { local $/; <$fh> };
}

sub write_file {
  my ($f, $data) = @_;
  die "FATAL: write_file() no data" unless defined $data;
  open my $fh, ">", $f or die "FATAL: write_file() cannot open file '$f': $!";
  binmode $fh;
  print $fh $data or die "FATAL: write_file() cannot write to '$f': $!";
  close $fh or die "FATAL: write_file() cannot close '$f': $!";
  return;
}

sub sanitize_comments {
  my($content) = @_;
  $content =~ s{/\*(.*?)\*/}{my $x=$1; $x =~ s/\w/x/g; "/*$x*/";}egs;
  return $content;
}

sub check_source {
  my @all_files = (
        bsd_glob("makefile*"),
        bsd_glob("*.{h,c,sh,pl}"),
        bsd_glob("*/*.{h,c,sh,pl}"),
  );

  my $fails = 0;
  for my $file (sort @all_files) {
    my $troubles = {};
    my $lineno = 1;
    my $content = read_file($file);
    $content = sanitize_comments $content;
    push @{$troubles->{crlf_line_end}}, '?' if $content =~ /\r/;
    for my $l (split /\n/, $content) {
      push @{$troubles->{merge_conflict}},     $lineno if $l =~ /^(<<<<<<<|=======|>>>>>>>)([^<=>]|$)/;
      push @{$troubles->{trailing_space}},     $lineno if $l =~ / $/;
      push @{$troubles->{tab}},                $lineno if $l =~ /\t/ && basename($file) !~ /^makefile/i;
      push @{$troubles->{non_ascii_char}},     $lineno if $l =~ /[^[:ascii:]]/;
      push @{$troubles->{cpp_comment}},        $lineno if $file =~ /\.(c|h)$/ && ($l =~ /\s\/\// || $l =~ /\/\/\s/);
      # we prefer using MP_MALLOC, MP_FREE, MP_REALLOC, MP_CALLOC ...
      push @{$troubles->{unwanted_malloc}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmalloc\s*\(/;
      push @{$troubles->{unwanted_realloc}},   $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\brealloc\s*\(/;
      push @{$troubles->{unwanted_calloc}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bcalloc\s*\(/;
      push @{$troubles->{unwanted_free}},      $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bfree\s*\(/;
      # and we probably want to also avoid the following
      push @{$troubles->{unwanted_memcpy}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemcpy\s*\(/;
      push @{$troubles->{unwanted_memset}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemset\s*\(/;
      push @{$troubles->{unwanted_memcpy}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemcpy\s*\(/;
      push @{$troubles->{unwanted_memmove}},   $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemmove\s*\(/;
      push @{$troubles->{unwanted_memcmp}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemcmp\s*\(/;
      push @{$troubles->{unwanted_strcmp}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bstrcmp\s*\(/;
      push @{$troubles->{unwanted_strcpy}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bstrcpy\s*\(/;
      push @{$troubles->{unwanted_strncpy}},   $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bstrncpy\s*\(/;
      push @{$troubles->{unwanted_clock}},     $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bclock\s*\(/;
      push @{$troubles->{unwanted_qsort}},     $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bqsort\s*\(/;
      push @{$troubles->{sizeof_no_brackets}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bsizeof\s*[^\(]/;
      if ($file =~ m|^[^\/]+\.c$| && $l =~ /^static(\s+[a-zA-Z0-9_]+)+\s+([a-zA-Z0-9_]+)\s*\(/) {
        my $funcname = $2;
        # static functions should start with s_
        push @{$troubles->{staticfunc_name}}, "$lineno($funcname)" if $funcname !~ /^s_/;
      }
      $lineno++;
    }
    for my $k (sort keys %$troubles) {
      warn "[$k] $file line:" . join(",", @{$troubles->{$k}}) . "\n";
      $fails++;
    }
  }

  warn( $fails > 0 ? "check-source:    FAIL $fails\n" : "check-source:    PASS\n" );
  return $fails;
}

sub check_comments {
  my $fails = 0;
  my $first_comment = <<'MARKER';
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */
MARKER
  #my @all_files = (bsd_glob("*.{h,c}"), bsd_glob("*/*.{h,c}"));
  my @all_files = (bsd_glob("*.{h,c}"));
  for my $f (@all_files) {
    my $txt = read_file($f);
    if ($txt !~ /\Q$first_comment\E/s) {
      warn "[first_comment] $f\n";
      $fails++;
    }
  }
  warn( $fails > 0 ? "check-comments:  FAIL $fails\n" : "check-comments:  PASS\n" );
  return $fails;
}

sub check_doc {
  my $fails = 0;
  my $tex = read_file('doc/bn.tex');
  my $tmh = read_file('tommath.h');
  my @functions = $tmh =~ /\n\s*[a-zA-Z0-9_* ]+?(mp_[a-z0-9_]+)\s*\([^\)]+\)\s*;/sg;
  my @macros    = $tmh =~ /\n\s*#define\s+([a-z0-9_]+)\s*\([^\)]+\)/sg;
  for my $n (sort @functions) {
    (my $nn = $n) =~ s/_/\\_/g; # mp_sub_d >> mp\_sub\_d
    if ($tex !~ /index\Q{$nn}\E/) {
      warn "[missing_doc_for_function] $n\n";
      $fails++
    }
  }
  for my $n (sort @macros) {
    (my $nn = $n) =~ s/_/\\_/g; # mp_iszero >> mp\_iszero
    if ($tex !~ /index\Q{$nn}\E/) {
      warn "[missing_doc_for_macro] $n\n";
      $fails++
    }
  }
  warn( $fails > 0 ? "check_doc:       FAIL $fails\n" : "check-doc:       PASS\n" );
  return $fails;
}

sub prepare_variable {
  my ($varname, @list) = @_;
  my $output = "$varname=";
  my $len = length($output);
  foreach my $obj (sort @list) {
    $len = $len + length $obj;
    $obj =~ s/\*/\$/;
    if ($len > 100) {
      $output .= "\\\n";
      $len = length $obj;
    }
    $output .= $obj . ' ';
  }
  $output =~ s/ $//;
  return $output;
}

sub prepare_msvc_files_xml {
  my ($all, $exclude_re, $targets) = @_;
  my $last = [];
  my $depth = 2;

  # sort files in the same order as visual studio (ugly, I know)
  my @parts = ();
  for my $orig (@$all) {
    my $p = $orig;
    $p =~ s|/|/~|g;
    $p =~ s|/~([^/]+)$|/$1|g;
    my @l = map { sprintf "% -99s", $_ } split /\//, $p;
    push @parts, [ $orig, join(':', @l) ];
  }
  my @sorted = map { $_->[0] } sort { $a->[1] cmp $b->[1] } @parts;

  my $files = "<Files>\r\n";
  for my $full (@sorted) {
    my @items = split /\//, $full; # split by '/'
    $full =~ s|/|\\|g;             # replace '/' bt '\'
    shift @items; # drop first one (src)
    pop @items;   # drop last one (filename.ext)
    my $current = \@items;
    if (join(':', @$current) ne join(':', @$last)) {
      my $common = 0;
      $common++ while ($last->[$common] && $current->[$common] && $last->[$common] eq $current->[$common]);
      my $back = @$last - $common;
      if ($back > 0) {
        $files .= ("\t" x --$depth) . "</Filter>\r\n" for (1..$back);
      }
      my $fwd = [ @$current ]; splice(@$fwd, 0, $common);
      for my $i (0..scalar(@$fwd) - 1) {
        $files .= ("\t" x $depth) . "<Filter\r\n";
        $files .= ("\t" x $depth) . "\tName=\"$fwd->[$i]\"\r\n";
        $files .= ("\t" x $depth) . "\t>\r\n";
        $depth++;
      }
      $last = $current;
    }
    $files .= ("\t" x $depth) . "<File\r\n";
    $files .= ("\t" x $depth) . "\tRelativePath=\"$full\"\r\n";
    $files .= ("\t" x $depth) . "\t>\r\n";
    if ($full =~ $exclude_re) {
      for (@$targets) {
        $files .= ("\t" x $depth) . "\t<FileConfiguration\r\n";
        $files .= ("\t" x $depth) . "\t\tName=\"$_\"\r\n";
        $files .= ("\t" x $depth) . "\t\tExcludedFromBuild=\"true\"\r\n";
        $files .= ("\t" x $depth) . "\t\t>\r\n";
        $files .= ("\t" x $depth) . "\t\t<Tool\r\n";
        $files .= ("\t" x $depth) . "\t\t\tName=\"VCCLCompilerTool\"\r\n";
        $files .= ("\t" x $depth) . "\t\t\tAdditionalIncludeDirectories=\"\"\r\n";
        $files .= ("\t" x $depth) . "\t\t\tPreprocessorDefinitions=\"\"\r\n";
        $files .= ("\t" x $depth) . "\t\t/>\r\n";
        $files .= ("\t" x $depth) . "\t</FileConfiguration>\r\n";
      }
    }
    $files .= ("\t" x $depth) . "</File>\r\n";
  }
  $files .= ("\t" x --$depth) . "</Filter>\r\n" for (@$last);
  $files .= "\t</Files>";
  return $files;
}

sub patch_file {
  my ($content, @variables) = @_;
  for my $v (@variables) {
    if ($v =~ /^([A-Z0-9_]+)\s*=.*$/si) {
      my $name = $1;
      $content =~ s/\n\Q$name\E\b.*?[^\\]\n/\n$v\n/s;
    }
    else {
      die "patch_file failed: " . substr($v, 0, 30) . "..";
    }
  }
  return $content;
}

sub make_sources_cmake {
  my ($src_ref, $hdr_ref) = @_;
  my @sources = @{ $src_ref };
  my @headers = @{ $hdr_ref };
  my $output = "# SPDX-License-Identifier: Unlicense
# Autogenerated File! Do not edit.

set(SOURCES\n";
  foreach my $sobj (sort @sources) {
    $output .= $sobj . "\n";
  }
  $output .= ")\n\nset(HEADERS\n";
  foreach my $hobj (sort @headers) {
    $output .= $hobj . "\n";
  }
  $output .= ")\n";
  return $output;
}

sub process_makefiles {
  my $write = shift;
  my $changed_count = 0;
  my @headers = bsd_glob("*.h");
  my @sources = bsd_glob("*.c");
  my @o = map { my $x = $_; $x =~ s/\.c$/.o/; $x } @sources;
  my @all = sort(@sources, @headers);

  my $var_o = prepare_variable("OBJECTS", @o);
  (my $var_obj = $var_o) =~ s/\.o\b/.obj/sg;

  # update MSVC project files
  my $msvc_files = prepare_msvc_files_xml(\@all, qr/NOT_USED_HERE/, ['Debug|Win32', 'Release|Win32', 'Debug|x64', 'Release|x64']);
  for my $m (qw/libtommath_VS2008.vcproj/) {
    my $old = read_file($m);
    my $new = $old;
    $new =~ s|<Files>.*</Files>|$msvc_files|s;
    if ($old ne $new) {
      write_file($m, $new) if $write;
      warn "changed: $m\n";
      $changed_count++;
    }
  }

  # update OBJECTS + HEADERS in makefile*
  for my $m (qw/ makefile makefile.shared makefile_include.mk makefile.msvc makefile.unix makefile.mingw sources.cmake /) {
    my $old = read_file($m);
    my $new = $m eq 'makefile.msvc' ? patch_file($old, $var_obj)
            : $m eq 'sources.cmake' ? make_sources_cmake(\@sources, \@headers)
            :                         patch_file($old, $var_o);

    if ($old ne $new) {
      write_file($m, $new) if $write;
      warn "changed: $m\n";
      $changed_count++;
    }
  }

  if ($write) {
    return 0; # no failures
  }
  else {
    warn( $changed_count > 0 ? "check-makefiles: FAIL $changed_count\n" : "check-makefiles: PASS\n" );
    return $changed_count;
  }
}

sub draw_func
{
   my ($deplist, $depmap, $out, $indent, $funcslist) = @_;
   my @funcs = split ',', $funcslist;
   # try this if you want to have a look at a minimized version of the callgraph without all the trivial functions
   #if ($deplist =~ /$funcs[0]/ || $funcs[0] =~ /BN_MP_(ADD|SUB|CLEAR|CLEAR_\S+|DIV|MUL|COPY|ZERO|GROW|CLAMP|INIT|INIT_\S+|SET|ABS|CMP|CMP_D|EXCH)_C/) {
   if ($deplist =~ /$funcs[0]/) {
      return $deplist;
   } else {
      $deplist = $deplist . $funcs[0];
   }
   if ($indent == 0) {
   } elsif ($indent >= 1) {
      print {$out} '|   ' x ($indent - 1) . '+--->';
   }
   print {$out} $funcs[0] . "\n";
   shift @funcs;
   my $olddeplist = $deplist;
   foreach my $i (@funcs) {
      $deplist = draw_func($deplist, $depmap, $out, $indent + 1, ${$depmap}{$i}) if exists ${$depmap}{$i};
   }
   return $olddeplist;
}

sub update_dep
{
    #open class file and write preamble
    open(my $class, '>', 'tommath_class.h') or die "Couldn't open tommath_class.h for writing\n";
    print {$class} << 'EOS';
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

#if !(defined(LTM1) && defined(LTM2) && defined(LTM3))
#define LTM_INSIDE
#if defined(LTM2)
#   define LTM3
#endif
#if defined(LTM1)
#   define LTM2
#endif
#define LTM1
#if defined(LTM_ALL)
EOS

    foreach my $filename (glob 'bn*.c') {
        my $define = $filename;

        print "Processing $filename\n";

        # convert filename to upper case so we can use it as a define
        $define =~ tr/[a-z]/[A-Z]/;
        $define =~ tr/\./_/;
        print {$class} "#   define $define\n";

        # now copy text and apply #ifdef as required
        my $apply = 0;
        open(my $src, '<', $filename);
        open(my $out, '>', 'tmp');

        # first line will be the #ifdef
        my $line = <$src>;
        if ($line =~ /include/) {
            print {$out} $line;
        } else {
            print {$out} << "EOS";
#include "tommath_private.h"
#ifdef $define
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */
$line
EOS
            $apply = 1;
        }
        while (<$src>) {
            if ($_ !~ /tommath\.h/) {
                print {$out} $_;
            }
        }
        if ($apply == 1) {
            print {$out} "#endif\n";
        }
        close $src;
        close $out;

        unlink $filename;
        rename 'tmp', $filename;
    }
    print {$class} "#endif\n#endif\n";

    # now do classes
    my %depmap;
    foreach my $filename (glob 'bn*.c') {
        my $content;
        if ($filename =~ "bn_deprecated.c") {
            open(my $src, '<', $filename) or die "Can't open source file!\n";
            read $src, $content, -s $src;
            close $src;
        } else {
            my $cc = $ENV{'CC'} || 'gcc';
            $content = `$cc -E -x c -DLTM_ALL $filename`;
            $content =~ s/^# 1 "$filename".*?^# 2 "$filename"//ms;
        }

        # convert filename to upper case so we can use it as a define
        $filename =~ tr/[a-z]/[A-Z]/;
        $filename =~ tr/\./_/;

        print {$class} "#if defined($filename)\n";
        my $list = $filename;

        # strip comments
        $content =~ s{/\*.*?\*/}{}gs;

        # scan for mp_* and make classes
        my @deps = ();
        foreach my $line (split /\n/, $content) {
            while ($line =~ /(fast_)?(s_)?mp\_[a-z_0-9]*((?=\;)|(?=\())|(?<=\()mp\_[a-z_0-9]*(?=\()/g) {
                my $a = $&;
                next if $a eq "mp_err";
                $a =~ tr/[a-z]/[A-Z]/;
                $a = 'BN_' . $a . '_C';
                push @deps, $a;
            }
        }
        if ($filename =~ "BN_DEPRECATED") {
            push(@deps, qw(BN_MP_GET_LL_C BN_MP_INIT_LL_C BN_MP_SET_LL_C));
            push(@deps, qw(BN_MP_GET_MAG_ULL_C BN_MP_INIT_ULL_C BN_MP_SET_ULL_C));
            push(@deps, qw(BN_MP_DIV_3_C BN_MP_EXPT_U32_C BN_MP_ROOT_U32_C BN_MP_LOG_U32_C));
        }
        @deps = sort(@deps);
        foreach my $a (@deps) {
            if ($list !~ /$a/) {
                print {$class} "#   define $a\n";
            }
            $list = $list . ',' . $a;
        }
        $depmap{$filename} = $list;

        print {$class} "#endif\n\n";
    }

    print {$class} << 'EOS';
#ifdef LTM_INSIDE
#undef LTM_INSIDE
#ifdef LTM3
#   define LTM_LAST
#endif

#include "tommath_superclass.h"
#include "tommath_class.h"
#else
#   define LTM_LAST
#endif
EOS
    close $class;

    #now let's make a cool call graph...

    open(my $out, '>', 'callgraph.txt');
    foreach (sort keys %depmap) {
        draw_func("", \%depmap, $out, 0, $depmap{$_});
        print {$out} "\n\n";
    }
    close $out;

    return 0;
}

sub generate_def {
    my @files = split /\n/, `git ls-files`;
    @files = grep(/\.c/, @files);
    @files = map { my $x = $_; $x =~ s/^bn_|\.c$//g; $x; } @files;
    @files = grep(!/mp_radix_smap/, @files);

    push(@files, qw(mp_set_int mp_set_long mp_set_long_long mp_get_int mp_get_long mp_get_long_long mp_init_set_int));
    push(@files, qw(mp_get_ll mp_get_mag_ull mp_init_ll mp_set_ll mp_init_ull mp_set_ull));
    push(@files, qw(mp_div_3 mp_expt_u32 mp_root_u32 mp_log_u32));

    my $files = join("\n    ", sort(grep(/^mp_/, @files)));
    write_file "tommath.def", "; libtommath
;
; Use this command to produce a 32-bit .lib file, for use in any MSVC version
;   lib -machine:X86 -name:libtommath.dll -def:tommath.def -out:tommath.lib
; Use this command to produce a 64-bit .lib file, for use in any MSVC version
;   lib -machine:X64 -name:libtommath.dll -def:tommath.def -out:tommath.lib
;
EXPORTS
    $files
";
    return 0;
}

sub die_usage {
  die <<"MARKER";
usage: $0 -s   OR   $0 --check-source
       $0 -o   OR   $0 --check-comments
       $0 -m   OR   $0 --check-makefiles
       $0 -a   OR   $0 --check-all
       $0 -u   OR   $0 --update-files
MARKER
}

GetOptions( "s|check-source"        => \my $check_source,
            "o|check-comments"      => \my $check_comments,
            "m|check-makefiles"     => \my $check_makefiles,
            "d|check-doc"           => \my $check_doc,
            "a|check-all"           => \my $check_all,
            "u|update-files"        => \my $update_files,
            "h|help"                => \my $help
          ) or die_usage;

my $failure;
$failure ||= check_source()       if $check_all || $check_source;
$failure ||= check_comments()     if $check_all || $check_comments;
$failure ||= check_doc()          if $check_doc; # temporarily excluded from --check-all
$failure ||= process_makefiles(0) if $check_all || $check_makefiles;
$failure ||= process_makefiles(1) if $update_files;
$failure ||= update_dep()         if $update_files;
$failure ||= generate_def()       if $update_files;

die_usage unless defined $failure;
exit $failure ? 1 : 0;
Deleted libtommath/libtommath_VS2008.sln.
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





























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

Microsoft Visual Studio Solution File, Format Version 10.00
# Visual Studio 2008
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "tommath", "libtommath_VS2008.vcproj", "{42109FEE-B0B9-4FCD-9E56-2863BF8C55D2}"
EndProject
Global
	GlobalSection(SolutionConfigurationPlatforms) = preSolution
		Debug|Win32 = Debug|Win32
		Debug|x64 = Debug|x64
		Release|Win32 = Release|Win32
		Release|x64 = Release|x64
	EndGlobalSection
	GlobalSection(ProjectConfigurationPlatforms) = postSolution
		{42109FEE-B0B9-4FCD-9E56-2863BF8C55D2}.Debug|Win32.ActiveCfg = Debug|Win32
		{42109FEE-B0B9-4FCD-9E56-2863BF8C55D2}.Debug|Win32.Build.0 = Debug|Win32
		{42109FEE-B0B9-4FCD-9E56-2863BF8C55D2}.Debug|x64.ActiveCfg = Debug|x64
		{42109FEE-B0B9-4FCD-9E56-2863BF8C55D2}.Debug|x64.Build.0 = Debug|x64
		{42109FEE-B0B9-4FCD-9E56-2863BF8C55D2}.Release|Win32.ActiveCfg = Release|Win32
		{42109FEE-B0B9-4FCD-9E56-2863BF8C55D2}.Release|Win32.Build.0 = Release|Win32
		{42109FEE-B0B9-4FCD-9E56-2863BF8C55D2}.Release|x64.ActiveCfg = Release|x64
		{42109FEE-B0B9-4FCD-9E56-2863BF8C55D2}.Release|x64.Build.0 = Release|x64
	EndGlobalSection
	GlobalSection(SolutionProperties) = preSolution
		HideSolutionNode = FALSE
	EndGlobalSection
	GlobalSection(ExtensibilityGlobals) = postSolution
		SolutionGuid = {83B84178-7B4F-4B78-9C5D-17B8201D5B61}
	EndGlobalSection
EndGlobal
Deleted libtommath/libtommath_VS2008.vcproj.
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


























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="Windows-1252"?>
<VisualStudioProject
	ProjectType="Visual C++"
	Version="9.00"
	Name="tommath"
	ProjectGUID="{42109FEE-B0B9-4FCD-9E56-2863BF8C55D2}"
	RootNamespace="tommath"
	TargetFrameworkVersion="0"
	>
	<Platforms>
		<Platform
			Name="Win32"
		/>
		<Platform
			Name="x64"
		/>
	</Platforms>
	<ToolFiles>
	</ToolFiles>
	<Configurations>
		<Configuration
			Name="Debug|Win32"
			OutputDirectory="MSVC_$(PlatformName)_$(ConfigurationName)"
			IntermediateDirectory="MSVC_$(PlatformName)_$(ConfigurationName)\Intermediate"
			ConfigurationType="4"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			CharacterSet="0"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="0"
				AdditionalIncludeDirectories="."
				PreprocessorDefinitions="WIN32;_DEBUG;_CRT_SECURE_NO_WARNINGS;_CRT_NONSTDC_NO_DEPRECATE"
				MinimalRebuild="true"
				ExceptionHandling="0"
				BasicRuntimeChecks="3"
				RuntimeLibrary="1"
				PrecompiledHeaderFile="$(IntDir)\libtomcrypt.pch"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(IntDir)\"
				WarningLevel="3"
				SuppressStartupBanner="true"
				DebugInformationFormat="4"
				CompileAs="1"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				PreprocessorDefinitions="_DEBUG"
				Culture="1033"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLibrarianTool"
				OutputFile="$(OutDir)\tommath.lib"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
				SuppressStartupBanner="true"
				OutputFile="$(OutDir)\tommath.bsc"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Debug|x64"
			OutputDirectory="MSVC_$(PlatformName)_$(ConfigurationName)"
			IntermediateDirectory="MSVC_$(PlatformName)_$(ConfigurationName)\Intermediate"
			ConfigurationType="4"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			CharacterSet="0"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="3"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="0"
				AdditionalIncludeDirectories="."
				PreprocessorDefinitions="WIN32;_DEBUG;_CRT_SECURE_NO_WARNINGS;_CRT_NONSTDC_NO_DEPRECATE"
				MinimalRebuild="true"
				ExceptionHandling="0"
				BasicRuntimeChecks="3"
				RuntimeLibrary="1"
				PrecompiledHeaderFile="$(IntDir)\libtomcrypt.pch"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(IntDir)\"
				WarningLevel="3"
				SuppressStartupBanner="true"
				DebugInformationFormat="3"
				CompileAs="1"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				PreprocessorDefinitions="_DEBUG"
				Culture="1033"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLibrarianTool"
				OutputFile="$(OutDir)\tommath.lib"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
				SuppressStartupBanner="true"
				OutputFile="$(OutDir)\tommath.bsc"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Release|Win32"
			OutputDirectory="MSVC_$(PlatformName)_$(ConfigurationName)"
			IntermediateDirectory="MSVC_$(PlatformName)_$(ConfigurationName)\Intermediate"
			ConfigurationType="4"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			CharacterSet="0"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="2"
				InlineFunctionExpansion="1"
				AdditionalIncludeDirectories="."
				PreprocessorDefinitions="WIN32;NDEBUG;_CRT_SECURE_NO_WARNINGS;_CRT_NONSTDC_NO_DEPRECATE"
				StringPooling="true"
				RuntimeLibrary="0"
				EnableFunctionLevelLinking="true"
				PrecompiledHeaderFile="$(IntDir)\libtomcrypt.pch"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(IntDir)\"
				WarningLevel="3"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				PreprocessorDefinitions="NDEBUG"
				Culture="1033"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLibrarianTool"
				OutputFile="$(OutDir)\tommath.lib"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
				SuppressStartupBanner="true"
				OutputFile="$(OutDir)\tommath.bsc"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Release|x64"
			OutputDirectory="MSVC_$(PlatformName)_$(ConfigurationName)"
			IntermediateDirectory="MSVC_$(PlatformName)_$(ConfigurationName)\Intermediate"
			ConfigurationType="4"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			CharacterSet="0"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="3"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="2"
				InlineFunctionExpansion="1"
				AdditionalIncludeDirectories="."
				PreprocessorDefinitions="WIN32;NDEBUG;_CRT_SECURE_NO_WARNINGS;_CRT_NONSTDC_NO_DEPRECATE"
				StringPooling="true"
				RuntimeLibrary="0"
				EnableFunctionLevelLinking="true"
				PrecompiledHeaderFile="$(IntDir)\libtomcrypt.pch"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(IntDir)\"
				WarningLevel="3"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				PreprocessorDefinitions="NDEBUG"
				Culture="1033"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLibrarianTool"
				OutputFile="$(OutDir)\tommath.lib"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
				SuppressStartupBanner="true"
				OutputFile="$(OutDir)\tommath.bsc"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
	</Configurations>
	<References>
	</References>
	<Files>
		<File
			RelativePath="bn_cutoffs.c"
			>
		</File>
		<File
			RelativePath="bn_deprecated.c"
			>
		</File>
		<File
			RelativePath="bn_mp_2expt.c"
			>
		</File>
		<File
			RelativePath="bn_mp_abs.c"
			>
		</File>
		<File
			RelativePath="bn_mp_add.c"
			>
		</File>
		<File
			RelativePath="bn_mp_add_d.c"
			>
		</File>
		<File
			RelativePath="bn_mp_addmod.c"
			>
		</File>
		<File
			RelativePath="bn_mp_and.c"
			>
		</File>
		<File
			RelativePath="bn_mp_clamp.c"
			>
		</File>
		<File
			RelativePath="bn_mp_clear.c"
			>
		</File>
		<File
			RelativePath="bn_mp_clear_multi.c"
			>
		</File>
		<File
			RelativePath="bn_mp_cmp.c"
			>
		</File>
		<File
			RelativePath="bn_mp_cmp_d.c"
			>
		</File>
		<File
			RelativePath="bn_mp_cmp_mag.c"
			>
		</File>
		<File
			RelativePath="bn_mp_cnt_lsb.c"
			>
		</File>
		<File
			RelativePath="bn_mp_complement.c"
			>
		</File>
		<File
			RelativePath="bn_mp_copy.c"
			>
		</File>
		<File
			RelativePath="bn_mp_count_bits.c"
			>
		</File>
		<File
			RelativePath="bn_mp_decr.c"
			>
		</File>
		<File
			RelativePath="bn_mp_div.c"
			>
		</File>
		<File
			RelativePath="bn_mp_div_2.c"
			>
		</File>
		<File
			RelativePath="bn_mp_div_2d.c"
			>
		</File>
		<File
			RelativePath="bn_mp_div_d.c"
			>
		</File>
		<File
			RelativePath="bn_mp_dr_is_modulus.c"
			>
		</File>
		<File
			RelativePath="bn_mp_dr_reduce.c"
			>
		</File>
		<File
			RelativePath="bn_mp_dr_setup.c"
			>
		</File>
		<File
			RelativePath="bn_mp_error_to_string.c"
			>
		</File>
		<File
			RelativePath="bn_mp_exch.c"
			>
		</File>
		<File
			RelativePath="bn_mp_expt_n.c"
			>
		</File>
		<File
			RelativePath="bn_mp_exptmod.c"
			>
		</File>
		<File
			RelativePath="bn_mp_exteuclid.c"
			>
		</File>
		<File
			RelativePath="bn_mp_fread.c"
			>
		</File>
		<File
			RelativePath="bn_mp_from_sbin.c"
			>
		</File>
		<File
			RelativePath="bn_mp_from_ubin.c"
			>
		</File>
		<File
			RelativePath="bn_mp_fwrite.c"
			>
		</File>
		<File
			RelativePath="bn_mp_gcd.c"
			>
		</File>
		<File
			RelativePath="bn_mp_get_double.c"
			>
		</File>
		<File
			RelativePath="bn_mp_get_i32.c"
			>
		</File>
		<File
			RelativePath="bn_mp_get_i64.c"
			>
		</File>
		<File
			RelativePath="bn_mp_get_l.c"
			>
		</File>
		<File
			RelativePath="bn_mp_get_mag_u32.c"
			>
		</File>
		<File
			RelativePath="bn_mp_get_mag_u64.c"
			>
		</File>
		<File
			RelativePath="bn_mp_get_mag_ul.c"
			>
		</File>
		<File
			RelativePath="bn_mp_grow.c"
			>
		</File>
		<File
			RelativePath="bn_mp_incr.c"
			>
		</File>
		<File
			RelativePath="bn_mp_init.c"
			>
		</File>
		<File
			RelativePath="bn_mp_init_copy.c"
			>
		</File>
		<File
			RelativePath="bn_mp_init_i32.c"
			>
		</File>
		<File
			RelativePath="bn_mp_init_i64.c"
			>
		</File>
		<File
			RelativePath="bn_mp_init_l.c"
			>
		</File>
		<File
			RelativePath="bn_mp_init_multi.c"
			>
		</File>
		<File
			RelativePath="bn_mp_init_set.c"
			>
		</File>
		<File
			RelativePath="bn_mp_init_size.c"
			>
		</File>
		<File
			RelativePath="bn_mp_init_u32.c"
			>
		</File>
		<File
			RelativePath="bn_mp_init_u64.c"
			>
		</File>
		<File
			RelativePath="bn_mp_init_ul.c"
			>
		</File>
		<File
			RelativePath="bn_mp_invmod.c"
			>
		</File>
		<File
			RelativePath="bn_mp_is_square.c"
			>
		</File>
		<File
			RelativePath="bn_mp_iseven.c"
			>
		</File>
		<File
			RelativePath="bn_mp_isodd.c"
			>
		</File>
		<File
			RelativePath="bn_mp_kronecker.c"
			>
		</File>
		<File
			RelativePath="bn_mp_lcm.c"
			>
		</File>
		<File
			RelativePath="bn_mp_log_n.c"
			>
		</File>
		<File
			RelativePath="bn_mp_lshd.c"
			>
		</File>
		<File
			RelativePath="bn_mp_mod.c"
			>
		</File>
		<File
			RelativePath="bn_mp_mod_2d.c"
			>
		</File>
		<File
			RelativePath="bn_mp_mod_d.c"
			>
		</File>
		<File
			RelativePath="bn_mp_montgomery_calc_normalization.c"
			>
		</File>
		<File
			RelativePath="bn_mp_montgomery_reduce.c"
			>
		</File>
		<File
			RelativePath="bn_mp_montgomery_setup.c"
			>
		</File>
		<File
			RelativePath="bn_mp_mul.c"
			>
		</File>
		<File
			RelativePath="bn_mp_mul_2.c"
			>
		</File>
		<File
			RelativePath="bn_mp_mul_2d.c"
			>
		</File>
		<File
			RelativePath="bn_mp_mul_d.c"
			>
		</File>
		<File
			RelativePath="bn_mp_mulmod.c"
			>
		</File>
		<File
			RelativePath="bn_mp_neg.c"
			>
		</File>
		<File
			RelativePath="bn_mp_or.c"
			>
		</File>
		<File
			RelativePath="bn_mp_pack.c"
			>
		</File>
		<File
			RelativePath="bn_mp_pack_count.c"
			>
		</File>
		<File
			RelativePath="bn_mp_prime_fermat.c"
			>
		</File>
		<File
			RelativePath="bn_mp_prime_frobenius_underwood.c"
			>
		</File>
		<File
			RelativePath="bn_mp_prime_is_prime.c"
			>
		</File>
		<File
			RelativePath="bn_mp_prime_miller_rabin.c"
			>
		</File>
		<File
			RelativePath="bn_mp_prime_next_prime.c"
			>
		</File>
		<File
			RelativePath="bn_mp_prime_rabin_miller_trials.c"
			>
		</File>
		<File
			RelativePath="bn_mp_prime_rand.c"
			>
		</File>
		<File
			RelativePath="bn_mp_prime_strong_lucas_selfridge.c"
			>
		</File>
		<File
			RelativePath="bn_mp_radix_size.c"
			>
		</File>
		<File
			RelativePath="bn_mp_radix_smap.c"
			>
		</File>
		<File
			RelativePath="bn_mp_rand.c"
			>
		</File>
		<File
			RelativePath="bn_mp_read_radix.c"
			>
		</File>
		<File
			RelativePath="bn_mp_reduce.c"
			>
		</File>
		<File
			RelativePath="bn_mp_reduce_2k.c"
			>
		</File>
		<File
			RelativePath="bn_mp_reduce_2k_l.c"
			>
		</File>
		<File
			RelativePath="bn_mp_reduce_2k_setup.c"
			>
		</File>
		<File
			RelativePath="bn_mp_reduce_2k_setup_l.c"
			>
		</File>
		<File
			RelativePath="bn_mp_reduce_is_2k.c"
			>
		</File>
		<File
			RelativePath="bn_mp_reduce_is_2k_l.c"
			>
		</File>
		<File
			RelativePath="bn_mp_reduce_setup.c"
			>
		</File>
		<File
			RelativePath="bn_mp_root_n.c"
			>
		</File>
		<File
			RelativePath="bn_mp_rshd.c"
			>
		</File>
		<File
			RelativePath="bn_mp_sbin_size.c"
			>
		</File>
		<File
			RelativePath="bn_mp_set.c"
			>
		</File>
		<File
			RelativePath="bn_mp_set_double.c"
			>
		</File>
		<File
			RelativePath="bn_mp_set_i32.c"
			>
		</File>
		<File
			RelativePath="bn_mp_set_i64.c"
			>
		</File>
		<File
			RelativePath="bn_mp_set_l.c"
			>
		</File>
		<File
			RelativePath="bn_mp_set_u32.c"
			>
		</File>
		<File
			RelativePath="bn_mp_set_u64.c"
			>
		</File>
		<File
			RelativePath="bn_mp_set_ul.c"
			>
		</File>
		<File
			RelativePath="bn_mp_shrink.c"
			>
		</File>
		<File
			RelativePath="bn_mp_signed_rsh.c"
			>
		</File>
		<File
			RelativePath="bn_mp_sqr.c"
			>
		</File>
		<File
			RelativePath="bn_mp_sqrmod.c"
			>
		</File>
		<File
			RelativePath="bn_mp_sqrt.c"
			>
		</File>
		<File
			RelativePath="bn_mp_sqrtmod_prime.c"
			>
		</File>
		<File
			RelativePath="bn_mp_sub.c"
			>
		</File>
		<File
			RelativePath="bn_mp_sub_d.c"
			>
		</File>
		<File
			RelativePath="bn_mp_submod.c"
			>
		</File>
		<File
			RelativePath="bn_mp_to_radix.c"
			>
		</File>
		<File
			RelativePath="bn_mp_to_sbin.c"
			>
		</File>
		<File
			RelativePath="bn_mp_to_ubin.c"
			>
		</File>
		<File
			RelativePath="bn_mp_ubin_size.c"
			>
		</File>
		<File
			RelativePath="bn_mp_unpack.c"
			>
		</File>
		<File
			RelativePath="bn_mp_xor.c"
			>
		</File>
		<File
			RelativePath="bn_mp_zero.c"
			>
		</File>
		<File
			RelativePath="bn_prime_tab.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_add.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_balance_mul.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_div_3.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_exptmod.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_exptmod_fast.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_get_bit.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_invmod_fast.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_invmod_slow.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_karatsuba_mul.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_karatsuba_sqr.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_log.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_log_2expt.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_log_d.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_montgomery_reduce_fast.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_mul_digs.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_mul_digs_fast.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_mul_high_digs.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_mul_high_digs_fast.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_prime_is_divisible.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_rand_jenkins.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_rand_platform.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_reverse.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_sqr.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_sqr_fast.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_sub.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_toom_mul.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_toom_sqr.c"
			>
		</File>
		<File
			RelativePath="tommath.h"
			>
		</File>
		<File
			RelativePath="tommath_class.h"
			>
		</File>
		<File
			RelativePath="tommath_cutoffs.h"
			>
		</File>
		<File
			RelativePath="tommath_private.h"
			>
		</File>
		<File
			RelativePath="tommath_superclass.h"
			>
		</File>
	</Files>
	<Globals>
	</Globals>
</VisualStudioProject>
Deleted libtommath/makefile.
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









































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#Makefile for GCC
#
#Tom St Denis

ifeq ($V,1)
silent=
else
silent=@
endif

#default files to install
ifndef LIBNAME
   LIBNAME=libtommath.a
endif

coverage: LIBNAME:=-Wl,--whole-archive $(LIBNAME)  -Wl,--no-whole-archive

include makefile_include.mk

%.o: %.c $(HEADERS)
ifneq ($V,1)
	@echo "   * ${CC} $@"
endif
	${silent} ${CC} -c ${LTM_CFLAGS} $< -o $@

LCOV_ARGS=--directory .

#START_INS
OBJECTS=bn_cutoffs.o bn_deprecated.o bn_mp_2expt.o bn_mp_abs.o bn_mp_add.o bn_mp_add_d.o bn_mp_addmod.o \
bn_mp_and.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \
bn_mp_cnt_lsb.o bn_mp_complement.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_decr.o bn_mp_div.o bn_mp_div_2.o \
bn_mp_div_2d.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o bn_mp_dr_setup.o \
bn_mp_error_to_string.o bn_mp_exch.o bn_mp_expt_n.o bn_mp_exptmod.o bn_mp_exteuclid.o bn_mp_fread.o \
bn_mp_from_sbin.o bn_mp_from_ubin.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_double.o bn_mp_get_i32.o \
bn_mp_get_i64.o bn_mp_get_l.o bn_mp_get_mag_u32.o bn_mp_get_mag_u64.o bn_mp_get_mag_ul.o bn_mp_grow.o \
bn_mp_incr.o bn_mp_init.o bn_mp_init_copy.o bn_mp_init_i32.o bn_mp_init_i64.o bn_mp_init_l.o \
bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_size.o bn_mp_init_u32.o bn_mp_init_u64.o bn_mp_init_ul.o \
bn_mp_invmod.o bn_mp_is_square.o bn_mp_iseven.o bn_mp_isodd.o bn_mp_kronecker.o bn_mp_lcm.o bn_mp_log_n.o \
bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o \
bn_mp_montgomery_reduce.o bn_mp_montgomery_setup.o bn_mp_mul.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul_d.o \
bn_mp_mulmod.o bn_mp_neg.o bn_mp_or.o bn_mp_pack.o bn_mp_pack_count.o bn_mp_prime_fermat.o \
bn_mp_prime_frobenius_underwood.o bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o \
bn_mp_prime_next_prime.o bn_mp_prime_rabin_miller_trials.o bn_mp_prime_rand.o \
bn_mp_prime_strong_lucas_selfridge.o bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_rand.o \
bn_mp_read_radix.o bn_mp_reduce.o bn_mp_reduce_2k.o bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o \
bn_mp_reduce_2k_setup_l.o bn_mp_reduce_is_2k.o bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o \
bn_mp_root_n.o bn_mp_rshd.o bn_mp_sbin_size.o bn_mp_set.o bn_mp_set_double.o bn_mp_set_i32.o \
bn_mp_set_i64.o bn_mp_set_l.o bn_mp_set_u32.o bn_mp_set_u64.o bn_mp_set_ul.o bn_mp_shrink.o \
bn_mp_signed_rsh.o bn_mp_sqr.o bn_mp_sqrmod.o bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o \
bn_mp_submod.o bn_mp_to_radix.o bn_mp_to_sbin.o bn_mp_to_ubin.o bn_mp_ubin_size.o bn_mp_unpack.o \
bn_mp_xor.o bn_mp_zero.o bn_prime_tab.o bn_s_mp_add.o bn_s_mp_balance_mul.o bn_s_mp_div_3.o \
bn_s_mp_exptmod.o bn_s_mp_exptmod_fast.o bn_s_mp_get_bit.o bn_s_mp_invmod_fast.o bn_s_mp_invmod_slow.o \
bn_s_mp_karatsuba_mul.o bn_s_mp_karatsuba_sqr.o bn_s_mp_log.o bn_s_mp_log_2expt.o bn_s_mp_log_d.o \
bn_s_mp_montgomery_reduce_fast.o bn_s_mp_mul_digs.o bn_s_mp_mul_digs_fast.o bn_s_mp_mul_high_digs.o \
bn_s_mp_mul_high_digs_fast.o bn_s_mp_prime_is_divisible.o bn_s_mp_rand_jenkins.o \
bn_s_mp_rand_platform.o bn_s_mp_reverse.o bn_s_mp_sqr.o bn_s_mp_sqr_fast.o bn_s_mp_sub.o \
bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o

#END_INS

$(LIBNAME):  $(OBJECTS)
	$(AR) $(ARFLAGS) $@ $(OBJECTS)
	$(RANLIB) $@

#make a profiled library (takes a while!!!)
#
# This will build the library with profile generation
# then run the test demo and rebuild the library.
#
# So far I've seen improvements in the MP math
profiled:
	make CFLAGS="$(CFLAGS) -fprofile-arcs -DTESTING" timing
	./timing
	rm -f *.a *.o timing
	make CFLAGS="$(CFLAGS) -fbranch-probabilities"

#make a single object profiled library
profiled_single:
	perl gen.pl
	$(CC) $(LTM_CFLAGS) -fprofile-arcs -DTESTING -c mpi.c -o mpi.o
	$(CC) $(LTM_CFLAGS) -DTESTING -DTIMER demo/timing.c mpi.o -lgcov -o timing
	./timing
	rm -f *.o timing
	$(CC) $(LTM_CFLAGS) -fbranch-probabilities -DTESTING -c mpi.c -o mpi.o
	$(AR) $(ARFLAGS) $(LIBNAME) mpi.o
	ranlib $(LIBNAME)

install: $(LIBNAME)
	install -d $(DESTDIR)$(LIBPATH)
	install -d $(DESTDIR)$(INCPATH)
	install -m 644 $(LIBNAME) $(DESTDIR)$(LIBPATH)
	install -m 644 $(HEADERS_PUB) $(DESTDIR)$(INCPATH)

uninstall:
	rm $(DESTDIR)$(LIBPATH)/$(LIBNAME)
	rm $(HEADERS_PUB:%=$(DESTDIR)$(INCPATH)/%)

test_standalone: test
	@echo "test_standalone is deprecated, please use make-target 'test'"

DEMOS=test mtest_opponent

define DEMO_template
$(1): demo/$(1).o demo/shared.o $$(LIBNAME)
	$$(CC) $$(LTM_CFLAGS) $$(LTM_LFLAGS) $$^ -o $$@
endef

$(foreach demo, $(strip $(DEMOS)), $(eval $(call DEMO_template,$(demo))))

.PHONY: mtest
mtest:
	cd mtest ; $(CC) $(LTM_CFLAGS) -O0 mtest.c $(LTM_LFLAGS) -o mtest

timing: $(LIBNAME) demo/timing.c
	$(CC) $(LTM_CFLAGS) -DTIMER demo/timing.c $(LIBNAME) $(LTM_LFLAGS) -o timing

tune: $(LIBNAME)
	$(MAKE) -C etc tune CFLAGS="$(LTM_CFLAGS)"
	$(MAKE)

# You have to create a file .coveralls.yml with the content "repo_token: <the token>"
# in the base folder to be able to submit to coveralls
coveralls: lcov
	coveralls-lcov

docs manual:
	$(MAKE) -C doc/ $@ V=$(V)

.PHONY: pre_gen
pre_gen:
	mkdir -p pre_gen
	perl gen.pl
	sed -e 's/[[:blank:]]*$$//' mpi.c > pre_gen/mpi.c
	rm mpi.c

zipup:
	$(MAKE) clean
	$(MAKE) .zipup

.zipup: astyle new_file docs
	@# Update the index, so diff-index won't fail in case the pdf has been created.
	@#   As the pdf creation modifies the tex files, git sometimes detects the
	@#   modified files, but misses that it's put back to its original version.
	@git update-index --refresh
	@git diff-index --quiet HEAD -- || ( echo "FAILURE: uncommited changes or not a git" && exit 1 )
	rm -rf libtommath-$(VERSION) ltm-$(VERSION).*
	@# files/dirs excluded from "git archive" are defined in .gitattributes
	git archive --format=tar --prefix=libtommath-$(VERSION)/ HEAD | tar x
	@echo 'fixme check'
	-@(find libtommath-$(VERSION)/ -type f | xargs grep 'FIXM[E]') && echo '############## BEWARE: the "fixme" marker was found !!! ##############' || true
	mkdir -p libtommath-$(VERSION)/doc
	cp doc/bn.pdf libtommath-$(VERSION)/doc/
	$(MAKE) -C libtommath-$(VERSION)/ pre_gen
	tar -c libtommath-$(VERSION)/ | xz -6e -c - > ltm-$(VERSION).tar.xz
	zip -9rq ltm-$(VERSION).zip libtommath-$(VERSION)
	cp doc/bn.pdf bn-$(VERSION).pdf
	rm -rf libtommath-$(VERSION)
	gpg -b -a ltm-$(VERSION).tar.xz
	gpg -b -a ltm-$(VERSION).zip

new_file:
	perl helper.pl --update-files

perlcritic:
	perlcritic *.pl doc/*.pl

astyle:
	@echo "   * run astyle on all sources"
	@astyle --options=astylerc --formatted $(OBJECTS:.o=.c) tommath*.h demo/*.c etc/*.c mtest/mtest.c
Deleted libtommath/makefile.mingw.
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

















































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# MAKEFILE for MS Windows (mingw + gcc + gmake)
#
# BEWARE: variable OBJECTS is updated via helper.pl

### USAGE:
# Open a command prompt with gcc + gmake in PATH and start:
#
# gmake -f makefile.mingw all
# test.exe
# gmake -f makefile.mingw PREFIX=c:\devel\libtom install

#The following can be overridden from command line e.g. make -f makefile.mingw CC=gcc ARFLAGS=rcs
PREFIX    = c:\mingw
CC        = i686-w64-mingw32-gcc
#CC        = x86_64-w64-mingw32-clang
#CC        = aarch64-w64-mingw32-clang
AR        = ar
ARFLAGS   = r
RANLIB    = ranlib
STRIP     = i686-w64-mingw32-gcc-strip
#STRIP     = x86_64-w64-mingw32-strip
#STRIP     = aarch64-w64-mingw32-strip
CFLAGS    = -O2
LDFLAGS   =

#Compilation flags
LTM_CFLAGS  = -I. $(CFLAGS) -DTCL_WITH_EXTERNAL_TOMMATH
LTM_LDFLAGS = $(LDFLAGS) -static-libgcc

#Libraries to be created
LIBMAIN_S =libtommath.a
LIBMAIN_I =libtommath.dll.a
LIBMAIN_D =libtommath.dll

#List of objects to compile (all goes to libtommath.a)
OBJECTS=bn_cutoffs.o bn_deprecated.o bn_mp_2expt.o bn_mp_abs.o bn_mp_add.o bn_mp_add_d.o bn_mp_addmod.o \
bn_mp_and.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \
bn_mp_cnt_lsb.o bn_mp_complement.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_decr.o bn_mp_div.o bn_mp_div_2.o \
bn_mp_div_2d.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o bn_mp_dr_setup.o \
bn_mp_error_to_string.o bn_mp_exch.o bn_mp_expt_n.o bn_mp_exptmod.o bn_mp_exteuclid.o bn_mp_fread.o \
bn_mp_from_sbin.o bn_mp_from_ubin.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_double.o bn_mp_get_i32.o \
bn_mp_get_i64.o bn_mp_get_l.o bn_mp_get_mag_u32.o bn_mp_get_mag_u64.o bn_mp_get_mag_ul.o bn_mp_grow.o \
bn_mp_incr.o bn_mp_init.o bn_mp_init_copy.o bn_mp_init_i32.o bn_mp_init_i64.o bn_mp_init_l.o \
bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_size.o bn_mp_init_u32.o bn_mp_init_u64.o bn_mp_init_ul.o \
bn_mp_invmod.o bn_mp_is_square.o bn_mp_iseven.o bn_mp_isodd.o bn_mp_kronecker.o bn_mp_lcm.o bn_mp_log_n.o \
bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o \
bn_mp_montgomery_reduce.o bn_mp_montgomery_setup.o bn_mp_mul.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul_d.o \
bn_mp_mulmod.o bn_mp_neg.o bn_mp_or.o bn_mp_pack.o bn_mp_pack_count.o bn_mp_prime_fermat.o \
bn_mp_prime_frobenius_underwood.o bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o \
bn_mp_prime_next_prime.o bn_mp_prime_rabin_miller_trials.o bn_mp_prime_rand.o \
bn_mp_prime_strong_lucas_selfridge.o bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_rand.o \
bn_mp_read_radix.o bn_mp_reduce.o bn_mp_reduce_2k.o bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o \
bn_mp_reduce_2k_setup_l.o bn_mp_reduce_is_2k.o bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o \
bn_mp_root_n.o bn_mp_rshd.o bn_mp_sbin_size.o bn_mp_set.o bn_mp_set_double.o bn_mp_set_i32.o \
bn_mp_set_i64.o bn_mp_set_l.o bn_mp_set_u32.o bn_mp_set_u64.o bn_mp_set_ul.o bn_mp_shrink.o \
bn_mp_signed_rsh.o bn_mp_sqr.o bn_mp_sqrmod.o bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o \
bn_mp_submod.o bn_mp_to_radix.o bn_mp_to_sbin.o bn_mp_to_ubin.o bn_mp_ubin_size.o bn_mp_unpack.o \
bn_mp_xor.o bn_mp_zero.o bn_prime_tab.o bn_s_mp_add.o bn_s_mp_balance_mul.o bn_s_mp_div_3.o \
bn_s_mp_exptmod.o bn_s_mp_exptmod_fast.o bn_s_mp_get_bit.o bn_s_mp_invmod_fast.o bn_s_mp_invmod_slow.o \
bn_s_mp_karatsuba_mul.o bn_s_mp_karatsuba_sqr.o bn_s_mp_log.o bn_s_mp_log_2expt.o bn_s_mp_log_d.o \
bn_s_mp_montgomery_reduce_fast.o bn_s_mp_mul_digs.o bn_s_mp_mul_digs_fast.o bn_s_mp_mul_high_digs.o \
bn_s_mp_mul_high_digs_fast.o bn_s_mp_prime_is_divisible.o bn_s_mp_rand_jenkins.o \
bn_s_mp_rand_platform.o bn_s_mp_reverse.o bn_s_mp_sqr.o bn_s_mp_sqr_fast.o bn_s_mp_sub.o \
bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o

HEADERS_PUB=tommath.h
HEADERS=tommath_private.h tommath_class.h tommath_superclass.h tommath_cutoffs.h $(HEADERS_PUB)

#The default rule for make builds the libtommath.a library (static)
default: $(LIBMAIN_S)

#Dependencies on *.h
$(OBJECTS): $(HEADERS)

.c.o:
	$(CC) $(LTM_CFLAGS) -c $< -o $@

#Create libtommath.a
$(LIBMAIN_S): $(OBJECTS)
	$(AR) $(ARFLAGS) $@ $(OBJECTS)
	$(RANLIB) $@

#Create DLL + import library libtommath.dll.a
$(LIBMAIN_D) $(LIBMAIN_I): $(OBJECTS)
	$(CC) -s -shared -o $(LIBMAIN_D) $^ -Wl,--enable-auto-import tommath.def -Wl,--out-implib=$(LIBMAIN_I) $(LTM_LDFLAGS)
	$(STRIP) -S $(LIBMAIN_D)

#Build test suite
test.exe: demo/shared.o demo/test.o $(LIBMAIN_S)
	$(CC) $(LTM_CFLAGS) $(LTM_LDFLAGS) $^ -o $@
	@echo NOTICE: start the tests by launching test.exe

test_standalone: test.exe
	@echo test_standalone is deprecated, please use make-target 'test.exe'

all: $(LIBMAIN_S) test.exe

tune: $(LIBNAME_S)
	$(MAKE) -C etc tune
	$(MAKE)

clean:
	@-cmd /c del /Q /S *.o *.a *.exe *.dll 2>nul

#Install the library + headers
install: $(LIBMAIN_S) $(LIBMAIN_I) $(LIBMAIN_D)
	cmd /c if not exist "$(PREFIX)\bin" mkdir "$(PREFIX)\bin"
	cmd /c if not exist "$(PREFIX)\lib" mkdir "$(PREFIX)\lib"
	cmd /c if not exist "$(PREFIX)\include" mkdir "$(PREFIX)\include"
	copy /Y $(LIBMAIN_S) "$(PREFIX)\lib"
	copy /Y $(LIBMAIN_I) "$(PREFIX)\lib"
	copy /Y $(LIBMAIN_D) "$(PREFIX)\bin"
	copy /Y tommath*.h "$(PREFIX)\include"
Deleted libtommath/makefile.msvc.
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





























































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# MAKEFILE for MS Windows (nmake + Windows SDK)
#
# BEWARE: variable OBJECTS is updated via helper.pl

### USAGE:
# Open a command prompt with WinSDK variables set and start:
#
# nmake -f makefile.msvc all
# test.exe
# nmake -f makefile.msvc PREFIX=c:\devel\libtom install

#The following can be overridden from command line e.g. make -f makefile.msvc CC=gcc ARFLAGS=rcs
PREFIX    = c:\devel
CFLAGS    = /Ox

#Compilation flags
LTM_CFLAGS  = /nologo /I./ /D_CRT_SECURE_NO_WARNINGS /D_CRT_NONSTDC_NO_DEPRECATE /D__STDC_WANT_SECURE_LIB__=1 /D_CRT_HAS_CXX17=0 /Wall /wd4146 /wd4127 /wd4668 /wd4710 /wd4711 /wd4820 /wd5045 /WX $(CFLAGS)
LTM_LDFLAGS = advapi32.lib

#Libraries to be created (this makefile builds only static libraries)
LIBMAIN_S =tommath.lib

#List of objects to compile (all goes to tommath.lib)
OBJECTS=bn_cutoffs.obj bn_deprecated.obj bn_mp_2expt.obj bn_mp_abs.obj bn_mp_add.obj bn_mp_add_d.obj bn_mp_addmod.obj \
bn_mp_and.obj bn_mp_clamp.obj bn_mp_clear.obj bn_mp_clear_multi.obj bn_mp_cmp.obj bn_mp_cmp_d.obj bn_mp_cmp_mag.obj \
bn_mp_cnt_lsb.obj bn_mp_complement.obj bn_mp_copy.obj bn_mp_count_bits.obj bn_mp_decr.obj bn_mp_div.obj bn_mp_div_2.obj \
bn_mp_div_2d.obj bn_mp_div_d.obj bn_mp_dr_is_modulus.obj bn_mp_dr_reduce.obj bn_mp_dr_setup.obj \
bn_mp_error_to_string.obj bn_mp_exch.obj bn_mp_expt_n.obj bn_mp_exptmod.obj bn_mp_exteuclid.obj bn_mp_fread.obj \
bn_mp_from_sbin.obj bn_mp_from_ubin.obj bn_mp_fwrite.obj bn_mp_gcd.obj bn_mp_get_double.obj bn_mp_get_i32.obj \
bn_mp_get_i64.obj bn_mp_get_l.obj bn_mp_get_mag_u32.obj bn_mp_get_mag_u64.obj bn_mp_get_mag_ul.obj bn_mp_grow.obj \
bn_mp_incr.obj bn_mp_init.obj bn_mp_init_copy.obj bn_mp_init_i32.obj bn_mp_init_i64.obj bn_mp_init_l.obj \
bn_mp_init_multi.obj bn_mp_init_set.obj bn_mp_init_size.obj bn_mp_init_u32.obj bn_mp_init_u64.obj bn_mp_init_ul.obj \
bn_mp_invmod.obj bn_mp_is_square.obj bn_mp_iseven.obj bn_mp_isodd.obj bn_mp_kronecker.obj bn_mp_lcm.obj bn_mp_log_n.obj \
bn_mp_lshd.obj bn_mp_mod.obj bn_mp_mod_2d.obj bn_mp_mod_d.obj bn_mp_montgomery_calc_normalization.obj \
bn_mp_montgomery_reduce.obj bn_mp_montgomery_setup.obj bn_mp_mul.obj bn_mp_mul_2.obj bn_mp_mul_2d.obj bn_mp_mul_d.obj \
bn_mp_mulmod.obj bn_mp_neg.obj bn_mp_or.obj bn_mp_pack.obj bn_mp_pack_count.obj bn_mp_prime_fermat.obj \
bn_mp_prime_frobenius_underwood.obj bn_mp_prime_is_prime.obj bn_mp_prime_miller_rabin.obj \
bn_mp_prime_next_prime.obj bn_mp_prime_rabin_miller_trials.obj bn_mp_prime_rand.obj \
bn_mp_prime_strong_lucas_selfridge.obj bn_mp_radix_size.obj bn_mp_radix_smap.obj bn_mp_rand.obj \
bn_mp_read_radix.obj bn_mp_reduce.obj bn_mp_reduce_2k.obj bn_mp_reduce_2k_l.obj bn_mp_reduce_2k_setup.obj \
bn_mp_reduce_2k_setup_l.obj bn_mp_reduce_is_2k.obj bn_mp_reduce_is_2k_l.obj bn_mp_reduce_setup.obj \
bn_mp_root_n.obj bn_mp_rshd.obj bn_mp_sbin_size.obj bn_mp_set.obj bn_mp_set_double.obj bn_mp_set_i32.obj \
bn_mp_set_i64.obj bn_mp_set_l.obj bn_mp_set_u32.obj bn_mp_set_u64.obj bn_mp_set_ul.obj bn_mp_shrink.obj \
bn_mp_signed_rsh.obj bn_mp_sqr.obj bn_mp_sqrmod.obj bn_mp_sqrt.obj bn_mp_sqrtmod_prime.obj bn_mp_sub.obj bn_mp_sub_d.obj \
bn_mp_submod.obj bn_mp_to_radix.obj bn_mp_to_sbin.obj bn_mp_to_ubin.obj bn_mp_ubin_size.obj bn_mp_unpack.obj \
bn_mp_xor.obj bn_mp_zero.obj bn_prime_tab.obj bn_s_mp_add.obj bn_s_mp_balance_mul.obj bn_s_mp_div_3.obj \
bn_s_mp_exptmod.obj bn_s_mp_exptmod_fast.obj bn_s_mp_get_bit.obj bn_s_mp_invmod_fast.obj bn_s_mp_invmod_slow.obj \
bn_s_mp_karatsuba_mul.obj bn_s_mp_karatsuba_sqr.obj bn_s_mp_log.obj bn_s_mp_log_2expt.obj bn_s_mp_log_d.obj \
bn_s_mp_montgomery_reduce_fast.obj bn_s_mp_mul_digs.obj bn_s_mp_mul_digs_fast.obj bn_s_mp_mul_high_digs.obj \
bn_s_mp_mul_high_digs_fast.obj bn_s_mp_prime_is_divisible.obj bn_s_mp_rand_jenkins.obj \
bn_s_mp_rand_platform.obj bn_s_mp_reverse.obj bn_s_mp_sqr.obj bn_s_mp_sqr_fast.obj bn_s_mp_sub.obj \
bn_s_mp_toom_mul.obj bn_s_mp_toom_sqr.obj

HEADERS_PUB=tommath.h
HEADERS=tommath_private.h tommath_class.h tommath_superclass.h tommath_cutoffs.h $(HEADERS_PUB)

#The default rule for make builds the tommath.lib library (static)
default: $(LIBMAIN_S)

#Dependencies on *.h
$(OBJECTS): $(HEADERS)

.c.obj:
	$(CC) $(LTM_CFLAGS) /c $< /Fo$@

#Create tommath.lib
$(LIBMAIN_S): $(OBJECTS)
	lib /out:$(LIBMAIN_S) $(OBJECTS)

#Build test suite
test.exe: $(LIBMAIN_S) demo/shared.obj demo/test.obj
	cl $(LTM_CFLAGS) $(TOBJECTS) $(LIBMAIN_S) $(LTM_LDFLAGS) demo/shared.c demo/test.c /Fe$@
	@echo NOTICE: start the tests by launching test.exe

test_standalone: test.exe
	@echo test_standalone is deprecated, please use make-target 'test.exe'

all: $(LIBMAIN_S) test.exe

tune: $(LIBMAIN_S)
	$(MAKE) -C etc tune
	$(MAKE)

clean:
	@-cmd /c del /Q /S *.OBJ *.LIB *.EXE *.DLL 2>nul

#Install the library + headers
install: $(LIBMAIN_S)
	cmd /c if not exist "$(PREFIX)\bin" mkdir "$(PREFIX)\bin"
	cmd /c if not exist "$(PREFIX)\lib" mkdir "$(PREFIX)\lib"
	cmd /c if not exist "$(PREFIX)\include" mkdir "$(PREFIX)\include"
	copy /Y $(LIBMAIN_S) "$(PREFIX)\lib"
	copy /Y tommath*.h "$(PREFIX)\include"
Deleted libtommath/makefile.shared.
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




































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#Makefile for GCC
#
#Tom St Denis

#default files to install
ifndef LIBNAME
   LIBNAME=libtommath.la
endif

include makefile_include.mk


ifndef LIBTOOL
  ifeq ($(PLATFORM), Darwin)
    LIBTOOL:=glibtool
  else
    LIBTOOL:=libtool
  endif
endif
LTCOMPILE = $(LIBTOOL) --mode=compile --tag=CC $(CC)
LTLINK = $(LIBTOOL) --mode=link --tag=CC $(CC)

LCOV_ARGS=--directory .libs --directory .

#START_INS
OBJECTS=bn_cutoffs.o bn_deprecated.o bn_mp_2expt.o bn_mp_abs.o bn_mp_add.o bn_mp_add_d.o bn_mp_addmod.o \
bn_mp_and.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \
bn_mp_cnt_lsb.o bn_mp_complement.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_decr.o bn_mp_div.o bn_mp_div_2.o \
bn_mp_div_2d.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o bn_mp_dr_setup.o \
bn_mp_error_to_string.o bn_mp_exch.o bn_mp_expt_n.o bn_mp_exptmod.o bn_mp_exteuclid.o bn_mp_fread.o \
bn_mp_from_sbin.o bn_mp_from_ubin.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_double.o bn_mp_get_i32.o \
bn_mp_get_i64.o bn_mp_get_l.o bn_mp_get_mag_u32.o bn_mp_get_mag_u64.o bn_mp_get_mag_ul.o bn_mp_grow.o \
bn_mp_incr.o bn_mp_init.o bn_mp_init_copy.o bn_mp_init_i32.o bn_mp_init_i64.o bn_mp_init_l.o \
bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_size.o bn_mp_init_u32.o bn_mp_init_u64.o bn_mp_init_ul.o \
bn_mp_invmod.o bn_mp_is_square.o bn_mp_iseven.o bn_mp_isodd.o bn_mp_kronecker.o bn_mp_lcm.o bn_mp_log_n.o \
bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o \
bn_mp_montgomery_reduce.o bn_mp_montgomery_setup.o bn_mp_mul.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul_d.o \
bn_mp_mulmod.o bn_mp_neg.o bn_mp_or.o bn_mp_pack.o bn_mp_pack_count.o bn_mp_prime_fermat.o \
bn_mp_prime_frobenius_underwood.o bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o \
bn_mp_prime_next_prime.o bn_mp_prime_rabin_miller_trials.o bn_mp_prime_rand.o \
bn_mp_prime_strong_lucas_selfridge.o bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_rand.o \
bn_mp_read_radix.o bn_mp_reduce.o bn_mp_reduce_2k.o bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o \
bn_mp_reduce_2k_setup_l.o bn_mp_reduce_is_2k.o bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o \
bn_mp_root_n.o bn_mp_rshd.o bn_mp_sbin_size.o bn_mp_set.o bn_mp_set_double.o bn_mp_set_i32.o \
bn_mp_set_i64.o bn_mp_set_l.o bn_mp_set_u32.o bn_mp_set_u64.o bn_mp_set_ul.o bn_mp_shrink.o \
bn_mp_signed_rsh.o bn_mp_sqr.o bn_mp_sqrmod.o bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o \
bn_mp_submod.o bn_mp_to_radix.o bn_mp_to_sbin.o bn_mp_to_ubin.o bn_mp_ubin_size.o bn_mp_unpack.o \
bn_mp_xor.o bn_mp_zero.o bn_prime_tab.o bn_s_mp_add.o bn_s_mp_balance_mul.o bn_s_mp_div_3.o \
bn_s_mp_exptmod.o bn_s_mp_exptmod_fast.o bn_s_mp_get_bit.o bn_s_mp_invmod_fast.o bn_s_mp_invmod_slow.o \
bn_s_mp_karatsuba_mul.o bn_s_mp_karatsuba_sqr.o bn_s_mp_log.o bn_s_mp_log_2expt.o bn_s_mp_log_d.o \
bn_s_mp_montgomery_reduce_fast.o bn_s_mp_mul_digs.o bn_s_mp_mul_digs_fast.o bn_s_mp_mul_high_digs.o \
bn_s_mp_mul_high_digs_fast.o bn_s_mp_prime_is_divisible.o bn_s_mp_rand_jenkins.o \
bn_s_mp_rand_platform.o bn_s_mp_reverse.o bn_s_mp_sqr.o bn_s_mp_sqr_fast.o bn_s_mp_sub.o \
bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o

#END_INS

objs: $(OBJECTS)

.c.o: $(HEADERS)
	$(LTCOMPILE) $(LTM_CFLAGS) $(LTM_LDFLAGS) -o $@ -c $<

LOBJECTS = $(OBJECTS:.o=.lo)

$(LIBNAME):  $(OBJECTS)
	$(LTLINK) $(LTM_LDFLAGS) $(LOBJECTS) -o $(LIBNAME) -rpath $(LIBPATH) -version-info $(VERSION_SO) $(LTM_LIBTOOLFLAGS)

install: $(LIBNAME)
	install -d $(DESTDIR)$(LIBPATH)
	install -d $(DESTDIR)$(INCPATH)
	$(LIBTOOL) --mode=install install -m 644 $(LIBNAME) $(DESTDIR)$(LIBPATH)/$(LIBNAME)
	install -m 644 $(HEADERS_PUB) $(DESTDIR)$(INCPATH)
	sed -e 's,^prefix=.*,prefix=$(PREFIX),' -e 's,^Version:.*,Version: $(VERSION_PC),' -e 's,@CMAKE_INSTALL_LIBDIR@,lib,' \
		-e 's,@CMAKE_INSTALL_INCLUDEDIR@,include,' libtommath.pc.in > libtommath.pc
	install -d $(DESTDIR)$(LIBPATH)/pkgconfig
	install -m 644 libtommath.pc $(DESTDIR)$(LIBPATH)/pkgconfig/

uninstall:
	$(LIBTOOL) --mode=uninstall rm $(DESTDIR)$(LIBPATH)/$(LIBNAME)
	rm $(HEADERS_PUB:%=$(DESTDIR)$(INCPATH)/%)
	rm $(DESTDIR)$(LIBPATH)/pkgconfig/libtommath.pc

test_standalone: test
	@echo "test_standalone is deprecated, please use make-target 'test'"

test mtest_opponent: demo/shared.o $(LIBNAME) | demo/test.o demo/mtest_opponent.o
	$(LTLINK) $(LTM_LDFLAGS) demo/$@.o $^ -o $@

.PHONY: mtest
mtest:
	cd mtest ; $(CC) $(LTM_CFLAGS) -O0 mtest.c $(LTM_LDFLAGS) -o mtest

timing: $(LIBNAME) demo/timing.c
	$(LTLINK) $(LTM_CFLAGS) $(LTM_LDFLAGS) -DTIMER demo/timing.c $(LIBNAME) -o timing

tune: $(LIBNAME)
	$(LTCOMPILE) $(LTM_CFLAGS) -c etc/tune.c -o etc/tune.o
	$(LTLINK) $(LTM_LDFLAGS) -o etc/tune etc/tune.o $(LIBNAME)
	cd etc/; /bin/sh tune_it.sh; cd ..
	$(MAKE) -f makefile.shared
Deleted libtommath/makefile.unix.
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










































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# MAKEFILE that is intended to be compatible with any kind of make (GNU make, BSD make, ...)
# works on: Linux, *BSD, Cygwin, AIX, HP-UX and hopefully other UNIX systems
#
# Please do not use here neither any special make syntax nor any unusual tools/utilities!

# using ICC compiler:
# make -f makefile.unix CC=icc CFLAGS="-O3 -xP -ip"

# using Borland C++Builder:
# make -f makefile.unix CC=bcc32

#The following can be overridden from command line e.g. "make -f makefile.unix CC=gcc ARFLAGS=rcs"
DESTDIR   =
PREFIX    = /usr/local
LIBPATH   = $(PREFIX)/lib
INCPATH   = $(PREFIX)/include
CC        = cc
AR        = ar
ARFLAGS   = r
RANLIB    = ranlib
CFLAGS    = -O2
LDFLAGS   =

VERSION   = 1.3.0

#Compilation flags
LTM_CFLAGS  = -I. $(CFLAGS)
LTM_LDFLAGS = $(LDFLAGS)

#Library to be created (this makefile builds only static library)
LIBMAIN_S = libtommath.a

OBJECTS=bn_cutoffs.o bn_deprecated.o bn_mp_2expt.o bn_mp_abs.o bn_mp_add.o bn_mp_add_d.o bn_mp_addmod.o \
bn_mp_and.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \
bn_mp_cnt_lsb.o bn_mp_complement.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_decr.o bn_mp_div.o bn_mp_div_2.o \
bn_mp_div_2d.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o bn_mp_dr_setup.o \
bn_mp_error_to_string.o bn_mp_exch.o bn_mp_expt_n.o bn_mp_exptmod.o bn_mp_exteuclid.o bn_mp_fread.o \
bn_mp_from_sbin.o bn_mp_from_ubin.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_double.o bn_mp_get_i32.o \
bn_mp_get_i64.o bn_mp_get_l.o bn_mp_get_mag_u32.o bn_mp_get_mag_u64.o bn_mp_get_mag_ul.o bn_mp_grow.o \
bn_mp_incr.o bn_mp_init.o bn_mp_init_copy.o bn_mp_init_i32.o bn_mp_init_i64.o bn_mp_init_l.o \
bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_size.o bn_mp_init_u32.o bn_mp_init_u64.o bn_mp_init_ul.o \
bn_mp_invmod.o bn_mp_is_square.o bn_mp_iseven.o bn_mp_isodd.o bn_mp_kronecker.o bn_mp_lcm.o bn_mp_log_n.o \
bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o \
bn_mp_montgomery_reduce.o bn_mp_montgomery_setup.o bn_mp_mul.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul_d.o \
bn_mp_mulmod.o bn_mp_neg.o bn_mp_or.o bn_mp_pack.o bn_mp_pack_count.o bn_mp_prime_fermat.o \
bn_mp_prime_frobenius_underwood.o bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o \
bn_mp_prime_next_prime.o bn_mp_prime_rabin_miller_trials.o bn_mp_prime_rand.o \
bn_mp_prime_strong_lucas_selfridge.o bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_rand.o \
bn_mp_read_radix.o bn_mp_reduce.o bn_mp_reduce_2k.o bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o \
bn_mp_reduce_2k_setup_l.o bn_mp_reduce_is_2k.o bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o \
bn_mp_root_n.o bn_mp_rshd.o bn_mp_sbin_size.o bn_mp_set.o bn_mp_set_double.o bn_mp_set_i32.o \
bn_mp_set_i64.o bn_mp_set_l.o bn_mp_set_u32.o bn_mp_set_u64.o bn_mp_set_ul.o bn_mp_shrink.o \
bn_mp_signed_rsh.o bn_mp_sqr.o bn_mp_sqrmod.o bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o \
bn_mp_submod.o bn_mp_to_radix.o bn_mp_to_sbin.o bn_mp_to_ubin.o bn_mp_ubin_size.o bn_mp_unpack.o \
bn_mp_xor.o bn_mp_zero.o bn_prime_tab.o bn_s_mp_add.o bn_s_mp_balance_mul.o bn_s_mp_div_3.o \
bn_s_mp_exptmod.o bn_s_mp_exptmod_fast.o bn_s_mp_get_bit.o bn_s_mp_invmod_fast.o bn_s_mp_invmod_slow.o \
bn_s_mp_karatsuba_mul.o bn_s_mp_karatsuba_sqr.o bn_s_mp_log.o bn_s_mp_log_2expt.o bn_s_mp_log_d.o \
bn_s_mp_montgomery_reduce_fast.o bn_s_mp_mul_digs.o bn_s_mp_mul_digs_fast.o bn_s_mp_mul_high_digs.o \
bn_s_mp_mul_high_digs_fast.o bn_s_mp_prime_is_divisible.o bn_s_mp_rand_jenkins.o \
bn_s_mp_rand_platform.o bn_s_mp_reverse.o bn_s_mp_sqr.o bn_s_mp_sqr_fast.o bn_s_mp_sub.o \
bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o

HEADERS_PUB=tommath.h
HEADERS=tommath_private.h tommath_class.h tommath_superclass.h tommath_cutoffs.h $(HEADERS_PUB)

#The default rule for make builds the libtommath.a library (static)
default: $(LIBMAIN_S)

#Dependencies on *.h
$(OBJECTS): $(HEADERS)

#This is necessary for compatibility with BSD make (namely on OpenBSD)
.SUFFIXES: .o .c
.c.o:
	$(CC) $(LTM_CFLAGS) -c $< -o $@

#Create libtommath.a
$(LIBMAIN_S): $(OBJECTS)
	$(AR) $(ARFLAGS) $@ $(OBJECTS)
	$(RANLIB) $@

#Build test_standalone suite
test: demo/shared.o demo/test.o $(LIBMAIN_S)
	$(CC) $(LTM_CFLAGS) $(LTM_LDFLAGS) $^ -o $@
	@echo "NOTICE: start the tests by: ./test"

test_standalone: test
	@echo "test_standalone is deprecated, please use make-target 'test'"

all: $(LIBMAIN_S) test

tune: $(LIBMAIN_S)
	$(MAKE) -C etc tune
	$(MAKE)

#NOTE: this makefile works also on cygwin, thus we need to delete *.exe
clean:
	-@rm -f $(OBJECTS) $(LIBMAIN_S)
	-@rm -f demo/main.o demo/opponent.o demo/test.o test test.exe

#Install the library + headers
install: $(LIBMAIN_S)
	@mkdir -p $(DESTDIR)$(INCPATH) $(DESTDIR)$(LIBPATH)/pkgconfig
	@cp $(LIBMAIN_S) $(DESTDIR)$(LIBPATH)/
	@cp $(HEADERS_PUB) $(DESTDIR)$(INCPATH)/
	@sed -e 's,^prefix=.*,prefix=$(PREFIX),' -e 's,^Version:.*,Version: $(VERSION),' libtommath.pc.in > $(DESTDIR)$(LIBPATH)/pkgconfig/libtommath.pc
Deleted libtommath/makefile_include.mk.
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






































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#
# Include makefile for libtommath
#

#version of library
VERSION=1.3.0
VERSION_PC=1.3.0
VERSION_SO=4:0:3

PLATFORM := $(shell uname | sed -e 's/_.*//')

# default make target
default: ${LIBNAME}

# Compiler and Linker Names
ifndef CROSS_COMPILE
  CROSS_COMPILE=
endif

# We only need to go through this dance of determining the right compiler if we're using
# cross compilation, otherwise $(CC) is fine as-is.
ifneq (,$(CROSS_COMPILE))
ifeq ($(origin CC),default)
CSTR := "\#ifdef __clang__\nCLANG\n\#endif\n"
ifeq ($(PLATFORM),FreeBSD)
  # XXX: FreeBSD needs extra escaping for some reason
  CSTR := $$$(CSTR)
endif
ifneq (,$(shell echo $(CSTR) | $(CC) -E - | grep CLANG))
  CC := $(CROSS_COMPILE)clang
else
  CC := $(CROSS_COMPILE)gcc
endif # Clang
endif # cc is Make's default
endif # CROSS_COMPILE non-empty

LD=$(CROSS_COMPILE)ld
AR=$(CROSS_COMPILE)ar
RANLIB=$(CROSS_COMPILE)ranlib

ifndef MAKE
# BSDs refer to GNU Make as gmake
ifneq (,$(findstring $(PLATFORM),FreeBSD OpenBSD DragonFly NetBSD))
  MAKE=gmake
else
  MAKE=make
endif
endif

LTM_CFLAGS += -I./ -Wall -Wsign-compare -Wextra -Wshadow

ifdef SANITIZER
LTM_CFLAGS += -fsanitize=undefined -fno-sanitize-recover=all -fno-sanitize=float-divide-by-zero
endif

ifndef NO_ADDTL_WARNINGS
# additional warnings
LTM_CFLAGS += -Wdeclaration-after-statement -Wbad-function-cast -Wcast-align
LTM_CFLAGS += -Wstrict-prototypes -Wpointer-arith
endif

ifdef CONV_WARNINGS
LTM_CFLAGS += -std=c89 -Wconversion -Wsign-conversion
ifeq ($(CONV_WARNINGS), strict)
LTM_CFLAGS += -DMP_USE_ENUMS -Wc++-compat
endif
else
LTM_CFLAGS += -Wsystem-headers
endif

ifdef COMPILE_DEBUG
#debug
LTM_CFLAGS += -g3
endif

ifdef COMPILE_SIZE
#for size
LTM_CFLAGS += -Os
else

ifndef IGNORE_SPEED
#for speed
LTM_CFLAGS += -O3 -funroll-loops

#x86 optimizations [should be valid for any GCC install though]
LTM_CFLAGS  += -fomit-frame-pointer
endif

endif # COMPILE_SIZE

ifneq ($(findstring clang,$(CC)),)
LTM_CFLAGS += -Wno-typedef-redefinition -Wno-tautological-compare -Wno-builtin-requires-header
endif
ifneq ($(findstring mingw,$(CC)),)
LTM_CFLAGS += -Wno-shadow
endif
ifeq ($(PLATFORM), Darwin)
LTM_CFLAGS += -Wno-nullability-completeness
endif
ifeq ($(PLATFORM), CYGWIN)
LIBTOOLFLAGS += -no-undefined
endif

# add in the standard FLAGS
LTM_CFLAGS += $(CFLAGS)
LTM_LFLAGS += $(LFLAGS)
LTM_LDFLAGS += $(LDFLAGS)
LTM_LIBTOOLFLAGS += $(LIBTOOLFLAGS)


ifeq ($(PLATFORM),FreeBSD)
  _ARCH := $(shell sysctl -b hw.machine_arch)
else
  _ARCH := $(shell uname -m)
endif

# adjust coverage set
ifneq ($(filter $(_ARCH), i386 i686 x86_64 amd64 ia64),)
   COVERAGE = test_standalone timing
   COVERAGE_APP = ./test && ./timing
else
   COVERAGE = test_standalone
   COVERAGE_APP = ./test
endif

HEADERS_PUB=tommath.h
HEADERS=tommath_private.h tommath_class.h tommath_superclass.h tommath_cutoffs.h $(HEADERS_PUB)

#LIBPATH  The directory for libtommath to be installed to.
#INCPATH  The directory to install the header files for libtommath.
#DATAPATH The directory to install the pdf docs.
DESTDIR  ?=
PREFIX   ?= /usr/local
LIBPATH  ?= $(PREFIX)/lib
INCPATH  ?= $(PREFIX)/include
DATAPATH ?= $(PREFIX)/share/doc/libtommath/pdf

#make the code coverage of the library
#
coverage: LTM_CFLAGS += -fprofile-arcs -ftest-coverage -DTIMING_NO_LOGS
coverage: LTM_LFLAGS += -lgcov
coverage: LTM_LDFLAGS += -lgcov

coverage: $(COVERAGE)
	$(COVERAGE_APP)

lcov: coverage
	rm -f coverage.info
	lcov --capture --no-external --no-recursion $(LCOV_ARGS) --output-file coverage.info -q
	genhtml coverage.info --output-directory coverage -q

# target that removes all coverage output
cleancov-clean:
	rm -f `find . -type f -name "*.info" | xargs`
	rm -rf coverage/

# cleans everything - coverage output and standard 'clean'
cleancov: cleancov-clean clean

clean:
	rm -f *.gcda *.gcno *.gcov *.bat *.o *.a *.obj *.lib *.exe *.dll etclib/*.o \
				demo/*.o test timing mtest_opponent mtest/mtest mtest/mtest.exe tuning_list \
				*.s mpi.c *.da *.dyn *.dpi tommath.tex `find . -type f | grep [~] | xargs` *.lo *.la
	rm -rf .libs/ demo/.libs
	${MAKE} -C etc/ clean MAKE=${MAKE}
	${MAKE} -C doc/ clean MAKE=${MAKE}
Deleted libtommath/win32/libtommath.dll.

cannot compute difference between binary files

Deleted libtommath/win32/tommath.lib.

cannot compute difference between binary files

Deleted libtommath/win64-arm/libtommath.dll.

cannot compute difference between binary files

Deleted libtommath/win64-arm/libtommath.dll.a.

cannot compute difference between binary files

Deleted libtommath/win64-arm/tommath.lib.

cannot compute difference between binary files

Deleted libtommath/win64/libtommath.dll.

cannot compute difference between binary files

Deleted libtommath/win64/libtommath.dll.a.

cannot compute difference between binary files

Deleted libtommath/win64/tommath.lib.

cannot compute difference between binary files

Changes to macosx/GNUmakefile.
1
2
3
4
5
6
7
8
9
10
11












12
13
14
15
16
17
18






1
2
3
4

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
-
-
-
-
-
-




-
+
+
+
+
+
+
+
+
+
+
+
+







########################################################################################################
#
# Makefile wrapper to build tcl on Mac OS X in a way compatible with the tk/macosx Xcode buildsystem
#	uses the standard Unix build system in tcl/unix (which can be used directly instead of this
#	if you are not using the tk/macosx projects).
#
# Copyright (c) 2002-2008 Daniel A. Steffen <das@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
########################################################################################################

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Makefile wrapper to build tcl on Mac OS X in a way compatible with the tk/macosx Xcode buildsystem
#	uses the standard Unix build system in tcl/unix (which can be used directly instead of this
#	if you are not using the tk/macosx projects).
#

#-------------------------------------------------------------------------------------------------------
# customizable settings

DESTDIR			?=
INSTALL_ROOT		?= ${DESTDIR}

Changes to macosx/Tcl-Common.xcconfig.
1
2
3
4
5
6
7
8
9
10












11
12
13
14
15
16
17






1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
-
-
-
-
-
-




+
+
+
+
+
+
+
+
+
+
+
+







//
// Tcl-Common.xcconfig --
//
//	This file contains the Xcode build settings comon to all
//	project configurations in Tcl.xcodeproj.
//
// Copyright (c) 2007-2008 Daniel A. Steffen <das@users.sourceforge.net>
//
// See the file "license.terms" for information on usage and redistribution
// of this file, and for a DISCLAIMER OF ALL WARRANTIES.

// You may distribute and/or modify this program under the terms of the GNU
// Affero General Public License as published by the Free Software Foundation,
// either version 3 of the License, or (at your option) any later version.
//
// See the file "COPYING" for information on usage and redistribution
// of this file, and for a DISCLAIMER OF ALL WARRANTIES.

// Tcl-Common.xcconfig --
//
//	This file contains the Xcode build settings comon to all
//	project configurations in Tcl.xcodeproj.

HEADER_SEARCH_PATHS = "$(DERIVED_FILE_DIR)/tcl" $(HEADER_SEARCH_PATHS)
OTHER_LDFLAGS = -headerpad_max_install_names -sectcreate __TEXT __info_plist "$(DERIVED_FILE_DIR)/tcl/Tclsh-Info.plist" $(OTHER_LDFLAGS)
INSTALL_PATH = $(BINDIR)
INSTALL_MODE_FLAG = go-w,a+rX
GCC_PREFIX_HEADER = $(DERIVED_FILE_DIR)/tcl/tclConfig.h
GCC_GENERATE_DEBUGGING_SYMBOLS = YES
Changes to macosx/Tcl-Debug.xcconfig.

1










2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17




18
19
20
21
22
23
24
+

+
+
+
+
+
+
+
+
+
+





-
-
-
-







// Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
//
// See the file "license.terms" for information on usage and redistribution
// of this file, and for a DISCLAIMER OF ALL WARRANTIES.

// You may distribute and/or modify this program under the terms of the GNU
// Affero General Public License as published by the Free Software Foundation,
// either version 3 of the License, or (at your option) any later version.
//
// See the file "COPYING" for information on usage and redistribution
// of this file, and for a DISCLAIMER OF ALL WARRANTIES.

// Tcl-Debug.xcconfig --
//
//	This file contains the Xcode build settings for all Debug
//	project configurations in Tcl.xcodeproj.
//
// Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
//
// See the file "license.terms" for information on usage and redistribution
// of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#include "Tcl-Common.xcconfig"

DEBUG_INFORMATION_FORMAT = dwarf
DEAD_CODE_STRIPPING = NO
DEPLOYMENT_POSTPROCESSING = NO
GCC_OPTIMIZATION_LEVEL = 0
Changes to macosx/Tcl-Info.plist.in.
1
2
3
4
5
6
7
8








9
10
11
12
13
14
15
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23








+
+
+
+
+
+
+
+







<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
<!--
	Copyright (c) 2005-2007 Daniel A. Steffen <das@users.sourceforge.net>

	See the file "license.terms" for information on usage and redistribution of
	this file, and for a DISCLAIMER OF ALL WARRANTIES.
-->
<!--
	You may distribute and/or modify this program under the terms of the GNU
	Affero General Public License as published by the Free Software Foundation,
	either version 3 of the License, or (at your option) any later version.

	See the file "COPYING" for information on usage and redistribution
	of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-->
<plist version="1.0">
<dict>
	<key>CFBundleDevelopmentRegion</key>
	<string>English</string>
	<key>CFBundleExecutable</key>
	<string>@TCL_LIB_FILE@</string>
	<key>CFBundleGetInfoString</key>
Changes to macosx/Tcl-Release.xcconfig.
1
2
3
4
5
6
7
8
9
10












11
12
13
14
15
16
17






1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
-
-
-
-
-
-




+
+
+
+
+
+
+
+
+
+
+
+







//
// Tcl-Release.xcconfig --
//
//	This file contains the Xcode build settings for all Release
//	project configurations in Tcl.xcodeproj.
//
// Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
//
// See the file "license.terms" for information on usage and redistribution
// of this file, and for a DISCLAIMER OF ALL WARRANTIES.

// You may distribute and/or modify this program under the terms of the GNU
// Affero General Public License as published by the Free Software Foundation,
// either version 3 of the License, or (at your option) any later version.
//
// See the file "COPYING" for information on usage and redistribution
// of this file, and for a DISCLAIMER OF ALL WARRANTIES.

// Tcl-Release.xcconfig --
//
//	This file contains the Xcode build settings for all Release
//	project configurations in Tcl.xcodeproj.

#include "Tcl-Common.xcconfig"

DEBUG_INFORMATION_FORMAT = dwarf-with-dsym
DEAD_CODE_STRIPPING = YES
DEPLOYMENT_POSTPROCESSING = YES
GCC_OPTIMIZATION_LEVEL = 2
Changes to macosx/Tclsh-Info.plist.in.
1
2
3
4
5
6
7
8








9
10
11
12
13
14
15
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23








+
+
+
+
+
+
+
+







<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
<!--
	Copyright (c) 2005-2007 Daniel A. Steffen <das@users.sourceforge.net>

	See the file "license.terms" for information on usage and redistribution of
	this file, and for a DISCLAIMER OF ALL WARRANTIES.
-->
<!--
	You may distribute and/or modify this program under the terms of the GNU
	Affero General Public License as published by the Free Software Foundation,
	either version 3 of the License, or (at your option) any later version.

	See the file "COPYING" for information on usage and redistribution
	of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-->
<plist version="1.0">
<dict>
	<key>CFBundleDevelopmentRegion</key>
	<string>English</string>
	<key>CFBundleExecutable</key>
	<string>tclsh@TCL_VERSION@</string>
	<key>CFBundleGetInfoString</key>
Changes to macosx/tclMacOSXBundle.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
















14
15
16
17
18
19
20
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

-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclMacOSXBundle.c --
 *
 *	This file implements functions that inspect CFBundle structures on
 *	MacOS X.
 *
 * Copyright © 2001-2009 Apple Inc.
 * Copyright © 2003-2009 Daniel A. Steffen <das@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclMacOSXBundle.c --
 *
 *	This file implements functions that inspect CFBundle structures on
 *	MacOS X.
 */

#include "tclPort.h"
#include "tclInt.h"

#ifdef HAVE_COREFOUNDATION
#include <CoreFoundation/CoreFoundation.h>

#ifndef TCL_DYLD_USE_DLFCN
Changes to macosx/tclMacOSXFCmd.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclMacOSXFCmd.c
 *
 *	This file implements the MacOSX specific portion of file manipulation
 *	subcommands of the "file" command.
 *
 * Copyright © 2003-2007 Daniel A. Steffen <das@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclMacOSXFCmd.c
 *
 *	This file implements the MacOSX specific portion of file manipulation
 *	subcommands of the "file" command.
 */

#include "tclInt.h"

#ifdef HAVE_GETATTRLIST
#include <sys/attr.h>
#include <sys/paths.h>
#include <libkern/OSByteOrder.h>
#endif
80
81
82
83
84
85
86
87
88
89
90
91





92

93
94
95
96
97
98
99
91
92
93
94
95
96
97





98
99
100
101
102

103
104
105
106
107
108
109
110







-
-
-
-
-
+
+
+
+
+
-
+







static int		GetOSTypeFromObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, OSType *osTypePtr);
static Tcl_Obj *	NewOSTypeObj(const OSType newOSType);
static int		SetOSTypeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		UpdateStringOfOSType(Tcl_Obj *objPtr);

static const Tcl_ObjType tclOSTypeType = {
    "osType",				/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    UpdateStringOfOSType,		/* updateStringProc */
    SetOSTypeFromAny,			/* setFromAnyProc */
    "osType",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    UpdateStringOfOSType,	/* updateStringProc */
    SetOSTypeFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V0
    0
};

enum {
    kIsInvisible = 0x4000,
};

#define kFinfoIsInvisible	(OSSwapHostToBigConstInt16(kIsInvisible))
638
639
640
641
642
643
644
645

646
647
648
649
650
651
652
649
650
651
652
653
654
655

656
657
658
659
660
661
662
663







-
+







{
    const char *string;
    int result = TCL_OK;
    Tcl_DString ds;
    Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman");
    Tcl_Size length;

    string = TclGetStringFromObj(objPtr, &length);
    string = Tcl_GetStringFromObj(objPtr, &length);
    Tcl_UtfToExternalDStringEx(NULL, encoding, string, length, TCL_ENCODING_PROFILE_TCL8, &ds, NULL);

    if (Tcl_DStringLength(&ds) > 4) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "expected Macintosh OS type but got \"%s\": ", string));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "MAC_OSTYPE", (char *)NULL);
687
688
689
690
691
692
693
694

695
696
697
698
699
700
701
698
699
700
701
702
703
704

705
706
707
708
709
710
711
712







-
+







 *	OSType-to-string conversion.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfOSType(
    Tcl_Obj *objPtr)	/* OSType object whose string rep to
    Tcl_Obj *objPtr)		/* OSType object whose string rep to
				 * update. */
{
    const size_t size = TCL_UTF_MAX * 4;
    char *dst = Tcl_InitStringRep(objPtr, NULL, size);
    OSType osType = (OSType) objPtr->internalRep.wideValue;
    int written = 0;
    Tcl_Encoding encoding;
Changes to macosx/tclMacOSXNotify.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

















16
17
18
19
20
21
22
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

-
-
-
-
-
-








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclMacOSXNotify.c --
 *
 *	This file contains the implementation of a merged CFRunLoop/select()
 *	based notifier, which is the lowest-level part of the Tcl event loop.
 *	This file works together with generic/tclNotify.c.
 *
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 * Copyright © 2001-2009, Apple Inc.
 * Copyright © 2005-2009 Daniel A. Steffen <das@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclMacOSXNotify.c --
 *
 *	This file contains the implementation of a merged CFRunLoop/select()
 *	based notifier, which is the lowest-level part of the Tcl event loop.
 *	This file works together with generic/tclNotify.c.
 */

#include "tclInt.h"

/*
 * In macOS 10.12 the os_unfair_lock was introduced as a replacement for the
 * OSSpinLock, and the OSSpinLock was deprecated.
 */

307
308
309
310
311
312
313
314

315
316
317
318
319
320
321
318
319
320
321
322
323
324

325
326
327
328
329
330
331
332







-
+







    int mask;			/* Mask of desired events: TCL_READABLE,
				 * etc. */
    int readyMask;		/* Mask of events that have been seen since
				 * the last time file handlers were invoked
				 * for this file. */
    Tcl_FileProc *proc;		/* Function to call, in the style of
				 * Tcl_CreateFileHandler. */
    void *clientData;	/* Argument to pass to proc. */
    void *clientData;		/* Argument to pass to proc. */
    struct FileHandler *nextPtr;/* Next in list of all files we care about. */
} FileHandler;

/*
 * The following structure is what is added to the Tcl event queue when file
 * handlers are ready to fire.
 */
995
996
997
998
999
1000
1001
1002

1003
1004
1005
1006
1007
1008
1009
1006
1007
1008
1009
1010
1011
1012

1013
1014
1015
1016
1017
1018
1019
1020







-
+







 *	Replaces any previous timer.
 *
 *----------------------------------------------------------------------
 */

void
TclpSetTimer(
    const Tcl_Time *timePtr)		/* Timeout value, may be NULL. */
    const Tcl_Time *timePtr)	/* Timeout value, may be NULL. */
{
    ThreadSpecificData *tsdPtr;
    CFRunLoopTimerRef runLoopTimer;
    CFTimeInterval waitTime;

    tsdPtr = TCL_TSD_INIT(&dataKey);
    runLoopTimer = tsdPtr->runLoopTimer;
1109
1110
1111
1112
1113
1114
1115
1116

1117
1118
1119
1120
1121
1122
1123
1120
1121
1122
1123
1124
1125
1126

1127
1128
1129
1130
1131
1132
1133
1134







-
+







    int fd,			/* Handle of stream to watch. */
    int mask,			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION: indicates
				 * conditions under which proc should be
				 * called. */
    Tcl_FileProc *proc,		/* Function to call for each selected
				 * event. */
    void *clientData)	/* Arbitrary data to pass to proc. */
    void *clientData)		/* Arbitrary data to pass to proc. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL);

    if (filePtr == NULL) {
	filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler));
	filePtr->fd = fd;
1903
1904
1905
1906
1907
1908
1909
1910

1911
1912
1913
1914
1915
1916
1917
1914
1915
1916
1917
1918
1919
1920

1921
1922
1923
1924
1925
1926
1927
1928







-
+







 *----------------------------------------------------------------------
 */

int
TclAsyncNotifier(
    int sigNumber,		/* Signal number. */
    TCL_UNUSED(Tcl_ThreadId),	/* Target thread. */
    TCL_UNUSED(void *),	/* Notifier data. */
    TCL_UNUSED(void *),		/* Notifier data. */
    int *flagPtr,		/* Flag to mark. */
    int value)			/* Value of mark. */
{
#if TCL_THREADS
    /*
     * WARNING:
     * This code most likely runs in a signal handler. Thus,
Changes to 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
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

+
+
+
+
+
+
+
+
+
+
+
+
+









-
-
-
-
-
-







#!/usr/bin/tclsh

# Copyright © 2014 Serg G. Brester (aka sebres)
#
# See the file "license.terms" for information on usage and redistribution
# of this file.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# ------------------------------------------------------------------------
#
# 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 © 2014 Serg G. Brester (aka sebres)
#
# See the file "license.terms" for information on usage and redistribution
# of this file.
#

array set in {-time 500}
if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} {
  array set in $argv
}

## common test performance framework:
352
353
354
355
356
357
358
359
360
361
362
363

364
365
366

367
368
369
370
371
372
373
374
375
359
360
361
362
363
364
365


366


367
368


369


370
371
372
373
374
375
376







-
-

-
-
+

-
-
+
-
-







  _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}}

    setup {set _(org-reptime) $_(reptime); lset _(reptime) 1 50}

    # Scan : test rotate of GC objects (format is dynamic, so tcl-obj removed with last reference)
    setup {set i -1}
    {clock scan "[incr i] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1}
    {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)
    setup {incr i; set j $i}
    {clock scan "[incr j -1] - 25.11.2015" -format "$j - %d.%m.%Y" -base 0 -gmt 1}
    {set i 50; time { clock scan "[incr i -1] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1 } 50}
    setup {set _(reptime) $_(org-reptime); set j $i}
    {clock scan "[incr j -1] - 25.11.2015" -format "$j - %d.%m.%Y" -base 0 -gmt 1; if {!$j} {set j $i}}
  }
}

proc test-ensemble-perf {{reptime 1000}} {
  _test_run $reptime {
    # Clock clicks (ensemble)
    {clock clicks}
Changes to tests-perf/comparePerf.tcl.
1











2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
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

+
+
+
+
+
+
+
+
+
+
+








-
-
-







#!/usr/bin/tclsh

# See the file "license.terms" for information on usage and redistribution
# of this file.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.

# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# ------------------------------------------------------------------------
#
# comparePerf.tcl --
#
#  Script to compare performance data from multiple runs.
#
# ------------------------------------------------------------------------
#
# See the file "license.terms" for information on usage and redistribution
# of this file.
#
# Usage:
#   tclsh comparePerf.tcl [--regexp RE] [--ratio time|rate] [--combine] [--base BASELABEL] PERFFILE ...
#
# The test data from each input file is tabulated so as to compare the results
# of test runs. If a PERFFILE does not exist, it is retried by adding the
# .perf extension. If the --regexp is specified, only test results whose
# id matches RE are examined.
Changes to tests-perf/listPerf.tcl.
1











2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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

+
+
+
+
+
+
+
+
+
+
+









-
-
-







#!/usr/bin/tclsh

# See the file "license.terms" for information on usage and redistribution
# of this file.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# ------------------------------------------------------------------------
#
# listPerf.tcl --
#
#  This file provides performance tests for list operations. Run
#     tclsh listPerf.tcl help
#  for options.
# ------------------------------------------------------------------------
#
# See the file "license.terms" for information on usage and redistribution
# of this file.
#
# Note: this file does not use the test-performance.tcl framework as we want
# more direct control over timerate options.

catch {package require twapi}

namespace eval perf::list {
    variable perfScript [file normalize [info script]]
Changes to tests-perf/test-performance.tcl.














1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+










-
-
-
-
-
-







#! /usr/bin/env tclsh

# Copyright © 2014 Serg G. Brester (aka sebres)
#
# See the file "license.terms" for information on usage and redistribution
# of this file.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# ------------------------------------------------------------------------
#
# test-performance.tcl --
#
#  This file provides common performance tests for comparison of tcl-speed
#  degradation or regression by switching between branches.
#
#  To execute test case evaluate direct corresponding file "tests-perf\*.perf.tcl".
#
# ------------------------------------------------------------------------
#
# Copyright © 2014 Serg G. Brester (aka sebres)
#
# See the file "license.terms" for information on usage and redistribution
# of this file.
#

namespace eval ::tclTestPerf {
# warm-up interpreter compiler env, calibrate timerate measurement functionality:

# if no timerate here - import from unsupported:
if {[namespace which -command timerate] eq {}} {
  namespace inscope ::tcl::unsupported {namespace export timerate}
Changes to tests-perf/timer-event.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
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


+
+
+
+
+
+
+
+
+
+
+
+








-
-
-
-
-
-
-







#!/usr/bin/tclsh

# Copyright © 2014 Serg G. Brester (aka sebres)
#
# See the file "license.terms" for information on usage and redistribution
# of this file.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# ------------------------------------------------------------------------
#
# timer-event.perf.tcl --
#
#  This file provides performance tests for comparison of tcl-speed
#  of timer events (event-driven tcl-handling).
#
# ------------------------------------------------------------------------
#
# Copyright © 2014 Serg G. Brester (aka sebres)
#
# See the file "license.terms" for information on usage and redistribution
# of this file.
#


if {![namespace exists ::tclTestPerf]} {
  source [file join [file dirname [info script]] test-performance.tcl]
}


namespace eval ::tclTestPerf-Timer-Event {
Changes to tests/aaa_exit.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  exit, emphasis on finalization hangs
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  exit, emphasis on finalization hangs
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

test exit-1.1 {normal, quick exit} {
Changes to tests/abstractlist.test.
1
2
3
4
5
6










7
8
9
10
11
12
13


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
-
-




+
+
+
+
+
+
+
+
+
+







# Exercise AbstractList via the "lstring" command defined in tclTestABSList.c
#
# Copyright © 2022 Brian Griffin
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Exercise AbstractList via the "lstring" command defined in tclTestABSList.c


if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

catch {
199
200
201
202
203
204
205
206

207
208
209
210
211
212
213
207
208
209
210
211
212
213

214
215
216
217
218
219
220
221







-
+







test abstractlist-2.14 {error case lset multiple indicies} -constraints {testobj lstring} -body {
    set l [lstring Inconceivable]
    set l-isa [testobj objtype $l]
    set m [lset l 2 0 1 k]
    set m-isa [testobj objtype $m]
    list $l ${l-isa} $m ${m-isa} [value-cmp l m]
} -returnCodes 1 \
    -result {Multiple indicies not supported by lstring.}
    -result {Multiple indices not supported by lstring.}

# lsort

test abstractlist-3.0 {no shimmer llength} {testobj lstring} {
    set l [lstring -not SLICE $str]
    set l-isa [testobj objtype $l]
    set len [llength $l]
489
490
491
492
493
494
495
496

497
498
499
500
501
502
503
504

505
506
507
508
509
510
511
497
498
499
500
501
502
503

504
505
506
507
508
509
510
511

512
513
514
515
516
517
518
519







-
+







-
+







    set l [lstring {*}$options Inconceivable]
    set l-isa [testobj objtype $l]
    set m [testevalex {lset l 2 k}]
    set m-isa [testobj objtype $m]
    list $l ${l-isa} $m ${m-isa} [value-cmp l m]
} {{I n k o n c e i v a b l e} lstring {I n k o n c e i v a b l e} lstring 0}

test abstractlist-$not-4.11e {error case lset multiple indicies} \
test abstractlist-$not-4.11e {error case lset multiple indices} \
    -constraints {SetelementShimmer testobj lstring testevalex} -body {
    set l [lstring Inconceivable]
    set l-isa [testobj objtype $l]
    set m [testevalex {lset l 2 0 1 k}]
    set m-isa [testobj objtype $m]
    list $l ${l-isa} $m ${m-isa} [value-cmp l m]
} -returnCodes 1 \
    -result {Multiple indicies not supported by lstring.}
    -result {Multiple indices not supported by lstring.}

# lrepeat
test abstractlist-$not-4.12 {shimmer lrepeat} -constraints {testobj lstring} -body {
    set l [lstring {*}$options Inconceivable]
    set l-isa [testobj objtype $l]
    set m [lrepeat 3 $l]
    set m-isa [testobj objtype $m]
Changes to tests/all.tcl.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# all.tcl --
#
# This file contains a top-level script to run all of the Tcl
# tests.  Execute it by invoking "source all.tcl" when running tcltest
# in this directory.
#
# Copyright © 1998-1999 Scriptics Corporation.
# Copyright © 2000 Ajuba Solutions
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# all.tcl --
#
# This file contains a top-level script to run all of the Tcl
# tests.  Execute it by invoking "source all.tcl" when running tcltest
# in this directory.

package prefer latest
package require tcltest 2.5
namespace import ::tcltest::*

configure {*}$argv -testdir [file dirname [file dirname [file normalize [
    info script]/...]]]
Changes to tests/append.test.
1
2
3
4
5
6
7
8
9
10
11
12














13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  append lappend
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  append lappend
#
# 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.
#

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
unset -nocomplain x
68
69
70
71
72
73
74
75

76
77
78
79

80
81
82
83

84
85
86
87
88
89
90
76
77
78
79
80
81
82

83
84
85
86

87
88
89
90

91
92
93
94
95
96
97
98







-
+



-
+



-
+







test append-3.6 {append surrogates} -body {
    set x \uDE02
    set x \uD83D$x
} -result \uD83D\uDE02
test append-3.7 {append \xC0 \x80} -constraints testbytestring -body {
    set x [testbytestring \xC0]
    string length [append x [testbytestring \x80]]
} -result 2
} -result 1
test append-3.8 {append \xC0 \x80} -constraints testbytestring -body {
    set x [testbytestring \xC0]
    string length $x[testbytestring \x80]
} -result 2
} -result 1
test append-3.9 {append \xC0 \x80} -constraints testbytestring -body {
    set x [testbytestring \x80]
    string length [testbytestring \xC0]$x
} -result 2
} -result 1
test append-3.10 {append surrogates} -body {
    set x \uD83D
    string range $x 0 end
    append x \uDE02
} -result [string range \uD83D\uDE02 0 end]

test append-4.1 {lappend command} {
Changes to tests/appendComp.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  append lappend
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  append lappend
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
catch {unset x}

Changes to tests/apply.test.
1
2
3
4
5
6
7
8
9
10
11
12
13













14
15
16
17
18
19
20






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
-
-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  apply
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
# Copyright © 2005-2006 Miguel Sofer
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  apply
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
Changes to tests/assemble.test.
1
2
3
4
5
6
7
8
9
10











11
12
13
14
15
16
17




1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+







# assemble.test --
#
#	Test suite for the 'tcl::unsupported::assemble' command
#
# Copyright © 2010 Ozgur Dogan Ugurlu.
# Copyright © 2010 Kevin B. Kenny.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#-----------------------------------------------------------------------------

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# assemble.test --
#
#	Test suite for the 'tcl::unsupported::assemble' command

# Commands covered: assemble

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
Changes to tests/assemble1.bench.







1
2
3
4
5
6
7
1
2
3
4
5
6
7
8
9
10
11
12
13
14
+
+
+
+
+
+
+







# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

proc ulam1 {n} {
    set max $n
    while {$n != 1} {
	if {$n > $max} {
	    set max $n
	}
	if {$n % 2} {
Changes to tests/assocd.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# This file tests the AssocData facility of Tcl
#
# 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 © 1991-1994 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file tests the AssocData facility of Tcl
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/async.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  none
#
# This file contains a collection of tests for Tcl_AsyncCreate and related
# library procedures.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright © 1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  none
#
# This file contains a collection of tests for Tcl_AsyncCreate and related
# library procedures.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/autoMkindex.test.
1
2
3
4
5
6
7
8
9
10













11
12
13
14
15
16
17





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
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  auto_mkindex auto_import
#
# This file contains tests related to autoloading and generating the
# autoloading index.
#
# Copyright © 1998  Lucent Technologies, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  auto_mkindex auto_import
#
# This file contains tests related to autoloading and generating the
# autoloading index.
#

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

makeFile {# Test file for:
121
122
123
124
125
126
127
128

129
130
131
132
133
134
135
129
130
131
132
133
134
135

136
137
138
139
140
141
142
143







-
+







    file delete tclIndex
    file exists tclIndex
} {0}
test autoMkindex-1.2 {build tclIndex based on a test file} {
    auto_mkindex . autoMkindex.tcl
    file exists tclIndex
} {1}
set element "{source -encoding utf-8 [file join . autoMkindex.tcl]}"
set element "{source [file join . autoMkindex.tcl]}"
test autoMkindex-1.3 {examine tclIndex} -setup {
    file delete tclIndex
} -body {
    auto_mkindex . autoMkindex.tcl
    namespace eval tcl_autoMkindex_tmp {
        set dir "."
        variable auto_index
186
187
188
189
190
191
192
193

194
195
196
197
198
199
200
194
195
196
197
198
199
200

201
202
203
204
205
206
207
208







-
+







test autoMkindex-3.2 {auto_mkindex_parser::command} -setup {
    file delete tclIndex
} -body {
    auto_mkindex_parser::command buried::myproc {name args} {
	variable index
	variable scriptFile
	append index [list set auto_index([fullname $name])] \
		" \[list source -encoding utf-8 \[file join \$dir [list $scriptFile]\]\]\n"
		" \[list source \[file join \$dir [list $scriptFile]\]\]\n"
    }
    auto_mkindex . autoMkindex.tcl
    namespace eval tcl_autoMkindex_tmp {
        set dir "."
        variable auto_index
        source tclIndex
        set ::result ""
212
213
214
215
216
217
218
219

220
221
222
223
224
225
226
220
221
222
223
224
225
226

227
228
229
230
231
232
233
234







-
+







    file delete tclIndex
} -constraints {knownBug} -body {
    auto_mkindex_parser::command {buried::my proc} {name args} {
	variable index
	variable scriptFile
	puts "my proc $name"
	append index [list set auto_index([fullname $name])] \
		" \[list source -encoding utf-8 \[file join \$dir [list $scriptFile]\]\]\n"
		" \[list source \[file join \$dir [list $scriptFile]\]\]\n"
    }
    auto_mkindex . autoMkindex.tcl
    namespace eval tcl_autoMkindex_tmp {
        set dir "."
        variable auto_index
        source tclIndex
        set ::result ""
262
263
264
265
266
267
268
269

270
271
272
273
274
275
276
270
271
272
273
274
275
276

277
278
279
280
281
282
283
284







-
+







	if {[string match {set auto_index*} $r]} {
	    lappend dat $r
	}
    }
    set result [lsort $dat]
    close $f
    set result
} {{set auto_index(::wok::commands) [list source -encoding utf-8 [file join $dir ensemblecommands.tcl]]} {set auto_index(::wok::vars) [list source -encoding utf-8 [file join $dir ensemblecommands.tcl]]} {set auto_index(wok) [list source -encoding utf-8 [file join $dir ensemblecommands.tcl]]}}
} {{set auto_index(::wok::commands) [list source [file join $dir ensemblecommands.tcl]]} {set auto_index(::wok::vars) [list source [file join $dir ensemblecommands.tcl]]} {set auto_index(wok) [list source [file join $dir ensemblecommands.tcl]]}}
removeFile ensemblecommands.tcl

test autoMkindex-4.1 {platform independent source commands} -setup {
    file delete tclIndex
    makeDirectory pkg
    makeFile {
	package provide football 1.0
299
300
301
302
303
304
305
306

307
308
309
310
311
312
313
307
308
309
310
311
312
313

314
315
316
317
318
319
320
321







-
+







    auto_mkindex . pkg/samename.tcl
    set f [open tclIndex r]
    lsort [lrange [split [string trim [read $f]] "\n"] end-1 end]
} -cleanup {
    catch {close $f}
    removeFile [file join pkg samename.tcl]
    removeDirectory pkg
} -result {{set auto_index(::college::team) [list source -encoding utf-8 [file join $dir pkg samename.tcl]]} {set auto_index(::pro::team) [list source -encoding utf-8 [file join $dir pkg samename.tcl]]}}
} -result {{set auto_index(::college::team) [list source [file join $dir pkg samename.tcl]]} {set auto_index(::pro::team) [list source [file join $dir pkg samename.tcl]]}}

test autoMkindex-5.1 {escape magic tcl chars in general code} -setup {
    file delete tclIndex
    makeDirectory pkg
    makeFile {
	set dollar1 "this string contains an unescaped dollar sign -> \\$foo"
	set dollar2 \
323
324
325
326
327
328
329
330

331
332
333
334
335
336
337
331
332
333
334
335
336
337

338
339
340
341
342
343
344
345







-
+







    auto_mkindex . pkg/magicchar.tcl
    set f [open tclIndex r]
    lindex [split [string trim [read $f]] "\n"] end
} -cleanup {
    catch {close $f}
    removeFile [file join pkg magicchar.tcl]
    removeDirectory pkg
} -result {set auto_index(testProc) [list source -encoding utf-8 [file join $dir pkg magicchar.tcl]]}
} -result {set auto_index(testProc) [list source [file join $dir pkg magicchar.tcl]]}
test autoMkindex-5.2 {correctly locate auto loaded procs with []} -setup {
    file delete tclIndex
    makeDirectory pkg
    makeFile {
	proc {[magic mojo proc]} {} {}
    } [file join pkg magicchar2.tcl]
    set result {}
Changes to tests/basic.test.













1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
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
+
+
+
+
+
+
+
+
+
+
+
+
+










-
-
-
-
-
-







# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains tests for the tclBasic.c source file. Tests appear in
# the same order as the C code that they test. The set of tests is
# currently incomplete since it currently includes only new tests for
# code changed for the addition of Tcl namespaces. Other variable-
# related tests appear in several other test files including
# assocd.test, cmdInfo.test, eval.test, expr.test, interp.test,
# and trace.test.
#
# Sourcing this file into Tcl runs the tests and generates output for
# errors. No output means no errors were found.
#
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/bigdata.test.
1
2
3
4
5
6
7









8
9
10
11

12
13
14
15
16
17
18


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
-
-





+
+
+
+
+
+
+
+
+




+







# Test cases for large sized data
#
# Copyright © 2023 Ashok P. Nadkarni
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Test cases for large sized data
#
# These are very rudimentary tests for large size arguments to commands.
# They do not exercise all possible code paths such as shared/unshared Tcl_Objs,
# literal/variable arguments etc.
# They do however test compiled and uncompiled execution.


if {"::tcltest" ni [namespace children]} {
    package require tcltest

    namespace import -force ::tcltest::*
}

Changes to tests/binary.test.
1
2
3
4
5
6
7
8
9
10
11














12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+
+







# This file tests the tclBinary.c file and the "binary" Tcl command.
#
# 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 © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file tests the tclBinary.c file and the "binary" Tcl command.
#
# 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.


if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
source [file join [file dirname [info script]] tcltests.tcl]
2013
2014
2015
2016
2017
2018
2019
2020

2021
2022
2023

2024
2025
2026
2027
2028
2029
2030
2021
2022
2023
2024
2025
2026
2027

2028
2029
2030

2031
2032
2033
2034
2035
2036
2037
2038







-
+


-
+







} \x3F\xCC\xCC\xCD
test binary-53.19 {Tcl_BinaryObjCmd: format} {} {
    set a {1.6 3.4}
    binary format r1 $a
} \xCD\xCC\xCC\x3F
test binary-53.20 {Tcl_BinaryObjCmd: float Inf} {} {
    binary format R Inf
} \x7F\x80\x00\x00
} \x7f\x80\x00\x00
test binary-53.21 {Tcl_BinaryObjCmd: float Inf} {} {
    binary format r Inf
} \x00\x00\x80\x7F
} \x00\x00\x80\x7f
test binary-53.22 {Binary float Inf round trip} -body {
    binary scan [binary format R Inf] R inf
    binary scan [binary format R -Inf] R inf_
    list $inf $inf_
} -result {Inf -Inf}
test binary-53.23 {Binary float round to FLT_MAX} -body {
    binary scan [binary format H* 7f7fffff] R fltmax
Changes to tests/chan.test.
1
2
3
4
5
6
7
8











9
10
11
12
13
14
15




1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
-
-
-
-




+
+
+
+
+
+
+
+
+
+
+







# This file contains a collection of tests for the Tcl built-in 'chan'
# command. Sourcing this file into Tcl runs the tests and generates
# output for errors. No output means no errors were found.
#
# Copyright © 2005 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains a collection of tests for the Tcl built-in 'chan'
# command. Sourcing this file into Tcl runs the tests and generates
# output for errors. No output means no errors were found.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
source [file join [file dirname [info script]] tcltests.tcl]

52
53
54
55
56
57
58
59

60
61
62
63
64
65
66
59
60
61
62
63
64
65

66
67
68
69
70
71
72
73







-
+







} -returnCodes error -result "wrong # args: should be \"chan configure channel ?-option value ...?\""
test chan-4.2 {chan command: [Bug 800753]} -body {
    chan configure stdout -eofchar Ā
} -returnCodes error -result {bad value for -eofchar: must be non-NUL ASCII character}
test chan-4.3 {chan command: [Bug 800753]} -body {
    chan configure stdout -eofchar \x00
} -returnCodes error -result {bad value for -eofchar: must be non-NUL ASCII character}
test chan-4.4 {chan command: check valid inValue, no outValue} -constraints deprecated -body {
test chan-4.4 {chan command: check valid inValue, no outValue} -body {
    chan configure stdout -eofchar [list \x27 {}]
} -result {}
test chan-4.5 {chan command: check valid inValue, invalid outValue} -body {
    chan configure stdout -eofchar [list \x27 \x80]
} -returnCodes error -result {bad value for -eofchar: must be non-NUL ASCII character}
test chan-4.6 {chan command: check no inValue, valid outValue} -body {
    chan configure stdout -eofchar [list {} \x27]
Changes to tests/chanio.test.
1
2
3
4
5
6
7
8
9
10
11
12
13
14

















15
16
17
18
19
20
21








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
-
-
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







# -*- tcl -*-
# Functionality covered: operation of all IO commands, and all procedures
# defined in generic/tclIO.c.
#
# 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 © 1991-1994 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Functionality covered: operation of all IO commands, and all procedures
# defined in generic/tclIO.c.
#
# 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.

# Functionality covered: operation of all IO commands, and all procedures
# defined in generic/tclIO.c.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

namespace eval ::tcl::test::io {
1086
1087
1088
1089
1090
1091
1092
1093

1094
1095
1096
1097
1098
1099
1100
1095
1096
1097
1098
1099
1100
1101

1102
1103
1104
1105
1106
1107
1108
1109







-
+







    chan configure $f -encoding shiftjis
    list [chan gets $f line] $line [chan eof $f]
} -cleanup {
    chan close $f
} -result {10 1234567890 0}
test chan-io-7.3 {FilterInputBytes: split up character at EOF} -setup {
    set x ""
} -constraints {testchannel} -body {
} -constraints testchannel -body {
    set f [open $path(test1) w]
    chan configure $f -translation binary
    chan puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -encoding shiftjis -profile tcl8
    lappend x [chan gets $f line] $line
5272
5273
5274
5275
5276
5277
5278
5279

5280
5281
5282
5283
5284
5285
5286
5287
5288
5289

5290
5291
5292
5293
5294
5295
5296
5281
5282
5283
5284
5285
5286
5287

5288
5289
5290
5291
5292
5293
5294
5295
5296
5297

5298
5299
5300
5301
5302
5303
5304
5305







-
+









-
+







} -cleanup {
    chan close $s1
    chan close $s2
} -result {auto crlf}
test chan-io-39.22 {Tcl_SetChannelOption, invariance} -setup {
    file delete $path(test1)
    set l ""
} -constraints {unix deprecated} -body {
} -constraints unix -body {
    set f1 [open $path(test1) w+]
    lappend l [chan configure $f1 -eofchar]
    chan configure $f1 -eofchar {O {}}
    lappend l [chan configure $f1 -eofchar]
    chan configure $f1 -eofchar D
    lappend l [chan configure $f1 -eofchar]
} -cleanup {
    chan close $f1
} -result {{} O D}
test chan-io-39.22a {Tcl_SetChannelOption, invariance} -constraints deprecated -setup {
test chan-io-39.22a {Tcl_SetChannelOption, invariance} -setup {
    file delete $path(test1)
    set l [list]
} -body {
    set f1 [open $path(test1) w+]
    chan configure $f1 -eofchar {O {}}
    lappend l [chan configure $f1 -eofchar]
    chan configure $f1 -eofchar D
6703
6704
6705
6706
6707
6708
6709
6710
6711


6712
6713
6714
6715

6716
6717

6718
6719
6720
6721
6722
6723
6724
6712
6713
6714
6715
6716
6717
6718


6719
6720
6721
6722
6723
6724
6725
6726

6727
6728
6729
6730
6731
6732
6733
6734







-
-
+
+




+

-
+







    return $result
} -result {0 0 ok}
test chan-io-52.4 {TclCopyChannel} -constraints {fcopy} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation lf -blocking 0
    chan configure $f2 -translation cr -blocking 0
    chan configure $f1 -encoding utf-8 -translation lf -blocking 0
    chan configure $f2 -encoding utf-8 -translation cr -blocking 0
    chan copy $f1 $f2 -size 40
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    chan close $f1
    chan close $f2
	# the file size is 41 because "©" is encoded in two bytes
    lappend result [file size $path(test1)]
} -result {0 0 40}
} -result {0 0 41}
test chan-io-52.5 {TclCopyChannel, all} -constraints {fcopy} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation binary -blocking 0
    chan configure $f2 -translation binary -blocking 0
6804
6805
6806
6807
6808
6809
6810
6811

6812
6813
6814
6815
6816
6817

6818
6819
6820
6821
6822

6823
6824
6825

6826
6827

6828
6829
6830
6831
6832
6833
6834
6814
6815
6816
6817
6818
6819
6820

6821
6822
6823
6824
6825
6826

6827
6828
6829
6830
6831

6832
6833
6834
6835
6836
6837

6838
6839
6840
6841
6842
6843
6844
6845







-
+





-
+




-
+



+

-
+







} -constraints {stdio fcopy} -body {
    set f1 [open $path(pipe) w]
    chan configure $f1 -translation lf
    chan puts $f1 "
	chan puts ready
	chan gets stdin
	set f1 \[open [list $thisScript] r\]
	chan configure \$f1 -translation lf
	chan configure \$f1 -encoding utf-8 -translation lf
	chan puts \[chan read \$f1 100\]
	chan close \$f1
    "
    chan close $f1
    set f1 [openpipe r+ $path(pipe)]
    chan configure $f1 -translation lf
    chan configure $f1 -encoding utf-8 -translation lf
    chan gets $f1
    chan puts $f1 ready
    chan flush $f1
    set f2 [open $path(test1) w]
    chan configure $f2 -translation lf
    chan configure $f2 -encoding utf-8 -translation lf
    set s0 [chan copy $f1 $f2 -size 40]
    catch {chan close $f1}
    chan close $f2
	# the file size is 41 because "©" is encoded in two bytes
    list $s0 [file size $path(test1)]
} -result {40 40}
} -result {40 41}
# Empty files, to register them with the test facility
set path(kyrillic.txt)   [makeFile {} kyrillic.txt]
set path(utf8-fcopy.txt) [makeFile {} utf8-fcopy.txt]
set path(utf8-rp.txt)    [makeFile {} utf8-rp.txt]
# Create kyrillic file, use lf translation to avoid os eol issues
set out [open $path(kyrillic.txt) w]
chan configure $out -encoding koi8-r -translation lf
Deleted tests/clock-ivm.test.
1
2
3
4
5
6
7
8








-
-
-
-
-
-
-
-
# clock-ivm.test --
#
# This test file covers the 'clock' command using inverted validity mode.
#
# See the file "clock.test" for more information.

::tcl::unsupported::clock::configure -valid [expr {![::tcl::unsupported::clock::configure -valid]}]
source [file join [file dirname [info script]] clock.test]
Changes to tests/clock.test.
23
24
25
26
27
28
29




30
31
32
33
34
35
36
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40







+
+
+
+







	}]} {
	# nothing to be done (registry loaded on demand)
    }
}

package require msgcat 1.4

set clockns [namespace ensemble configure clock -namespace]

testConstraint notclassic 1

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 with both validity modes - validate on / off:

178
179
180
181
182
183
184
185

186
187
188
189
190
191
192
182
183
184
185
186
187
188

189
190
191
192
193
194
195
196







-
+







# autogenerated by 'tools/makeTestCases.tcl'.  DO NOT EDIT CODE BETWEEN
# '# BEGIN' and '# END'.

# Define a fictitious locale, 'en_US_roman', for formatting of clock
# strings with localized numerics and eras.  This locale will be used
# in testing the 'clock' command.

namespace eval ::tcl::clock {
namespace eval ${clockns} {
    ::msgcat::mcmset en_US_roman {
	LOCALE_ERAS {
	    {-62164627200 {} 0}
	    {-59008867200 c 100}
	    {-55853107200 cc 200}
	    {-52697347200 ccc 300}
	    {-49541587200 cd 400}
232
233
234
235
236
237
238
239

240
241
242
243
244
245
246
236
237
238
239
240
241
242

243
244
245
246
247
248
249
250







-
+







    }
}

#----------------------------------------------------------------------
#
# The tests for the Windows platform are careful *not* to muck with
# the system registry.  Instead, the 'registry' command is overridden
# in the '::tcl::clock' namespace.
# in the namespace for the clock implementation.
#
#----------------------------------------------------------------------

namespace eval ::testClock {
    namespace export registry
    set reg \
	[dict create \
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
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







+




+
-
+
+


-
+



-
+

-
-
+
+



+
-
+
+



-
+



-
+

-
-
+
+




+
-
+
+

-
-
+
+













-
+



+
-
+
+



-
+







    }
    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]
}

# START TESTS MARKER
# Base test cases:

# no lazy creation of clock-ensemble (interim, bug [9889f96f4da77e3b], [31fd84270644f67d]),
# so ensemble created implicitely in init.tcl
test clock-0.1 {
test clock-0.1 "initial: auto-loading of ensemble and stubs on demand" -setup {
    initial: auto-loading of ensemble and stubs on demand
} -constraints notclassic -setup {
    set i [interp create]; # because clock can be used somewhere, test it in new interp:
} -body {
    $i eval {
    $i eval [string map [list @clockns@ $clockns] {
	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 ""}]
	lappend ret stubs:[expr {[namespace which -command @clockns@::GetSystemTimeZone] ne ""}]
	clock format now; # clock.tcl stubs expected
	lappend ret stubs:[expr {[namespace which -command ::tcl::clock::GetSystemTimeZone] ne ""}]
    }
	lappend ret stubs:[expr {[namespace which -command @clockns@::GetSystemTimeZone] ne ""}]
    }]
} -cleanup {
    interp delete $i
} -result {ens:1 ens:1 stubs:0 stubs:1}
test clock-0.1a {
test clock-0.1a "initial: safe interpreter shares clock command with parent" -setup {
    initial: safe interpreter shares clock command with parent
} -constraints notclassic  -setup {
    set i [interp create]
    $i eval {set sci [interp create -safe]}
} -body {
    $i eval {
    $i eval [string map [list @clockns@ $clockns] {
	lappend ret ens:[namespace ensemble exists ::clock]
	$sci eval { 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 ""}]
	lappend ret stubs:[expr {[namespace which -command @clockns@::GetSystemTimeZone] ne ""}]
	$sci eval { clock format now }; # clock.tcl stubs expected
	lappend ret stubs:[expr {[namespace which -command ::tcl::clock::GetSystemTimeZone] ne ""}]
    }
	lappend ret stubs:[expr {[namespace which -command @clockns@::GetSystemTimeZone] ne ""}]
    }]
} -cleanup {
    interp delete $i
} -result {ens:1 ens:1 stubs:0 stubs:1}

test clock-0.2 {
test clock-0.2 "initial: loading of format/locale does not overwrite interp state (errorInfo)" -setup {
    initial: loading of format/locale does not overwrite interp state (errorInfo)
} -constraints notclassic -setup {
    # be sure - we have no cached locale/msgcat, etc:
    if {[namespace which -command ::tcl::clock::ClearCaches] ne ""} {
	::tcl::clock::ClearCaches
    if {[namespace which -command ${clockns}::ClearCaches] ne ""} {
	${clockns}::ClearCaches
    }
} -body {
    if {[catch {
	return -level 0 -code error -errorcode {EXPERR TEST-ERROR} -errorinfo "ERROR expected error" test
    }]} {
	clock format now -locale de; # should not overwrite error code/info
	list $::errorCode $::errorInfo
    }
} -result {{EXPERR TEST-ERROR} {ERROR expected error}}

# Test some of the basics of [clock format]

set syntax "clockval|now ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"
test clock-1.0 "clock format - wrong # args" {
test clock-1.0 "clock format - wrong # args" notclassic {
    list [catch {clock format} msg] $msg $::errorCode
} [subst {1 {wrong # args: should be "clock format $syntax"} {CLOCK wrongNumArgs}}]

test clock-1.0.1 {
test clock-1.0.1 "clock format - wrong # args (compiled ensemble with invalid syntax)" {
    clock format - wrong # args (compiled ensemble with invalid syntax)
} notclassic {
    list [catch {clock format 0 -too-few-options-4-test} msg] $msg $::errorCode
} [subst {1 {wrong # args: should be "clock format $syntax"} {CLOCK wrongNumArgs}}]

test clock-1.1 "clock format - bad time" {
test clock-1.1 "clock format - bad time" notclassic {
    list [catch {clock format foo} msg opt] $msg [dict getd $opt -errorcode {}]
} {1 {bad seconds "foo": must be now or integer} {CLOCK badOption 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"}}

363
364
365
366
367
368
369
370

371
372
373
374
375
376

377
378
379
380
381
382
383
376
377
378
379
380
381
382

383
384
385
386
387
388

389
390
391
392
393
394
395
396







-
+





-
+







    clock format 0 -g true -f "%Y-%m-%d"
} 1970-01-01

test clock-1.7.1 "clock format - command abbreviations (compat regression test)" {
    clock f 0 -g 1 -f "%Y-%m-%d"
} 1970-01-01

test clock-1.8 "clock format now" {
test clock-1.8 "clock format now" notclassic {
    # 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" {
test clock-1.9 "clock arguments: option doubly present" notclassic {
    list [catch {clock format 0 -gmt 1 -gmt 0} result] $result
} {1 {bad option "-gmt": doubly present}}

test clock-1.10 {clock format: text with token (bug [a858d95f4bfddafb])} {
    clock format 0 -format text(%d) -gmt 1
} {text(01)}

15381
15382
15383
15384
15385
15386
15387
15388

15389
15390
15391

15392
15393
15394

15395
15396
15397

15398
15399
15400

15401
15402
15403

15404
15405
15406

15407
15408
15409
15410
15411
15412
15413

15414
15415
15416
15417
15418
15419
15420
15394
15395
15396
15397
15398
15399
15400

15401
15402
15403

15404
15405
15406

15407
15408
15409

15410
15411
15412

15413
15414
15415

15416
15417
15418

15419
15420
15421
15422
15423
15424
15425

15426
15427
15428
15429
15430
15431
15432
15433







-
+


-
+


-
+


-
+


-
+


-
+


-
+






-
+







test clock-4.96 { format time of day 23:59:59 } {
    clock format 86399 \
        -format {%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+} \
	  -locale en_US_roman \
        -gmt true
} {23 xxiii 11 xi 23 xxiii 11 xi 59 lix PM pm 11:59:59 pm 23:59 59 lix 23:59:59 23:59:59 xxiii h lix m lix s Thu Jan  1 23:59:59 GMT 1970}

test clock-4.97.1 { format JDN/JD (calendar and astronomical) } {
test clock-4.97.1 { format JDN/JD (calendar and astronomical) } notclassic {
    clock format 0 -format {%J %EJ %Ej} -gmt true
} {2440588 2440588.0 2440587.5}
test clock-4.97.2 { format JDN/JD (calendar and astronomical) } {
test clock-4.97.2 { format JDN/JD (calendar and astronomical) } notclassic {
    clock format 43200 -format {%J %EJ %Ej} -gmt true
} {2440588 2440588.5 2440588.0}
test clock-4.97.3 { format JDN/JD (calendar and astronomical) } {
test clock-4.97.3 { format JDN/JD (calendar and astronomical) } notclassic {
    clock format 86399 -format {%J %EJ %Ej} -gmt true
} {2440588 2440588.99998843 2440588.49998843}
test clock-4.97.4 { format JDN/JD (calendar and astronomical) } {
test clock-4.97.4 { format JDN/JD (calendar and astronomical) } notclassic {
    clock format 86400 -format {%J %EJ %Ej} -gmt true
} {2440589 2440589.0 2440588.5}
test clock-4.97.5 { format JDN/JD (calendar and astronomical) } {
test clock-4.97.5 { format JDN/JD (calendar and astronomical) } notclassic {
    clock format 129599 -format {%J %EJ %Ej} -gmt true
} {2440589 2440589.49998843 2440588.99998843}
test clock-4.97.6 { format JDN/JD (calendar and astronomical) } {
test clock-4.97.6 { format JDN/JD (calendar and astronomical) } notclassic {
    clock format 129600 -format {%J %EJ %Ej} -gmt true
} {2440589 2440589.5 2440589.0}
test clock-4.97.7 { format JDN/JD (calendar and astronomical) } {
test clock-4.97.7 { format JDN/JD (calendar and astronomical) } notclassic {
    set i 1548249092
    list \
	[clock format $i -format {%J %EJ %Ej} -gmt true] \
	[clock format [incr i] -format {%J %EJ %Ej} -gmt true] \
	[clock format [incr i] -format {%J %EJ %Ej} -gmt true]
} {{2458507 2458507.54967593 2458507.04967593} {2458507 2458507.5496875 2458507.0496875} {2458507 2458507.54969907 2458507.04969907}}
test clock-4.97.8 { format JDN/JD (calendar and astronomical) } {
test clock-4.97.8 { format JDN/JD (calendar and astronomical) } notclassic {
    set res {}
    foreach i {
	-172800 -129600 -86400 -43200
	-1 0 1 21600 43199 43200 86399
	86400 86401 108000 129600 172800
    } {
	lappend res $i [clock format [expr {-210866803200 - $i}] \
15435
15436
15437
15438
15439
15440
15441
15442

15443
15444
15445
15446
15447
15448
15449
15448
15449
15450
15451
15452
15453
15454

15455
15456
15457
15458
15459
15460
15461
15462







-
+







     86399 {B.C.E. 4714-12-31 00:00:01 -- -000001 -0.99998843 -1.49998843} \
     86400 {B.C.E. 4714-12-31 00:00:00 -- -000001 -1.0 -1.5} \
     86401 {B.C.E. 4714-12-30 23:59:59 -- -000002 -1.00001157 -1.50001157} \
    108000 {B.C.E. 4714-12-30 18:00:00 -- -000002 -1.25 -1.75} \
    129600 {B.C.E. 4714-12-30 12:00:00 -- -000002 -1.5 -2.0} \
    172800 {B.C.E. 4714-12-30 00:00:00 -- -000002 -2.0 -2.5} \
]
test clock-4.97.9 { format JDN/JD (calendar and astronomical) } {
test clock-4.97.9 { format JDN/JD (calendar and astronomical) } notclassic {
    set res {}
    foreach i {
	-86400 -43200
	-1 0 1
	43199 43200 43201 86400
    } {
	lappend res $i [clock format [expr {653133196800 + $i}] \
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
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
18770







-
+






-
+



















-
+
+


-
+
+








-
+



-
+







    clock scan {2147483648} -format %s -gmt true
} 2147483648

test clock-6.8 {input of seconds} {
    clock scan {9223372036854775807} -format %s -gmt true
} 9223372036854775807

test clock-6.8b "clock scan - bad base" {
test clock-6.8b "clock scan - bad base" notclassic {
    list [catch {clock scan "" -base foo -gmt 1} msg opt] $msg [dict getd $opt -errorcode {}]
} {1 {bad seconds "foo": must be now or integer} {CLOCK badOption foo}}

test clock-6.9 {input of seconds - overflow} {
    list [catch {clock scan -9223372036854775809 -format %s -gmt true} result opt] $result [dict getd $opt -errorcode ""]
} {1 {integer value too large to represent} {CLOCK dateTooLarge}}
test clock-6.10 {input of seconds - overflow} {
test clock-6.10 {input of seconds - overflow} notclassic {
    list [catch {clock scan 9223372036854775808 -format %s -gmt true} result opt] $result [dict getd $opt -errorcode ""]
} {1 {integer value too large to represent} {CLOCK dateTooLarge}}

foreach sign {{} -} {
  test clock-6.10a$sign {input of seconds - overflow, bug [1f40aa83c5]}  {
    list [catch {clock scan ${sign}27670116110564327423 -format %s -gmt true} result opt] $result [dict getd $opt -errorcode ""]
  } {1 {integer value too large to represent} {CLOCK dateTooLarge}}
  test clock-6.10b$sign {input of seconds - overflow, bug [1f40aa83c5]} {
    list [catch {clock scan ${sign}27670116110564327424 -format %s -gmt true} result opt] $result [dict getd $opt -errorcode ""]
  } {1 {integer value too large to represent} {CLOCK dateTooLarge}}
  test clock-6.10c$sign {input of seconds - no overflow, bug [1f40aa83c5]} {
    list [catch {clock scan ${sign}[string repeat 9 18] -format %s -gmt true} result opt] $result [dict getd $opt -errorcode ""]
  } [list 0 ${sign}[string repeat 9 18] {}]
  test clock-6.10d$sign {input of seconds - overflow, bug [1f40aa83c5]} {
    list [catch {clock scan ${sign}[string repeat 9 19] -format %s -gmt true} result opt] $result [dict getd $opt -errorcode ""]
  } {1 {integer value too large to represent} {CLOCK dateTooLarge}}
  # both fololowing freescan test don't generate overflow error,
  # since it is a free scan, thus the token is simply not recognized further in yacc lexer,
  # therefore we get parse error (can be surely changed latter):
  test clock-6.10e$sign {input of seconds - overflow (but since freescan parse error, but not boom), bug [1f40aa83c5]} -body {
  test clock-6.10e$sign {input of seconds - overflow (but since freescan parse error, but not boom), bug [1f40aa83c5]
  } -constraints notclassic -body {
    list [catch {clock scan ${sign}27670116110564327423 -gmt true} result opt] $result [dict getd $opt -errorcode ""]
  } -match glob -result {1 {unable to convert date-time string "*": syntax error *} {TCL VALUE DATE PARSE}}
  test clock-6.10f$sign {input of seconds - overflow (but since freescan parse error, but not boom), bug [1f40aa83c5]} -body {
  test clock-6.10f$sign {input of seconds - overflow (but since freescan parse error, but not boom), bug [1f40aa83c5]
  } -constraints notclassic -body {
    list [catch {clock scan ${sign}27670116110564327424 -gmt true} result opt] $result [dict getd $opt -errorcode ""]
  } -match glob -result {1 {unable to convert date-time string "*": syntax error *} {TCL VALUE DATE PARSE}}
}; unset sign

test clock-6.11 {input of seconds - two values} {
    clock scan {1 2} -format {%s %s} -gmt true
} 2

test clock-6.12.0 {input of short forms of locale token (%b)} {
test clock-6.12.0 {input of short forms of locale token (%b)} notclassic {
    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.12.1 {input of all forms of unambiguous short locale token (%b)} {
test clock-6.12.1 {input of all forms of unambiguous short locale token (%b)} notclassic {
    # find all unambiguous short forms and check it'll be scanned successful and correctly:
    set months {January February March April May June July August September October November December}
    set res {}
    foreach mon $months {
	set i 0
	while {[incr i] < [string length $mon]} {
	    # short month form:
18771
18772
18773
18774
18775
18776
18777
18778

18779
18780
18781
18782

18783
18784
18785
18786
18787
18788
18789
18790
18791
18792
18793
18794
18795
18796
18797

18798
18799
18800
18801
18802
18803
18804

18805
18806
18807
18808
18809
18810
18811
18786
18787
18788
18789
18790
18791
18792

18793
18794
18795
18796

18797
18798
18799
18800
18801
18802
18803
18804
18805
18806
18807
18808
18809
18810
18811

18812
18813
18814
18815
18816
18817
18818

18819
18820
18821
18822
18823
18824
18825
18826







-
+



-
+














-
+






-
+







	    if {$t ne $e} {
		lappend res "unexpected result converting $s, expected \"$e\", got \"$t\""
	    }
	}
    }
    set res
} {}
test clock-6.13 {input of lowercase locale token (%b)} {
test clock-6.13 {input of lowercase locale token (%b)} notclassic {
    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)} {
test clock-6.14 {input of uppercase locale token (%b)} notclassic {
    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)} {
test clock-6.17 {spaces are always optional in non-strict mode (default)} notclassic {
    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} {
test clock-6.18 {zone token (%z) is optional} notclassic {
    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%" }] \
18836
18837
18838
18839
18840
18841
18842
18843

18844
18845
18846
18847


18848
18849
18850


18851
18852
18853

18854
18855
18856

18857
18858
18859
18860

18861
18862
18863
18864


18865
18866
18867
18868
18869
18870
18871
18851
18852
18853
18854
18855
18856
18857

18858
18859
18860
18861

18862
18863
18864
18865

18866
18867
18868
18869

18870
18871
18872

18873
18874
18875
18876

18877
18878
18879
18880

18881
18882
18883
18884
18885
18886
18887
18888
18889







-
+



-
+
+


-
+
+


-
+


-
+



-
+



-
+
+







	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} {
test clock-6.21.0 {Stardate 0 day} notclassic {
    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)} {
test clock-6.21.0.1 {Stardate 0.1 - 1.9 (test negative clock value -> positive Stardate)
} notclassic {
    _testStarDates -757382400 2 0.1
} {}
test clock-6.21.0.2 {Stardate 10000.1 - 10002.9 (test negative clock value -> positive Stardate)} {
test clock-6.21.0.2 {Stardate 10000.1 - 10002.9 (test negative clock value -> positive Stardate)
} notclassic {
    _testStarDates [clock scan "Stardate 10000.1" -f %Q -g 1] 3 0.1
} {}
test clock-6.21.0.3 {Stardate 80000.1 - 80002.9 (test positive clock value)} {
test clock-6.21.0.3 {Stardate 80000.1 - 80002.9 (test positive clock value)} notclassic {
    _testStarDates [clock scan "Stardate 80001.1" -f %Q -g 1] 3 0.1
} {}
test clock-6.21.1 {Stardate} {
test clock-6.21.1 {Stardate} notclassic {
    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} {
test clock-6.21.2 {Stardate next time} notclassic {
    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)} {
test clock-6.21.3 {Stardate correct scan over year (leap year, begin, middle and end of the year)
} notclassic {
    _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}
18998
18999
19000
19001
19002
19003
19004
19005


19006
19007
19008
19009
19010
19011
19012
19013
19014

19015
19016
19017
19018

19019
19020
19021
19022
19023

19024
19025
19026
19027
19028

19029
19030
19031
19032
19033

19034
19035
19036
19037
19038

19039
19040
19041
19042

19043
19044
19045
19046
19047
19048
19049
19050
19051
19052
19053

19054
19055
19056
19057
19058
19059
19060
19061
19062
19063
19064
19065
19066
19067
19068


19069
19070
19071
19072
19073
19074
19075


19076
19077
19078
19079


19080
19081
19082
19083
19084
19085
19086
19016
19017
19018
19019
19020
19021
19022

19023
19024
19025
19026
19027
19028
19029
19030
19031
19032

19033
19034
19035
19036

19037
19038
19039
19040
19041

19042
19043
19044
19045
19046

19047
19048
19049
19050
19051

19052
19053
19054
19055
19056

19057
19058
19059
19060

19061
19062
19063
19064
19065
19066
19067
19068
19069
19070
19071

19072
19073
19074
19075
19076
19077
19078
19079
19080
19081
19082
19083
19084
19085
19086

19087
19088
19089
19090
19091
19092
19093
19094

19095
19096
19097
19098
19099

19100
19101
19102
19103
19104
19105
19106
19107
19108







-
+
+








-
+



-
+




-
+




-
+




-
+




-
+



-
+










-
+














-
+
+






-
+
+



-
+
+







    set J0m24h [scan [clock format $s0m24h -format %J -gmt true] %lld]
    set s0m1s [clock add $s0 -1 seconds -timezone :UTC]
    set J0m1s [scan [clock format $s0m1s -format %J -gmt true] %lld]
    list $s0m1d $s0m24h $J0m24h $s0m1s $J0m1s $s0 $J0 \
	[::tcl::mathop::== $s0m1d $s0m24h] [::tcl::mathop::== $J0m24h $J0m1s]
} [list -210866889600 -210866889600 -1 -210866803201 -1 -210866803200 0 1 1]

test clock-7.11.1 {Calendar vs Astronomical Julian Day (without and with time fraction)} {
test clock-7.11.1 {Calendar vs Astronomical Julian Day (without and with time fraction)
} notclassic {
    list \
	[clock scan {2440588}   -format {%J}  -gmt true] \
	[clock scan {2440588}   -format {%EJ} -gmt true] \
	[clock scan {2440588}   -format {%Ej} -gmt true] \
	[clock scan {2440588.5} -format {%EJ} -gmt true] \
	[clock scan {2440588.5} -format {%Ej} -gmt true] \
} {0 0 43200 43200 86400}

test clock-7.11.2 {Astronomical JDN/JD} {
test clock-7.11.2 {Astronomical JDN/JD} notclassic {
    clock scan 0 -format %Ej -gmt true
} -210866760000

test clock-7.12 {Astronomical JDN/JD} {
test clock-7.12 {Astronomical JDN/JD} notclassic {
    clock format [clock scan 2440587.5 -format %Ej -gmt true] \
	-format "%Y-%m-%d %T" -gmt true
} "1970-01-01 00:00:00"

test clock-7.13 {Astronomical JDN/JD} {
test clock-7.13 {Astronomical JDN/JD} notclassic {
    clock format [clock scan 2451544.5 -format %Ej -gmt true] \
	-format "%Y-%m-%d %T" -gmt true
} "2000-01-01 00:00:00"

test clock-7.13.1 {Astronomical JDN/JD} {
test clock-7.13.1 {Astronomical JDN/JD} notclassic {
    clock format [clock scan 2488069.5 -format %Ej -gmt true] \
	-format "%Y-%m-%d %T" -gmt true
} "2100-01-01 00:00:00"

test clock-7.14 {Astronomical JDN/JD} {
test clock-7.14 {Astronomical JDN/JD} notclassic {
    clock format [clock scan 5373483.5 -format %Ej -gmt true] \
	-format "%Y-%m-%d %T" -gmt true
} "9999-12-31 00:00:00"

test clock-7.14.1 {Astronomical JDN/JD} {
test clock-7.14.1 {Astronomical JDN/JD} notclassic {
    clock format [clock scan 5373484 -format %Ej -gmt true] \
	-format "%Y-%m-%d %T" -gmt true
} "9999-12-31 12:00:00"
test clock-7.14.2 {Astronomical JDN/JD} {
test clock-7.14.2 {Astronomical JDN/JD} notclassic {
    clock format [clock scan 5373484.49999 -format %Ej -gmt true] \
	-format "%Y-%m-%d %T" -gmt true
} "9999-12-31 23:59:59"

test clock-7.15 {Astronomical JDN/JD, bad} {
    list [catch {
	clock scan bogus -format %Ej
    } result] $result $errorCode
} {1 {input string does not match supplied format} {CLOCK badInputString}}

test clock-7.16 {Astronomical JDN/JD, overflow} {
test clock-7.16 {Astronomical JDN/JD, overflow} notclassic {
    list [catch {
	clock scan 5373484.5 -format %Ej
    } result] $result $errorCode \
    [catch {
	clock scan 5373485 -format %Ej
    } result] $result $errorCode \
    [catch {
	clock scan 2147483648 -format %Ej
    } result] $result $errorCode \
    [catch {
	clock scan 2147483648.5 -format %Ej
    } result] $result $errorCode
} [lrepeat 4 1 {requested date too large to represent} {CLOCK dateTooLarge}]

test clock-7.18 {Astronomical JDN/JD, same precedence as seconds (last wins} {
test clock-7.18 {Astronomical JDN/JD, same precedence as seconds (last wins
} notclassic {
    list [clock scan {2440588 86400} -format {%Ej %s} -gmt true] \
	[clock scan {2440589 0} -format {%Ej %s} -gmt true] \
	[clock scan {86400 2440588} -format {%s %Ej} -gmt true] \
	[clock scan {0 2440589} -format {%s %Ej} -gmt true]
} {86400 0 43200 129600}

test clock-7.19 {Astronomical JDN/JD, two values} {
test clock-7.19 {Astronomical JDN/JD, two values
} notclassic {
    clock scan {2440588 2440589} -format {%Ej %Ej} -gmt true
} 129600

test clock-7.20 {all JDN/JD are signed (and extended accept floats)} {
test clock-7.20 {all JDN/JD are signed (and extended accept floats)
} notclassic {
    set res {}
    foreach i {%J %EJ %Ej} {
	lappend res [clock scan "-1" -format $i -gmt 1]
    }
    foreach i {%EJ %Ej} {
	lappend res [clock scan "-1.5" -format $i -gmt 1]
    }
21493
21494
21495
21496
21497
21498
21499
21500

21501
21502
21503
21504

21505


21506
21507
21508
21509
21510
21511


21512
21513
21514
21515
21516
21517
21518
21519
21520
21521
21522
21523
21524
21525
21526
21527
21528
21529
21530
21531
21532
21533
21534
21535
21536
21537
21538
21539
21540
21541
21542
21543
21544
21545
21546
21547
21548
21549
21550
21551
21552
21553
21554
21555
21556
21557
21558
21559
21560
21561
21562

21563


21564
21565

21566


21567
21568

21569


21570
21571
21572
21573
21574
21575
21576
21577
21578
21579
21580
21581
21582
21583
21584
21585
21586

21587


21588
21589

21590


21591
21592

21593


21594
21595
21596
21597
21598
21599
21600
21601

21602


21603
21604

21605


21606
21607
21608
21609
21610
21611
21612
21515
21516
21517
21518
21519
21520
21521

21522
21523
21524
21525
21526
21527

21528
21529
21530
21531
21532
21533
21534

21535
21536
21537
21538
21539
21540




























21541
21542
21543
21544
21545
21546
21547
21548
21549
21550
21551
21552
21553
21554
21555
21556
21557
21558
21559
21560

21561
21562
21563
21564
21565

21566
21567
21568
21569
21570

21571
21572
21573
21574
21575
21576
21577
21578
21579
21580
21581
21582
21583
21584
21585
21586
21587
21588
21589
21590

21591
21592
21593
21594
21595

21596
21597
21598
21599
21600

21601
21602
21603
21604
21605
21606
21607
21608
21609
21610
21611

21612
21613
21614
21615
21616

21617
21618
21619
21620
21621
21622
21623
21624
21625







-
+




+
-
+
+





-
+
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



















+
-
+
+


+
-
+
+


+
-
+
+

















+
-
+
+


+
-
+
+


+
-
+
+








+
-
+
+


+
-
+
+







} 1009756800
# END testcases8

test clock-9.1 {seconds take precedence over ccyymmdd} {
    clock scan {0 20000101} -format {%s %Y%m%d} -gmt true
} 0

test clock-9.2 {Calendar julian day takes precedence over ccyymmdd} {
test clock-9.2 {Calendar julian day takes precedence over ccyymmdd} notclassic {
    list \
	[clock scan {2440588 20000101} -format {%J %Y%m%d} -gmt true] \
	[clock scan {2440588 20000101} -format {%EJ %Y%m%d} -gmt true]
} {0 0}
test clock-9.2.1 {
test clock-9.2.1 {Calendar julian day (with time fraction) takes precedence over date-time} {
    Calendar julian day (with time fraction) takes precedence over date-time
} notclassic {
    list \
	[clock scan {2440588.0 20000101 010203} -format {%EJ %Y%m%d %H%M%S} -gmt true] \
	[clock scan {2440588.5 20000101 010203} -format {%EJ %Y%m%d %H%M%S} -gmt true]

} {0 43200}
test clock-9.3 {Astro julian day takes always precedence over date-time} {
test clock-9.3 {Astro julian day takes always precedence over date-time
} notclassic {
    list \
	[clock scan {2440587.5 20000101 010203} -format {%Ej %Y%m%d %H%M%S} -gmt true] \
	[clock scan {2440588 20000101 010203} -format {%Ej %Y%m%d %H%M%S} -gmt true]
} {0 43200}

# Test parsing of ccyyddd

test clock-10.1 {parse ccyyddd} {
    clock scan {1970 001} -format {%Y %j} -locale en_US_roman -gmt 1
} 0
test clock-10.2 {parse ccyyddd} {
    clock scan {1970 365} -format {%Y %j} -locale en_US_roman -gmt 1
} 31449600
test clock-10.3 {parse ccyyddd} {
    clock scan {1971 001} -format {%Y %j} -locale en_US_roman -gmt 1
} 31536000
test clock-10.4 {parse ccyyddd} {
    clock scan {1971 365} -format {%Y %j} -locale en_US_roman -gmt 1
} 62985600
test clock-10.5 {parse ccyyddd} {
    clock scan {2000 001} -format {%Y %j} -locale en_US_roman -gmt 1
} 946684800
test clock-10.6 {parse ccyyddd} {
    clock scan {2000 365} -format {%Y %j} -locale en_US_roman -gmt 1
} 978134400
test clock-10.7 {parse ccyyddd} {
    clock scan {2001 001} -format {%Y %j} -locale en_US_roman -gmt 1
} 978307200
test clock-10.8 {parse ccyyddd} {
    clock scan {2001 365} -format {%Y %j} -locale en_US_roman -gmt 1
} 1009756800


test clock-10.9 {seconds take precedence over ccyyddd} {
    list [clock scan {0 2000001} -format {%s %Y%j} -gmt true] \
	 [clock scan {2000001 0} -format {%Y%j %s} -gmt true]
} {0 0}
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

if {!$valid_mode} {
    set res {-result 0}
} else {
    set res {-returnCodes error -result "unable to convert input string: ambiguous day"}
}
test clock-11.1 {
test clock-11.1 {precedence of ccyymmdd over ccyyddd} -body {
    precedence of ccyymmdd over ccyyddd
} -constraints notclassic -body {
    clock scan 19700101002 -format %Y%m%d%j -gmt 1
} {*}$res
test clock-11.2 {
test clock-11.2 {precedence of ccyymmdd over ccyyddd} -body {
    precedence of ccyymmdd over ccyyddd
} -constraints notclassic -body {
    clock scan 01197001002 -format %m%Y%d%j -gmt 1
} {*}$res
test clock-11.3 {
test clock-11.3 {precedence of ccyymmdd over ccyyddd} -body {
    precedence of ccyymmdd over ccyyddd
} -constraints notclassic -body {
    clock scan 01197001002 -format %d%Y%m%j -gmt 1
} {*}$res
test clock-11.4 {precedence of ccyymmdd over ccyyddd} -body {
    clock scan 00219700101 -format %j%Y%m%d -gmt 1
} {*}$res
test clock-11.5 {precedence of ccyymmdd over ccyyddd} -body {
    clock scan 19700100201 -format %Y%m%j%d -gmt 1
} {*}$res
test clock-11.6 {precedence of ccyymmdd over ccyyddd} -body {
    clock scan 01197000201 -format %m%Y%j%d -gmt 1
} {*}$res
test clock-11.7 {precedence of ccyymmdd over ccyyddd} -body {
    clock scan 01197000201 -format %d%Y%j%m -gmt 1
} {*}$res
test clock-11.8 {precedence of ccyymmdd over ccyyddd} -body {
    clock scan 00219700101 -format %j%Y%d%m -gmt 1
} {*}$res
test clock-11.9 {
test clock-11.9 {precedence of ccyymmdd over ccyyddd} -body {
    precedence of ccyymmdd over ccyyddd
} -constraints notclassic -body {
    clock scan 19700101002 -format %Y%d%m%j -gmt 1
} {*}$res
test clock-11.10 {
test clock-11.10 {precedence of ccyymmdd over ccyyddd} -body {
    precedence of ccyymmdd over ccyyddd
} -constraints notclassic -body {
    clock scan 01011970002 -format %m%d%Y%j -gmt 1
} {*}$res
test clock-11.11 {
test clock-11.11 {precedence of ccyymmdd over ccyyddd} -body {
    precedence of ccyymmdd over ccyyddd
} -constraints notclassic -body {
    clock scan 01011970002 -format %d%m%Y%j -gmt 1
} {*}$res
test clock-11.12 {precedence of ccyymmdd over ccyyddd} -body {
    clock scan 00201197001 -format %j%m%Y%d -gmt 1
} {*}$res
test clock-11.13 {precedence of ccyymmdd over ccyyddd} -body {
    clock scan 19700100201 -format %Y%d%j%m -gmt 1
} {*}$res
test clock-11.14 {
test clock-11.14 {precedence of ccyymmdd over ccyyddd} -body {
    precedence of ccyymmdd over ccyyddd
} -constraints notclassic -body {
    clock scan 01010021970 -format %m%d%j%Y -gmt 1
} {*}$res
test clock-11.15 {
test clock-11.15 {precedence of ccyymmdd over ccyyddd} -body {
    precedence of ccyymmdd over ccyyddd
} -constraints notclassic -body {
    clock scan 01010021970 -format %d%m%j%Y -gmt 1
} {*}$res
test clock-11.16 {precedence of ccyymmdd over ccyyddd} -body {
    clock scan 00201011970 -format %j%m%d%Y -gmt 1
} {*}$res
test clock-11.17 {precedence of ccyymmdd over ccyyddd} -body {
    clock scan 19700020101 -format %Y%j%m%d -gmt 1
35755
35756
35757
35758
35759
35760
35761
35762

35763
35764
35765
35766
35767

35768
35769
35770
35771
35772

35773
35774
35775
35776
35777

35778
35779
35780
35781
35782

35783
35784
35785
35786
35787
35788
35789
35768
35769
35770
35771
35772
35773
35774

35775
35776
35777
35778
35779

35780
35781
35782
35783
35784

35785
35786
35787
35788
35789

35790
35791
35792
35793
35794

35795
35796
35797
35798
35799
35800
35801
35802







-
+




-
+




-
+




-
+




-
+







    set t [clock scan {2004-10-31 01:00:00 -0400} \
	       -format {%Y-%m-%d %H:%M:%S %z} \
	       -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
    set f1 [clock add $t 3600 seconds -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
} {2004-10-31 01:00:00 -0500}
test clock-30.26 {clock add weekdays} {
test clock-30.26 {clock add weekdays} notclassic {
    set t [clock scan {2013-11-20}] ;# Wednesday
    set f1 [clock add $t 3 weekdays]
    set x1 [clock format $f1 -format {%Y-%m-%d}]
} {2013-11-25}
test clock-30.27 {clock add weekdays starting on Saturday} {
test clock-30.27 {clock add weekdays starting on Saturday} notclassic {
    set t [clock scan {2013-11-23}] ;# Saturday
    set f1 [clock add $t 1 weekday]
    set x1 [clock format $f1 -format {%Y-%m-%d}]
} {2013-11-25}
test clock-30.28 {clock add weekdays starting on Sunday} {
test clock-30.28 {clock add weekdays starting on Sunday} notclassic {
    set t [clock scan {2013-11-24}] ;# Sunday
    set f1 [clock add $t 1 weekday]
    set x1 [clock format $f1 -format {%Y-%m-%d}]
} {2013-11-25}
test clock-30.29 {clock add 0 weekdays starting on a weekend} {
test clock-30.29 {clock add 0 weekdays starting on a weekend} notclassic {
    set t [clock scan {2016-02-27}] ;# Saturday
    set f1 [clock add $t 0 weekdays]
    set x1 [clock format $f1 -format {%Y-%m-%d}]
} {2016-02-27}
test clock-30.30 {clock add weekdays and back} -body {
test clock-30.30 {clock add weekdays and back} -constraints notclassic -body {
    set n [clock seconds]
    # we start on each day of the week
    for {set i 0} {$i < 7} {incr i} {
        set start  [clock add $n $i days]
        set startu [clock format $start -format %u]
        # add 0 - 100 weekdays
        for {set j 0} {$j < 100} {incr j} {
35848
35849
35850
35851
35852
35853
35854
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
35888
35889

35890
35891
35892
35893


35894
35895
35896
35897
35898
35899
35900
35901

35902
35903
35904
35905
35906



35907
35908
35909
35910
35911
35912

35913
35914
35915
35916


35917
35918
35919
35920
35921
35922
35923
35924

35925
35926
35927
35928







































35929
35930
35931
35932
35933
35934
35935
35936
35937

35938
35939
35940

35941
35942
35943

35944
35945

35946
35947
35948
35949
35950
35951
35952
35953

35954
35955
35956

35957
35958

35959
35960
35961

35962
35963
35964
35965


35966
35967
35968
35969
35970
35971
35972
35973
35974

35975
35976
35977

35978
35979
35980

35981
35982
35983

35984
35985
35986
35987
35988
35989
35990

35991
35992
35993
35994
35995
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
36031
36032
36033
36034
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
35888
35889
35890

35891
35892
35893



35894
35895
35896
35897
35898
35899
35900
35901

35902
35903
35904


35905
35906
35907
35908
35909
35910
35911
35912
35913

35914
35915
35916



35917
35918
35919
35920
35921
35922
35923
35924

35925
35926
35927


35928
35929
35930
35931
35932
35933
35934
35935
35936

35937
35938
35939


35940
35941
35942
35943
35944
35945
35946
35947
35948
35949
35950
35951
35952
35953
35954
35955
35956
35957
35958
35959
35960
35961
35962
35963
35964
35965
35966
35967
35968
35969
35970
35971
35972
35973
35974
35975
35976
35977
35978
35979
35980
35981
35982
35983
35984
35985
35986

35987
35988
35989

35990
35991
35992

35993
35994
35995
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
36031
36032

36033
36034
36035
36036
36037
36038
36039

36040





































36041
36042
36043
36044
36045
36046
36047







-
+


-
-
-
+
+
+





-
+


-
-
+
+







-
+


-
-
-
+
+
+





-
+


-
-
+
+







-
+


-
-
-
+
+
+





-
+


-
-
+
+







-
+


-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








-
+


-
+


-
+


+






-
-
+


-
+

-
+


-
+


-
-
+
+








-
+


-
+


-
+


-
+






-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








# END testcases30


test clock-31.1 {system locale} \
    -constraints win \
    -setup {
	namespace eval ::tcl::clock {
	namespace eval $clockns {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	::tcl::clock::ClearCaches
	set noreg [info exists ${clockns}::NoRegistry]
	if {$noreg} {unset ${clockns}::NoRegistry}
	${clockns}::ClearCaches
    } \
    -body {
	clock format 0 -timezone :UTC -locale system -format %x
    } \
    -cleanup {
	namespace eval ::tcl::clock {
	namespace eval ${clockns} {
	    rename registry {}
	}
	if {$noreg} {set ::tcl::clock::NoRegistry {}}
	::tcl::clock::ClearCaches
	if {$noreg} {set ${clockns}::NoRegistry {}}
	${clockns}::ClearCaches
    } \
    -result [clock format 0 -timezone :UTC -locale current \
		 -format {%d-%b-%Y}]

test clock-31.2 {system locale} \
    -constraints win \
    -setup {
	namespace eval ::tcl::clock {
	namespace eval ${clockns} {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	::tcl::clock::ClearCaches
	set noreg [info exists ${clockns}::NoRegistry]
	if {$noreg} {unset ${clockns}::NoRegistry}
	${clockns}::ClearCaches
    } \
    -body {
	clock format 0 -timezone :UTC -locale system -format %Ex
    } \
    -cleanup {
	namespace eval ::tcl::clock {
	namespace eval ${clockns} {
	    rename registry {}
	}
	if {$noreg} {set ::tcl::clock::NoRegistry {}}
	::tcl::clock::ClearCaches
	if {$noreg} {set ${clockns}::NoRegistry {}}
	${clockns}::ClearCaches
    } \
    -result [clock format 0 -timezone :UTC -locale current \
		 -format {the %d' day of %B %Y}]

test clock-31.3 {system locale} \
    -constraints win \
    -setup {
	namespace eval ::tcl::clock {
	namespace eval ${clockns} {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	::tcl::clock::ClearCaches
	set noreg [info exists ${clockns}::NoRegistry]
	if {$noreg} {unset ${clockns}::NoRegistry}
	${clockns}::ClearCaches
    } \
    -body {
	clock format 0 -timezone :UTC -locale system -format %X
    } \
    -cleanup {
	namespace eval ::tcl::clock {
	namespace eval ${clockns} {
	    rename registry {}
	}
	if {$noreg} {set ::tcl::clock::NoRegistry {}}
	::tcl::clock::ClearCaches
	if {$noreg} {set ${clockns}::NoRegistry {}}
	${clockns}::ClearCaches
    } \
    -result [clock format 0 -timezone :UTC -locale current \
		 -format {%l:%M:%S %p}]

test clock-31.4 {system locale} \
    -constraints win \
    -setup {
	namespace eval ::tcl::clock {
	namespace eval ${clockns} {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	set noreg [info exists ${clockns}::NoRegistry]
	if {$noreg} {unset ${clockns}::NoRegistry}
	if { [info exists env(TZ)] } {
	    set oldTZ $env(TZ)
	    unset env(TZ)
	}
	if { [info exists env(TCL_TZ)] } {
	    set oldTclTZ $env(TCL_TZ)
	    unset env(TCL_TZ)
	}
	${clockns}::ClearCaches
    } \
    -body {
	clock format 0 -locale system -format %x
    } \
    -cleanup {
	namespace eval ${clockns} {
	    rename registry {}
	}
	if { [info exists oldTclTZ] } {
	    set env(TCL_TZ) $oldTclTZ
	}
	if { [info exists oldTZ] } {
	    set env(TZ) $oldTZ
	}
	if {$noreg} {set ${clockns}::NoRegistry {}}
	${clockns}::ClearCaches
    } \
    -result [clock format 0 -locale current -timezone EST5 \
		 -format {%d-%b-%Y}]

test clock-31.5 {system locale} \
    -constraints win \
    -setup {
	namespace eval ${clockns} {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ${clockns}::NoRegistry]
	if {$noreg} {unset ${clockns}::NoRegistry}
	if { [info exists env(TZ)] } {
	    set oldTZ $env(TZ)
	    unset env(TZ)
	}
	if { [info exists env(TCL_TZ)] } {
	    set oldTclTZ $env(TCL_TZ)
	    unset env(TCL_TZ)
	}
	::tcl::clock::ClearCaches
	${clockns}::ClearCaches
    } \
    -body {
	clock format 0 -locale system -format %x
	clock format 0 -locale system -format %Ex
    } \
    -cleanup {
	namespace eval ::tcl::clock {
	namespace eval ${clockns} {
	    rename registry {}
	}
	if {$noreg} {set ${clockns}::NoRegistry {}}
	if { [info exists oldTclTZ] } {
	    set env(TCL_TZ) $oldTclTZ
	}
	if { [info exists oldTZ] } {
	    set env(TZ) $oldTZ
	}
	if {$noreg} {set ::tcl::clock::NoRegistry {}}
	::tcl::clock::ClearCaches
	${clockns}::ClearCaches
    } \
    -result [clock format 0 -locale current -timezone EST5 \
		 -format {%d-%b-%Y}]
		 -format {the %d' day of %B %Y}]

test clock-31.5 {system locale} \
test clock-31.6 {system locale} \
    -constraints win \
    -setup {
	namespace eval ::tcl::clock {
	namespace eval ${clockns} {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	set noreg [info exists ${clockns}::NoRegistry]
	if {$noreg} {unset ${clockns}::NoRegistry}
	if { [info exists env(TZ)] } {
	    set oldTZ $env(TZ)
	    unset env(TZ)
	}
	if { [info exists env(TCL_TZ)] } {
	    set oldTclTZ $env(TCL_TZ)
	    unset env(TCL_TZ)
	}
	::tcl::clock::ClearCaches
	${clockns}::ClearCaches
    } \
    -body {
	clock format 0 -locale system -format %Ex
	clock format 0 -locale system -format "%X %Z"
    } \
    -cleanup {
	namespace eval ::tcl::clock {
	namespace eval ${clockns} {
	    rename registry {}
	}
	if {$noreg} {set ::tcl::clock::NoRegistry {}}
	if {$noreg} {set ${clockns}::NoRegistry {}}
	if { [info exists oldTclTZ] } {
	    set env(TCL_TZ) $oldTclTZ
	}
	if { [info exists oldTZ] } {
	    set env(TZ) $oldTZ
	}
	::tcl::clock::ClearCaches
	${clockns}::ClearCaches
    } \
    -result [clock format 0 -locale current -timezone EST5 \
		 -format {the %d' day of %B %Y}]

test clock-31.6 {system locale} \
    -constraints win \
    -setup {
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	if { [info exists env(TZ)] } {
	    set oldTZ $env(TZ)
	    unset env(TZ)
	}
	if { [info exists env(TCL_TZ)] } {
	    set oldTclTZ $env(TCL_TZ)
	    unset env(TCL_TZ)
	}
	::tcl::clock::ClearCaches
    } \
    -body {
	clock format 0 -locale system -format "%X %Z"
    } \
    -cleanup {
	namespace eval ::tcl::clock {
	    rename registry {}
	}
	if {$noreg} {set ::tcl::clock::NoRegistry {}}
	if { [info exists oldTclTZ] } {
	    set env(TCL_TZ) $oldTclTZ
	}
	if { [info exists oldTZ] } {
	    set env(TZ) $oldTZ
	}
	::tcl::clock::ClearCaches
    } \
    -result [clock format 0 -locale current -timezone EST5 \
		 -format {%l:%M:%S %p %Z}]

test clock-32.1 {scan/format across the Gregorian change} {
    set problems {}
    set t [expr { wide(-6857395200) }]
36214
36215
36216
36217
36218
36219
36220
36221

36222
36223
36224
36225
36226
36227
36228
36227
36228
36229
36230
36231
36232
36233

36234
36235
36236
36237
36238
36239
36240
36241







-
+







	set t1 $t3
    }
    expr { $t2 / 1000 == $t3 }
} {1}

# clock scan
set syntax "clock scan string ?-base seconds? ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE? ?-validate boolean?"
test clock-34.1 {clock scan tests} {
test clock-34.1 {clock scan tests} notclassic {
    list [catch {clock scan} msg] $msg
} [subst {1 {wrong # args: should be "$syntax"}}]
test clock-34.2 {clock scan tests} {*}{
    -body {clock scan "bad-string"}
    -returnCodes error
    -match glob
    -result {unable to convert date-time string "bad-string"*}
36248
36249
36250
36251
36252
36253
36254
36255

36256
36257
36258
36259
36260
36261
36262
36263

36264
36265
36266
36267
36268
36269
36270

36271
36272
36273
36274
36275
36276
36277
36261
36262
36263
36264
36265
36266
36267

36268
36269
36270
36271
36272
36273
36274
36275

36276
36277
36278
36279
36280
36281
36282

36283
36284
36285
36286
36287
36288
36289
36290







-
+







-
+






-
+







    set time [clock scan "Oct 23,1992 15:00 GMT"]
    clock format $time -format {%b %d,%Y %H:%M GMT} -gmt true
} {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} {
test clock-34.9 {clock scan tests} notclassic {
    list [catch {clock scan "Jan 12" -bad arg} msg] $msg
} [subst {1 {bad option "-bad": must be -base, -format, -gmt, -locale, -timezone or -validate}}]
# 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} {
test clock-34.11 {clock scan tests} notclassic {
    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} {
test clock-34.11.2 {clock scan tests: same century switch} notclassic {
    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"  -gmt true]
36286
36287
36288
36289
36290
36291
36292
36293

36294
36295
36296

36297


36298
36299
36300

36301


36302
36303
36304
36305
36306
36307
36308
36299
36300
36301
36302
36303
36304
36305

36306
36307
36308
36309
36310

36311
36312
36313
36314
36315
36316

36317
36318
36319
36320
36321
36322
36323
36324
36325







-
+



+
-
+
+



+
-
+
+







    set time [clock scan "1992-10-23" -gmt true]
    clock format $time -format {%b %d, %Y} -gmt true
} "Oct 23, 1992"
test clock-34.15 {clock scan, DD-Mon-YYYY format} {
    set time [clock scan "23-Oct-1992" -gmt true]
    clock format $time -format {%b %d, %Y} -gmt true
} "Oct 23, 1992"
test clock-34.16 {clock scan, ISO 8601 point in time format} {
test clock-34.16 {clock scan, ISO 8601 point in time format} notclassic {
    set time [clock scan "19921023T235959" -gmt true]
    clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true
} "Oct 23, 1992 23:59:59"
test clock-34.16.1a {
test clock-34.16.1a {clock scan, ISO 8601 T literal optional (YYYYMMDDhhmmss)} {
    clock scan, ISO 8601 T literal optional (YYYYMMDDhhmmss)
} notclassic {
    set time [clock scan "19921023235959" -gmt true]
    clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true
} "Oct 23, 1992 23:59:59"
test clock-34.16.1b {
test clock-34.16.1b {clock scan, ISO 8601 T literal optional (YYYYMMDDhhmm)} {
    clock scan, ISO 8601 T literal optional (YYYYMMDDhhmm)
} notclassic {
    set time [clock scan "199210232359" -gmt true]
    clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true
} "Oct 23, 1992 23:59:00"
test clock-34.16.2 {clock scan, ISO 8601 extended date time} {
    set time [clock scan "1992-10-23T23:59:59" -gmt true]
    clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true
} "Oct 23, 1992 23:59:59"
36318
36319
36320
36321
36322
36323
36324

36325


36326
36327
36328
36329
36330
36331
36332
36333

36334


36335
36336
36337
36338
36339
36340
36341
36342
36343
36344
36345
36346
36347
36348
36349
36350
36351
36352
36353
36354

36355


36356
36357
36358
36359
36360
36361
36362
36335
36336
36337
36338
36339
36340
36341
36342

36343
36344
36345
36346
36347
36348
36349
36350
36351
36352
36353

36354
36355
36356
36357
36358
36359
36360
36361
36362
36363
36364
36365
36366
36367
36368
36369
36370
36371
36372
36373
36374
36375
36376

36377
36378
36379
36380
36381
36382
36383
36384
36385







+
-
+
+








+
-
+
+




















+
-
+
+







    set time [clock scan "1992-10-23T23:59:59" -gmt true]
    clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true
} "Oct 23, 1992 23:59:59"
test clock-34.17.2c {clock scan, ISO 8601 extended date time (YYYY-MM-DD hh:mm)} {
    set time [clock scan "1992-10-23 23:59" -gmt true]
    clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true
} "Oct 23, 1992 23:59:00"
test clock-34.17.2d {
test clock-34.17.2d {clock scan, ISO 8601 extended date time (YYYY-MM-DDThh:mm)} {
    clock scan, ISO 8601 extended date time (YYYY-MM-DDThh:mm)
} notclassic {
    set time [clock scan "1992-10-23T23:59" -gmt true]
    clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true
} "Oct 23, 1992 23:59:00"
test clock-34.17.3 {clock scan, TZ-word boundaries - Z is not TZ here } -body {
    set time [clock scan "1992-10-23Z23:59:59" -gmt true]
    clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true
} -returnCodes error -match glob \
  -result {unable to convert date-time string*}
test clock-34.17.4 {
test clock-34.17.4 {clock scan, TZ-word boundaries - Z is TZ UTC here} {
    clock scan, TZ-word boundaries - Z is TZ UTC here
} notclassic {
    set time [clock scan "1992-10-23 Z 23:59:59" -gmt true]
    clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true
} "Oct 23, 1992 23:59:59"
test clock-34.17.5 {clock scan, ISO 8601 extended date time with UTC TZ} {
    set time [clock scan "1992-10-23T23:59:59Z" -timezone :America/Detroit]
    clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true
} "Oct 23, 1992 23:59:59"
test clock-34.18 {clock scan, ISO 8601 point in time format} {
    set time [clock scan "19921023T000000" -gmt true]
    clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true
} "Oct 23, 1992 00:00:00"
test clock-34.18.2 {clock scan, ISO 8601 extended date time} {
    set time [clock scan "1992-10-23T00:00:00" -gmt true]
    clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true
} "Oct 23, 1992 00:00:00"
test clock-34.18.3 {clock scan, TZ-word boundaries - Z is not TZ here } -body {
    set time [clock scan "1992-10-23Z00:00:00" -gmt true]
    clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true
} -returnCodes error -match glob \
  -result {unable to convert date-time string*}
test clock-34.18.4 {
test clock-34.18.4 {clock scan, TZ-word boundaries - Z is TZ UTC here} {
    clock scan, TZ-word boundaries - Z is TZ UTC here
} notclassic {
    set time [clock scan "1992-10-23 Z 00:00:00" -gmt true]
    clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true
} "Oct 23, 1992 00:00:00"
test clock-34.18.5 {clock scan, ISO 8601 extended date time with UTC TZ} {
    set time [clock scan "1992-10-23T00:00:00Z" -timezone :America/Detroit]
    clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true
} "Oct 23, 1992 00:00:00"
36397
36398
36399
36400
36401
36402
36403
36404

36405
36406
36407
36408
36409

36410
36411
36412
36413
36414

36415
36416
36417
36418
36419

36420
36421
36422
36423

36424
36425
36426
36427
36428

36429
36430
36431
36432
36433
36434

36435
36436
36437
36438
36439
36440
36441
36442
36443
36444
36445
36446
36447
36448
36449
36450
36451
36452
36453
36454

36455
36456
36457
36458
36459
36460
36461
36420
36421
36422
36423
36424
36425
36426

36427
36428
36429
36430
36431

36432
36433
36434
36435
36436

36437
36438
36439
36440
36441

36442
36443
36444
36445

36446
36447
36448
36449
36450

36451
36452
36453
36454
36455
36456

36457
36458
36459
36460
36461
36462
36463
36464
36465
36466
36467
36468
36469
36470
36471
36472
36473
36474
36475
36476

36477
36478
36479
36480
36481
36482
36483
36484







-
+




-
+




-
+




-
+



-
+




-
+





-
+



















-
+







    set time [clock scan "10:59 pm CET" -base 2000000 -gmt true]
    clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
} {Jan 24,1970 21:59:00 GMT}
test clock-34.20.10 {clock scan tests (merid and TZ)} {
    set time [clock scan "10:59 pm +0100" -base 2000000 -gmt true]
    clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
} {Jan 24,1970 21:59:00 GMT}
test clock-34.20.11 {clock scan tests (complex TZ)} {
test clock-34.20.11 {clock scan tests (complex TZ)} notclassic {
    list [clock scan "GMT+1000" -base 100000000 -gmt 1] \
	 [clock scan "GMT+10" -base 100000000 -gmt 1] \
	 [clock scan "+1000" -base 100000000 -gmt 1]
} [lrepeat 3 99964000]
test clock-34.20.12 {clock scan tests (complex TZ)} {
test clock-34.20.12 {clock scan tests (complex TZ)} notclassic {
    list [clock scan "GMT-1000" -base 100000000 -gmt 1] \
	 [clock scan "GMT-10" -base 100000000 -gmt 1] \
	 [clock scan "-1000" -base 100000000 -gmt 1]
} [lrepeat 3 100036000]
test clock-34.20.13 {clock scan tests (complex TZ)} {
test clock-34.20.13 {clock scan tests (complex TZ)} notclassic {
    list [clock scan "GMT-0000" -base 100000000 -gmt 1] \
	 [clock scan "GMT+0000" -base 100000000 -gmt 1] \
	 [clock scan "GMT" -base 100000000 -gmt 1]
} [lrepeat 3 100000000]
test clock-34.20.14 {clock scan tests (complex TZ)} {
test clock-34.20.14 {clock scan tests (complex TZ)} notclassic {
    list [clock scan "CET+1000" -base 100000000 -gmt 1] \
	 [clock scan "CET-1000" -base 100000000 -gmt 1]
} {99960400 100032400}
test clock-34.20.15 {clock scan tests (complex TZ)} {
test clock-34.20.15 {clock scan tests (complex TZ)} notclassic {
    list [clock scan "CET-0000" -base 100000000 -gmt 1] \
	 [clock scan "CET+0000" -base 100000000 -gmt 1] \
	 [clock scan "CET" -base 100000000 -gmt 1]
} [lrepeat 3 99996400]
test clock-34.20.16 {clock scan tests (complex TZ)} {
test clock-34.20.16 {clock scan tests (complex TZ)} notclassic {
    list [clock format [clock scan "00:00 GMT+1000" -base 100000000 -gmt 1] -gmt 1] \
	 [clock format [clock scan "00:00 GMT+10" -base 100000000 -gmt 1] -gmt 1] \
	 [clock format [clock scan "00:00 +1000" -base 100000000 -gmt 1] -gmt 1] \
	 [clock format [clock scan "00:00" -base 100000000 -timezone +1000] -gmt 1]
} [lrepeat 4 "Fri Mar 02 14:00:00 GMT 1973"]
test clock-34.20.17 {clock scan tests (complex TZ)} {
test clock-34.20.17 {clock scan tests (complex TZ)} notclassic {
    list [clock format [clock scan "00:00 GMT+0100" -base 100000000 -gmt 1] -gmt 1] \
	 [clock format [clock scan "00:00 GMT+01" -base 100000000 -gmt 1] -gmt 1] \
	 [clock format [clock scan "00:00 GMT+1" -base 100000000 -gmt 1] -gmt 1] \
	 [clock format [clock scan "00:00" -base 100000000 -timezone +0100] -gmt 1]
} [lrepeat 4 "Fri Mar 02 23:00:00 GMT 1973"]
test clock-34.20.18 {clock scan tests (no TZ)} {
    list [clock scan "1000days" -base 100000000 -gmt 1] \
	 [clock scan "1000 days" -base 100000000 -gmt 1] \
	 [clock scan "+1000days" -base 100000000 -gmt 1] \
	 [clock scan "+1000 days" -base 100000000 -gmt 1] \
	 [clock scan "GMT +1000 days" -base 100000000 -gmt 1] \
	 [clock scan "00:00 GMT +1000 days" -base 100000000 -gmt 1]
} [lrepeat 6 186364800]
test clock-34.20.19 {clock scan tests (no TZ)} {
    list [clock scan "-1000days" -base 100000000 -gmt 1] \
	 [clock scan "-1000 days" -base 100000000 -gmt 1] \
	 [clock scan "GMT -1000days" -base 100000000 -gmt 1] \
	 [clock scan "00:00 GMT -1000 days" -base 100000000 -gmt 1] \
} [lrepeat 4 13564800]
test clock-34.20.20 {clock scan tests (TZ, TZ + 1day)} {
test clock-34.20.20 {clock scan tests (TZ, TZ + 1day)} notclassic {
    clock scan "00:00 GMT+1000 day" -base 100000000 -gmt 1
} 100015200
test clock-34.20.21 {clock scan tests (local date of base depends on given TZ, time apllied to different day)} {
    list [clock scan "23:59:59 -0100" -base 0 -timezone :CET] \
	 [clock scan "23:59:59 -0100" -base 0 -gmt 1] \
	 [clock scan "23:59:59 -0100" -base 0 -timezone -1400] \
	 [clock scan "23:59:59 -0100" -base 0 -timezone :Pacific/Apia]
36558
36559
36560
36561
36562
36563
36564

36565


36566
36567
36568
36569
36570
36571

36572


36573
36574
36575
36576
36577
36578
36579
36581
36582
36583
36584
36585
36586
36587
36588

36589
36590
36591
36592
36593
36594
36595
36596
36597

36598
36599
36600
36601
36602
36603
36604
36605
36606







+
-
+
+






+
-
+
+







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 {
test clock-34.40.2 {clock scan, ordinal month after relative date} {
    clock scan, ordinal month after relative date
} notclassic {
    # 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 {
test clock-34.40.3 {clock scan, day of week after ordinal date} {
    clock scan, day of week after ordinal date
} notclassic {
    # 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"

36746
36747
36748
36749
36750
36751
36752

36753


36754
36755
36756
36757
36758
36759
36760
36773
36774
36775
36776
36777
36778
36779
36780

36781
36782
36783
36784
36785
36786
36787
36788
36789







+
-
+
+







    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.69.4 {
test clock-34.69.4 {relative time with month & day increment / daylight switch} {
    relative time with month & day increment / daylight switch
} notclassic {
    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}}
36816
36817
36818
36819
36820
36821
36822
36823

36824
36825

36826
36827
36828
36829
36830
36831
36832
36845
36846
36847
36848
36849
36850
36851

36852
36853

36854
36855
36856
36857
36858
36859
36860
36861







-
+

-
+







} {}] \n]

# clock seconds
test clock-35.1 {clock seconds tests} {
    expr {[clock seconds] + 1}
    concat {}
} {}
test clock-35.2 {clock seconds tests} {
test clock-35.2 {clock seconds tests} -body {
    list [catch {clock seconds foo} msg] $msg
} {1 {wrong # args: should be "clock seconds"}}
} -match glob -result {1 {wrong # args: should be "* seconds"}}
test clock-35.3 {clock seconds tests} {
    set start [clock seconds]
    after 2000
    set end [clock seconds]
    expr {$end > $start}
} {1}

36850
36851
36852
36853
36854
36855
36856
36857

36858
36859
36860
36861
36862
36863
36864
36865
36866

36867
36868
36869
36870
36871
36872
36873
36879
36880
36881
36882
36883
36884
36885

36886
36887
36888
36889
36890
36891
36892
36893
36894

36895
36896
36897
36898
36899
36900
36901
36902







-
+








-
+







    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} {
test clock-37.2 {%Es gmt testing CET} notclassic {
    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} {
test clock-37.3 {%Es gmt testing CEST} notclassic {
    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}]
37051
37052
37053
37054
37055
37056
37057

37058
37059


37060
37061
37062
37063
37064
37065
37066
37080
37081
37082
37083
37084
37085
37086
37087


37088
37089
37090
37091
37092
37093
37094
37095
37096







+
-
-
+
+








test clock-44.3 {regression test - spaces between some scan tokens are optional (TCL_CLOCK_FULL_COMPAT, no-strict only)} \
    -body {
	list [clock scan {9 Apr 2024} -format {%d %b%Y} -gmt 1] \
	     [clock scan {Tue, 9 Apr 2024 00:00:00 +0000} -format {%a, %d %b%Y %H:%M:%S %Z} -gmt 1]
    } \
    -result {1712620800 1712620800}
test clock-44.4 {
test clock-44.4 {regression test - spaces between all scan tokens are optional (TCL_CLOCK_FULL_COMPAT, no-strict only)} \
    -body {
    regression test - spaces between all scan tokens are optional (TCL_CLOCK_FULL_COMPAT, no-strict only)
} -constraints notclassic -body {
	list [clock scan {9 Apr 2024} -format {%d%b%Y} -gmt 1] \
	     [clock scan {Tue, 9 Apr 2024 00:00:00 +0000} -format {%a,%d%b%Y%H:%M:%S%Z} -gmt 1]
    } \
    -result {1712620800 1712620800}

test clock-45.1 {compat: scan regression on spaces (multiple spaces in format)} \
    -body {
37099
37100
37101
37102
37103
37104
37105
37106

37107
37108
37109
37110
37111
37112
37113
37114
37115
37116
37117

37118
37119
37120
37121
37122
37123
37124
37129
37130
37131
37132
37133
37134
37135

37136
37137
37138
37139
37140
37141
37142
37143
37144
37145
37146

37147
37148
37149
37150
37151
37152
37153
37154







-
+










-
+







test clock-45.4 {compat: scan regression on spaces (mandatory leading/trailing spaces in format)} \
    -body {
	list \
	    [catch {clock scan "11 1 120" -format "%y%m%d %H%M%S " -gmt 1} ret] $ret \
	    [catch {clock scan "11 1 120" -format " %y%m%d %H%M%S" -gmt 1} ret] $ret \
	    [catch {clock scan "11 1 120" -format " %y%m%d %H%M%S " -gmt 1} ret] $ret
    } -result [lrepeat 3 1 "input string does not match supplied format"]
test clock-45.5 {regression test - freescan no int overflow} {
test clock-45.5 {regression test - freescan no int overflow} notclassic {
    # note that the relative date changes currently reset the time to 00:00,
    # this can be changed later (simply achievable by adding 00:00 if expected):
    list \
	[clock scan "+24856 days" -base 1600000000 -gmt 1] \
	[clock scan "+815 months" -base 1600000000 -gmt 1] \
	[clock scan "+69 years" -base 1600000000 -gmt 1] \
	[clock scan "+596524 hours" -base 1600000000 -gmt 1] \
	[clock scan "+35791395 minutes" -base 1600000000 -gmt 1] \
	[clock scan "+2147483647 seconds" -base 1600000000 -gmt 1]
} {3747513600 3743193600 3777408000 3747486400 3747483700 3747483647}
test clock-45.6 {regression test - freescan no int overflow} {
test clock-45.6 {regression test - freescan no int overflow} notclassic {
    # note that the relative date changes currently reset the time to 00:00,
    # this can be changed later (simply achievable by adding 00:00 if expected):
    list \
	[clock scan "-24856 days" -base 2177452800 -gmt 1] \
	[clock scan "-815 months" -base 2177452800 -gmt 1] \
	[clock scan "-69 years" -base 2177452800 -gmt 1] \
	[clock scan "-596524 hours" -base 2177452800 -gmt 1] \
37145
37146
37147
37148
37149
37150
37151

37152


37153
37154
37155
37156
37157
37158
37159
37160
37161
37162
37163
37164

37165



37166
37167
37168
37169
37170
37171
37172
37175
37176
37177
37178
37179
37180
37181
37182

37183
37184
37185
37186
37187
37188
37189
37190
37191
37192
37193
37194
37195
37196
37197

37198
37199
37200
37201
37202
37203
37204
37205
37206
37207







+
-
+
+












+
-
+
+
+








test clock-46.5 {regression test - good time} \
    -body {
	# 12:01 apm are valid input strings...
	list [clock scan "12:01 am" -base 0 -gmt 1] \
	     [clock scan "12:01 pm" -base 0 -gmt 1]
    } -result {60 43260}
test clock-46.6 {
test clock-46.6 {freescan: regression test - bad time} -constraints valid_off \
    freescan: regression test - bad time
} -constraints {notclassic valid_off} \
    -body {
	# 13:00 am/pm are invalid input strings...
	list [clock scan "13:00 am" -base 0 -gmt 1] \
	     [clock scan "13:00 pm" -base 0 -gmt 1]
    } -result {3600 46800}

if {!$valid_mode} {
  test clock-46.7a {regression test - switch day by large not-valid time, see bug [3ee8f1c2a785f4d8]} {valid_off} {
    list [clock scan 23:59:59 -base 0 -gmt 1 -format %H:%M:%S] \
	 [clock scan 24:00:00 -base 0 -gmt 1 -format %H:%M:%S] \
	 [clock scan 48:00:00 -base 0 -gmt 1 -format %H:%M:%S]
  } {86399 86400 172800}
  test clock-46.7b {
  test clock-46.7b {freescan: regression test - switch day by large not-valid time, see bug [3ee8f1c2a785f4d8]} {valid_off} {
    freescan: regression test - switch day by large not-valid time, see bug
    [3ee8f1c2a785f4d8]
} {notclassic valid_off} {
    list [clock scan 23:59:59 -base 0 -gmt 1] \
	 [clock scan 24:00:00 -base 0 -gmt 1] \
	 [clock scan 48:00:00 -base 0 -gmt 1]
  } {86399 86400 172800}
} else {
  test clock-46.8a {regression test - invalid time (hour)} {
    list [catch {clock scan 24:00:00 -base 0 -gmt 1 -format %H:%M:%S} msg] $msg \
37195
37196
37197
37198
37199
37200
37201
37202

37203
37204
37205
37206
37207

37208
37209
37210
37211
37212

37213
37214
37215
37216
37217

37218
37219
37220
37221

37222
37223
37224
37225

37226
37227
37228
37229

37230
37231
37232

37233
37234
37235
37236
37237
37238
37239
37240
37241
37242
37243

37244
37245


37246
37247
37248
37249
37250
37251

37252
37253


37254
37255
37256
37257
37258
37259

37260
37261


37262
37263
37264
37265
37266
37267

37268
37269


37270
37271
37272
37273
37274
37275
37276
37230
37231
37232
37233
37234
37235
37236

37237
37238
37239
37240
37241

37242
37243
37244
37245
37246

37247
37248
37249
37250
37251

37252
37253
37254
37255

37256
37257
37258
37259

37260
37261
37262
37263

37264
37265
37266

37267
37268
37269
37270
37271
37272
37273
37274
37275
37276
37277
37278
37279


37280
37281
37282
37283
37284
37285
37286
37287
37288


37289
37290
37291
37292
37293
37294
37295
37296
37297


37298
37299
37300
37301
37302
37303
37304
37305
37306


37307
37308
37309
37310
37311
37312
37313
37314
37315







-
+




-
+




-
+




-
+



-
+



-
+



-
+


-
+











+
-
-
+
+






+
-
-
+
+






+
-
-
+
+






+
-
-
+
+







	}
    }
    set res
}
# test without and with relative offsets:
foreach {idx relstr} {"" "" "+rel" "+ 15 month + 40 days + 30 hours + 80 minutes +9999 seconds"} {
test clock-46.10$idx {freescan: validation rules: invalid time} \
    -body {
    -constraints notclassic -body {
	# 13:00 am/pm are invalid input strings...
	_invalid_test {} {} "13:00 am$relstr" "13:00 pm$relstr"
    } -result [lrepeat 10 1 {unable to convert input string: invalid time (hour)}]
test clock-46.11$idx {freescan: validation rules: invalid time} \
    -body {
    -constraints notclassic -body {
	# invalid minutes in input strings...
	_invalid_test {} {} "23:70$relstr" "11:80 pm$relstr"
    } -result [lrepeat 10 1 {unable to convert input string: invalid time (minutes)}]
test clock-46.12$idx {freescan: validation rules: invalid time} \
    -body {
    -constraints notclassic -body {
	# invalid seconds in input strings...
	_invalid_test {} {} "23:00:70$relstr" "11:00:80 pm$relstr"
    } -result [lrepeat 10 1 {unable to convert input string: invalid time}]
test clock-46.13$idx {freescan: validation rules: invalid day} \
    -body {
    -constraints notclassic -body {
	_invalid_test {} {} "29 Feb 2017$relstr" "30 Feb 2016$relstr"
    } -result [lrepeat 10 1 {unable to convert input string: invalid day}]
test clock-46.14$idx {freescan: validation rules: invalid day} \
    -body {
    -constraints notclassic -body {
	_invalid_test {} {} "0 Feb 2017$relstr" "00 Feb 2017$relstr"
    } -result [lrepeat 10 1 {unable to convert input string: invalid day}]
test clock-46.15$idx {freescan: validation rules: invalid month} \
    -body {
    -constraints notclassic -body {
	_invalid_test {} {} "13/13/2017$relstr" "00/00/2017$relstr"
    } -result [lrepeat 10 1 {unable to convert input string: invalid month}]
test clock-46.16$idx {freescan: validation rules: invalid day of week} \
    -body {
    -constraints notclassic -body {
	_invalid_test {} {} "Sat Jan 02 00:00:00 1970$relstr" "Thu Jan 04 00:00:00 1970$relstr"
    } -result [lrepeat 10 1 {unable to convert input string: invalid day of week}]
test clock-46.17$idx {scan: validation rules: invalid year} -setup {
test clock-46.17$idx {scan: validation rules: invalid year} -constraints notclassic -setup {
	set orgcfg [list -min-year [::tcl::unsupported::clock::configure -min-year] -max-year [::tcl::unsupported::clock::configure -max-year] \
	     -year-century [::tcl::unsupported::clock::configure -year-century] -century-switch [::tcl::unsupported::clock::configure -century-switch]]
	::tcl::unsupported::clock::configure -min-year 2000 -max-year 2100 -year-century 2000 -century-switch 38
    } -body {
	_invalid_test {} {} "70-01-01$relstr" "1870-01-01$relstr" "9570-01-01$relstr"
    } -result [lrepeat 15 1 {unable to convert input string: invalid year}] -cleanup {
	::tcl::unsupported::clock::configure {*}$orgcfg
	unset -nocomplain orgcfg
    }

}; # foreach
test clock-46.16-pos-fs {
test clock-46.16-pos-fs {freescan: validation rules: valid day of week (must work for all weekdays)} \
    -body {
    freescan: validation rules: valid day of week (must work for all weekdays)
} -constraints notclassic -body {
	_invalid_test {:GMT -12:00 +12:00} {} {Sat, 01 Jan 2000 00:00:00} {Sun, 02 Jan 2000 00:00:00} {Mon, 03 Jan 2000 00:00:00} {Tue, 04 Jan 2000 00:00:00} {Wed, 05 Jan 2000 00:00:00} {Thu, 06 Jan 2000 00:00:00} {Fri, 07 Jan 2000 00:00:00}
    } -result [list \
	0 946684800 0 946771200 0 946857600 0 946944000 0 947030400 0 947116800 0 947203200 \
	0 946728000 0 946814400 0 946900800 0 946987200 0 947073600 0 947160000 0 947246400 \
	0 946641600 0 946728000 0 946814400 0 946900800 0 946987200 0 947073600 0 947160000 \
    ]
test clock-46.16-pos-fmt1 {
test clock-46.16-pos-fmt1 {scan with format: validation rules: valid day of week (must work for all weekdays)} \
    -body {
    scan with format: validation rules: valid day of week (must work for all weekdays)
} -constraints notclassic -body {
	_invalid_test {:GMT -12:00 +12:00} {-format "%a, %d %b %Y %H:%M:%S"} {Sat, 01 Jan 2000 00:00:00} {Sun, 02 Jan 2000 00:00:00} {Mon, 03 Jan 2000 00:00:00} {Tue, 04 Jan 2000 00:00:00} {Wed, 05 Jan 2000 00:00:00} {Thu, 06 Jan 2000 00:00:00} {Fri, 07 Jan 2000 00:00:00}
    } -result [list \
	0 946684800 0 946771200 0 946857600 0 946944000 0 947030400 0 947116800 0 947203200 \
	0 946728000 0 946814400 0 946900800 0 946987200 0 947073600 0 947160000 0 947246400 \
	0 946641600 0 946728000 0 946814400 0 946900800 0 946987200 0 947073600 0 947160000 \
    ]
test clock-46.16-pos-fmt2 {
test clock-46.16-pos-fmt2 {scan with format: validation rules: valid day of week (must work for all weekdays)} \
    -body {
    scan with format: validation rules: valid day of week (must work for all weekdays)
} -constraints notclassic -body {
	_invalid_test {:GMT -12:00 +12:00} {-format "%u, %d %b %Y %H:%M:%S"} {6, 01 Jan 2000 00:00:00} {7, 02 Jan 2000 00:00:00} {1, 03 Jan 2000 00:00:00} {2, 04 Jan 2000 00:00:00} {3, 05 Jan 2000 00:00:00} {4, 06 Jan 2000 00:00:00} {5, 07 Jan 2000 00:00:00}
    } -result [list \
	0 946684800 0 946771200 0 946857600 0 946944000 0 947030400 0 947116800 0 947203200 \
	0 946728000 0 946814400 0 946900800 0 946987200 0 947073600 0 947160000 0 947246400 \
	0 946641600 0 946728000 0 946814400 0 946900800 0 946987200 0 947073600 0 947160000 \
    ]
test clock-46.16-pos-fmt3 {
test clock-46.16-pos-fmt3 {scan with format: validation rules: valid day of week (must work for all weekdays)} \
    -body {
    scan with format: validation rules: valid day of week (must work for all weekdays)
} -constraints notclassic -body {
	_invalid_test {:GMT -12:00 +12:00} {-format "%w, %d %b %Y %H:%M:%S"} {6, 01 Jan 2000 00:00:00} {0, 02 Jan 2000 00:00:00} {1, 03 Jan 2000 00:00:00} {2, 04 Jan 2000 00:00:00} {3, 05 Jan 2000 00:00:00} {4, 06 Jan 2000 00:00:00} {5, 07 Jan 2000 00:00:00}
    } -result [list \
	0 946684800 0 946771200 0 946857600 0 946944000 0 947030400 0 947116800 0 947203200 \
	0 946728000 0 946814400 0 946900800 0 946987200 0 947073600 0 947160000 0 947246400 \
	0 946641600 0 946728000 0 946814400 0 946900800 0 946987200 0 947073600 0 947160000 \
    ]
rename _invalid_test {}
37286
37287
37288
37289
37290
37291
37292

37293
37294


37295
37296
37297
37298
37299
37300
37301
37325
37326
37327
37328
37329
37330
37331
37332


37333
37334
37335
37336
37337
37338
37339
37340
37341







+
-
-
+
+







    {":America/New_York"
	"2017-03-12 01:59:59" "2017-03-12 02:00:00" "2017-03-12 02:59:59" "2017-03-12 03:00:00"
	"2017-11-05 01:59:59" "2017-11-05 02:00:00"}
    {":America/New_York"
	"2018-03-11 01:59:59" "2018-03-11 02:00:00" "2018-03-11 02:59:59" "2018-03-11 03:00:00"
	"2018-11-04 01:59:59" "2018-11-04 02:00:00"}
}
test clock-46.19-1 {
test clock-46.19-1 {free-scan: validation rules: invalid time (DST-hole, out of range in time-zone)} \
    -body {
    free-scan: validation rules: invalid time (DST-hole, out of range in time-zone)
} -constraints notclassic -body {
	set res {}
	foreach tz $dst_hole_check { set dt [lassign $tz tz]; foreach dt $dt {
	    lappend res [set v [catch {clock scan $dt -timezone $tz -valid 1} msg]]
	    if {$v} { lappend res $msg }
	}}
	set res
    } -cleanup {
37309
37310
37311
37312
37313
37314
37315

37316
37317


37318
37319
37320
37321
37322
37323
37324
37349
37350
37351
37352
37353
37354
37355
37356


37357
37358
37359
37360
37361
37362
37363
37364
37365







+
-
-
+
+







	foreach tz $dst_hole_check { set dt [lassign $tz tz]; foreach dt $dt {
	    lappend res [set v [catch {clock scan $dt -timezone $tz} msg]]
	}}
	set res
    } -cleanup {
	unset -nocomplain res v dt tz
    } -result [lrepeat 4 {*}[if {$valid_mode} {list 0 1 1 0 0 0} else {list 0 0 0 0 0 0}]]
test clock-46.19-3 {
test clock-46.19-3 {scan: validation rules: invalid time (DST-hole, out of range in time-zone)} \
    -body {
    scan: validation rules: invalid time (DST-hole, out of range in time-zone)
} -constraints notclassic -body {
	set res {}
	foreach tz $dst_hole_check { set dt [lassign $tz tz]; foreach dt $dt {
	    lappend res [set v [catch {clock scan $dt -timezone $tz -format "%Y-%m-%d %H:%M:%S" -valid 1} msg]]
	    if {$v} { lappend res $msg }
	}}
	set res
    } -cleanup {
37351
37352
37353
37354
37355
37356
37357
37358

37359
37360
37361
37362
37363

37364
37365
37366
37367
37368

37369
37370
37371
37372
37373

37374
37375
37376
37377

37378
37379
37380
37381

37382
37383
37384
37385

37386
37387
37388
37389

37390
37391
37392
37393

37394
37395
37396
37397

37398
37399
37400
37401

37402
37403
37404
37405
37406

37407


37408
37409
37410
37411
37412
37413
37414
37415
37416

37417


37418
37419
37420
37421
37422
37423
37424
37392
37393
37394
37395
37396
37397
37398

37399
37400
37401
37402
37403

37404
37405
37406
37407
37408

37409
37410
37411
37412
37413

37414
37415
37416
37417

37418
37419
37420
37421

37422
37423
37424
37425

37426
37427
37428
37429

37430
37431
37432
37433

37434
37435
37436
37437

37438
37439
37440
37441

37442
37443
37444
37445
37446
37447
37448

37449
37450
37451
37452
37453
37454
37455
37456
37457
37458
37459
37460

37461
37462
37463
37464
37465
37466
37467
37468
37469







-
+




-
+




-
+




-
+



-
+



-
+



-
+



-
+



-
+



-
+



-
+





+
-
+
+









+
-
+
+







		lappend res [catch {clock scan $v -format $fmt -valid 1 -timezone $tz} msg] $msg
	    }
	}
    }
    set res
}
test clock-46.20 {scan: validation rules: invalid time} \
    -body {
    -constraints notclassic -body {
	# 13:00 am/pm are invalid input strings...
	_invalid_test "13:00 am" "%H:%M %p" "13:00 pm" "%H:%M %p"
    } -result [lrepeat 10 1 {unable to convert input string: invalid time (hour)}]
test clock-46.21 {scan: validation rules: invalid time} \
    -body {
    -constraints notclassic -body {
	# invalid minutes in input strings...
	_invalid_test "23:70" "%H:%M" "11:80 pm" "%H:%M %p"
    } -result [lrepeat 10 1 {unable to convert input string: invalid time (minutes)}]
test clock-46.22 {scan: validation rules: invalid time} \
    -body {
    -constraints notclassic -body {
	# invalid seconds in input strings...
	_invalid_test "23:00:70" "%H:%M:%S" "11:00:80 pm" "%H:%M:%S %p"
    } -result [lrepeat 10 1 {unable to convert input string: invalid time}]
test clock-46.23 {scan: validation rules: invalid day} \
    -body {
    -constraints notclassic -body {
	_invalid_test "29 Feb 2017" "%d %b %Y" "30 Feb 2016" "%d %b %Y"
    } -result [lrepeat 10 1 {unable to convert input string: invalid day}]
test clock-46.24 {scan: validation rules: invalid day} \
    -body {
    -constraints notclassic -body {
	_invalid_test "0 Feb 2017" "%d %b %Y" "00 Feb 2017" "%d %b %Y"
    } -result [lrepeat 10 1 {unable to convert input string: invalid day}]
test clock-46.25 {scan: validation rules: invalid month} \
    -body {
    -constraints notclassic -body {
	_invalid_test "13/13/2017" "%m/%d/%Y" "00/01/2017" "%m/%d/%Y"
    } -result [lrepeat 10 1 {unable to convert input string: invalid month}]
test clock-46.26 {scan: validation rules: ambiguous day} \
    -body {
    -constraints notclassic -body {
	_invalid_test "1970-01-02--004" "%Y-%m-%d--%j" "70-01-02--004" "%y-%m-%d--%j"
    } -result [lrepeat 10 1 {unable to convert input string: ambiguous day}]
test clock-46.27 {scan: validation rules: ambiguous year} \
    -body {
    -constraints notclassic -body {
	_invalid_test "19700106 00W014" "%Y%m%d %gW%V%u" "1970006 00W014" "%Y%j %gW%V%u"
    } -result [lrepeat 10 1 {unable to convert input string: ambiguous year}]
test clock-46.28 {scan: validation rules: invalid day of week} \
    -body {
    -constraints notclassic -body {
	_invalid_test "Sat Jan 02 00:00:00 1970" "%a %b %d %H:%M:%S %Y"
    } -result [lrepeat 5 1 {unable to convert input string: invalid day of week}]
test clock-46.29-1 {scan: validation rules: invalid day of year} \
    -body {
    -constraints notclassic -body {
	_invalid_test "000-2017" "%j-%Y" "366-2017" "%j-%Y" "000-2017" "%j-%G" "366-2017" "%j-%G"
    } -result [lrepeat 20 1 {unable to convert input string: invalid day of year}]
test clock-46.29-2 {scan: validation rules: valid day of leap/not leap year} \
    -body {
    -constraints notclassic -body {
	list [clock format [clock scan "366-2016" -format "%j-%Y" -valid 1 -gmt 1] -format "%d-%m-%Y" -gmt 1] \
	     [clock format [clock scan "365-2017" -format "%j-%Y" -valid 1 -gmt 1] -format "%d-%m-%Y" -gmt 1] \
	     [clock format [clock scan "366-2016" -format "%j-%G" -valid 1 -gmt 1] -format "%d-%m-%Y" -gmt 1] \
	     [clock format [clock scan "365-2017" -format "%j-%G" -valid 1 -gmt 1] -format "%d-%m-%Y" -gmt 1]
    } -result {31-12-2016 31-12-2017 31-12-2016 31-12-2017}
test clock-46.30 {
test clock-46.30 {scan: validation rules: invalid year} -setup {
    scan: validation rules: invalid year
} -constraints notclassic -setup {
	set orgcfg [list -min-year [::tcl::unsupported::clock::configure -min-year] -max-year [::tcl::unsupported::clock::configure -max-year] \
	     -year-century [::tcl::unsupported::clock::configure -year-century] -century-switch [::tcl::unsupported::clock::configure -century-switch]]
	::tcl::unsupported::clock::configure -min-year 2000 -max-year 2100 -year-century 2000 -century-switch 38
    } -body {
	_invalid_test "01-01-70" "%d-%m-%y" "01-01-1870" "%d-%m-%C%y" "01-01-1970" "%d-%m-%Y"
    } -result [lrepeat 15 1 {unable to convert input string: invalid year}] -cleanup {
	::tcl::unsupported::clock::configure {*}$orgcfg
	unset -nocomplain orgcfg
    }
test clock-46.31 {
test clock-46.31 {scan: validation rules: invalid iso year} -setup {
    scan: validation rules: invalid iso year
} -constraints notclassic -setup {
	set orgcfg [list -min-year [::tcl::unsupported::clock::configure -min-year] -max-year [::tcl::unsupported::clock::configure -max-year] \
	     -year-century [::tcl::unsupported::clock::configure -year-century] -century-switch [::tcl::unsupported::clock::configure -century-switch]]
	::tcl::unsupported::clock::configure -min-year 2000 -max-year 2100 -year-century 2000 -century-switch 38
    } -body {
	_invalid_test "01-01-70" "%d-%m-%g" "01-01-9870" "%d-%m-%C%g" "01-01-9870" "%d-%m-%G"
    } -result [lrepeat 15 1 {unable to convert input string: invalid iso year}] -cleanup {
	::tcl::unsupported::clock::configure {*}$orgcfg
37454
37455
37456
37457
37458
37459
37460
37461

37462
37463
37464
37465


37466
37467
37468
37469
37470
37471
37472
37473
37474
37475

37476
37477
37478

37479
37480
37481

37482
37483
37484
37485
37486
37487

37488
37489
37490

37491
37492
37493
37494
37495
37496
37497
37498

37499
37500
37501

37502
37503
37504
37505
37506
37507
37508
37499
37500
37501
37502
37503
37504
37505

37506
37507
37508


37509
37510
37511
37512
37513
37514
37515
37516
37517
37518
37519

37520
37521
37522

37523
37524
37525

37526
37527
37528
37529
37530
37531

37532
37533
37534

37535
37536
37537
37538
37539
37540
37541
37542

37543
37544
37545

37546
37547
37548
37549
37550
37551
37552
37553







-
+


-
-
+
+









-
+


-
+


-
+





-
+


-
+







-
+


-
+







    -match regexp \
    -result {0 1969|1 {localtime failed \(clock value may be too large/small to represent\)}}

test clock-49.2 {regression test - missing time zone file (Bug 1237907)} \
    -constraints win \
    -setup {
	# override the registry so that the test takes place in New York time
	namespace eval ::tcl::clock {
	namespace eval ${clockns} {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	set noreg [info exists ${clockns}::NoRegistry]
	if {$noreg} {unset ${clockns}::NoRegistry}
	if { [info exists env(TZ)] } {
	    set oldTZ $env(TZ)
	    unset env(TZ)
	}
	if { [info exists env(TCL_TZ)] } {
	    set oldTclTZ $env(TCL_TZ)
	    unset env(TCL_TZ)
	}
	# make it so New York time is a missing file
	dict set ::tcl::clock::WinZoneInfo \
	dict set ${clockns}::WinZoneInfo \
	    {-18000 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} \
	    :No/Such/File
	::tcl::clock::ClearCaches
	${clockns}::ClearCaches
    } \
    -body {
	list [::tcl::clock::GuessWindowsTimeZone] \
	list [${clockns}::GuessWindowsTimeZone] \
	    [clock format 0 -locale system -format "%H:%M:%S %Z"] \
	    [clock format -86400 -format "%Y"]
    } \
    -cleanup {
	# restore the registry and environment
	namespace eval ::tcl::clock {
	namespace eval ${clockns} {
	    rename registry {}
	}
	if {$noreg} {set ::tcl::clock::NoRegistry {}}
	if {$noreg} {set ${clockns}::NoRegistry {}}
	if { [info exists oldTclTZ] } {
	    set env(TCL_TZ) $oldTclTZ
	}
	if { [info exists oldTZ] } {
	    set env(TZ) $oldTZ
	}
	# put New York back on the map
	dict set ::tcl::clock::WinZoneInfo \
	dict set ${clockns}::WinZoneInfo \
	    {-18000 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} \
	    :America/New_York
	::tcl::clock::ClearCaches
	${clockns}::ClearCaches
    } \
    -result {<-0500>+05:00:00<-0400>+04:00:00,M3.2.0/02:00:00,M11.1.0/02:00:00 {19:00:00 -0500} 1969}

test clock-50.1 {format / scan -1 as a local time} {
    if {[catch {
	clock scan \
	    [clock format -1 -format %Y%m%d%H%M%S -timezone :localtime] \
37664
37665
37666
37667
37668
37669
37670
37671
37672
37673



37674
37675
37676
37677
37678



37679
37680
37681
37682
37683
37684
37685
37709
37710
37711
37712
37713
37714
37715



37716
37717
37718
37719
37720



37721
37722
37723
37724
37725
37726
37727
37728
37729
37730







-
-
-
+
+
+


-
-
-
+
+
+







	    0xd0 0x81 0x1a 0x1c 0xfa 0xf8 0x75 0x10 0xfb 0xe8 0x58 0x00
	    0x00 0x01 0x00 0x01 0x02 0x01 0x02 0x01 0x00 0x01 0xff 0xff
	    0xab 0xa0 0x01 0x00 0xff 0xff 0x9d 0x90 0x00 0x04 0xff 0xff
	    0xab 0xa0 0x01 0x08 0x4d 0x44 0x54 0x00 0x4d 0x53 0x54 0x00
	    0x4d 0x57 0x54 0x00 0x00 0x00 0x00 0x00 0x00 0x00
	}]
	close $f
	set ::tcl::clock::ZoneinfoPaths \
	    [linsert $::tcl::clock::ZoneinfoPaths 0 $tzdir]
	::tcl::clock::ClearCaches
	set ${clockns}::ZoneinfoPaths \
	    [linsert [set ${clockns}::ZoneinfoPaths] 0 $tzdir]
	${clockns}::ClearCaches
    }
    -cleanup {
	set ::tcl::clock::ZoneinfoPaths \
	    [lrange $::tcl::clock::ZoneinfoPaths 1 end]
	::tcl::clock::ClearCaches
	set ${clockns}::ZoneinfoPaths \
	    [lrange [set ${clockns}::ZoneinfoPaths] 1 end]
	${clockns}::ClearCaches
	removeFile PhoenixOne $tzdir2
	removeDirectory Test $tzdir
	removeDirectory zoneinfo
    }
    -body {
	clock format 1072940400 -timezone :Test/PhoenixOne \
	    -format {%Y-%m-%d %H:%M:%S %Z}
37721
37722
37723
37724
37725
37726
37727
37728
37729
37730



37731
37732
37733
37734
37735



37736
37737
37738
37739
37740
37741
37742
37766
37767
37768
37769
37770
37771
37772



37773
37774
37775
37776
37777



37778
37779
37780
37781
37782
37783
37784
37785
37786
37787







-
-
-
+
+
+


-
-
-
+
+
+







	    0xee 0x00 0x00 0xff 0xff 0xab 0xa0 0x01 0x04 0xff 0xff 0x9d
	    0x90 0x00 0x08 0xff 0xff 0xab 0xa0 0x01 0x0c 0x4c 0x4d 0x54
	    0x00 0x4d 0x44 0x54 0x00 0x4d 0x53 0x54 0x00 0x4d 0x57 0x54
	    0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x0a 0x4d 0x53
	    0x54 0x37 0x0a
	}]
	close $f
	set ::tcl::clock::ZoneinfoPaths \
	    [linsert $::tcl::clock::ZoneinfoPaths 0 $tzdir]
	::tcl::clock::ClearCaches
	set ${clockns}::ZoneinfoPaths \
	    [linsert [set ${clockns}::ZoneinfoPaths] 0 $tzdir]
	${clockns}::ClearCaches
    }
    -cleanup {
	set ::tcl::clock::ZoneinfoPaths \
	    [lrange $::tcl::clock::ZoneinfoPaths 1 end]
	::tcl::clock::ClearCaches
	set ${clockns}::ZoneinfoPaths \
	    [lrange [set ${clockns}::ZoneinfoPaths] 1 end]
	${clockns}::ClearCaches
	removeFile PhoenixTwo $tzdir2
	removeDirectory Test $tzdir
	removeDirectory zoneinfo
    }
    -body {
	clock format 1072940400 -timezone :Test/PhoenixTwo \
	    -format {%Y-%m-%d %H:%M:%S %Z}
37931
37932
37933
37934
37935
37936
37937
37938
37939
37940



37941
37942
37943
37944
37945



37946
37947
37948
37949
37950
37951
37952
37953
37954
37955
37956
37957
37958

37959
37960
37961
37962
37963
37964
37965
37976
37977
37978
37979
37980
37981
37982



37983
37984
37985
37986
37987



37988
37989
37990
37991
37992
37993
37994
37995
37996
37997
37998
37999
38000
38001
38002

38003
38004
38005
38006
38007
38008
38009
38010







-
-
-
+
+
+


-
-
-
+
+
+












-
+







            0x54 0x00 0x50 0x53 0x54 0x00 0x50 0x44 0x54 0x00 0x50 0x57 0x54
            0x00 0x50 0x50 0x54 0x00 0x00 0x00 0x00 0x00 0x00 0x01 0x00 0x00
            0x00 0x00 0x00 0x01 0x0a 0x50 0x53 0x54 0x38 0x50 0x44 0x54 0x2c
            0x4d 0x34 0x2e 0x31 0x2e 0x30 0x2c 0x4d 0x31 0x30 0x2e 0x35 0x2e
            0x30 0x0a
	}]
	close $f
	set ::tcl::clock::ZoneinfoPaths \
	    [linsert $::tcl::clock::ZoneinfoPaths 0 $tzdir]
	::tcl::clock::ClearCaches
	set ${clockns}::ZoneinfoPaths \
	    [linsert [set ${clockns}::ZoneinfoPaths] 0 $tzdir]
	${clockns}::ClearCaches
    }
    -cleanup {
	set ::tcl::clock::ZoneinfoPaths \
	    [lrange $::tcl::clock::ZoneinfoPaths 1 end]
	::tcl::clock::ClearCaches
	set ${clockns}::ZoneinfoPaths \
	    [lrange [set ${clockns}::ZoneinfoPaths] 1 end]
	${clockns}::ClearCaches
	removeFile TijuanaTwo $tzdir2
	removeDirectory Test $tzdir
	removeDirectory zoneinfo
    }
    -body {
	clock format 2224738800 -timezone :Test/TijuanaTwo \
	    -format {%Y-%m-%d %H:%M:%S %Z}
    }
    -result {2040-07-01 00:00:00 PDT}
}

test clock-56.4 {Bug 3470928} {*}{
    -setup {
    -constraints notclassic -setup {
	clock format [clock seconds]
	set tzdir [makeDirectory zoneinfo]
	set tzdir2 [makeDirectory Test $tzdir]
	set tzfile [makeFile {} Windhoek $tzdir2]
	set f [open $tzfile wb]
	puts -nonewline $f [binary format c* {
            0x54 0x5a 0x69 0x66 0x32 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00
38080
38081
38082
38083
38084
38085
38086
38087
38088
38089



38090
38091
38092
38093
38094
38095
38096
38097



38098
38099
38100
38101
38102
38103
38104
38125
38126
38127
38128
38129
38130
38131



38132
38133
38134
38135
38136
38137
38138
38139



38140
38141
38142
38143
38144
38145
38146
38147
38148
38149







-
-
-
+
+
+





-
-
-
+
+
+







            0x4d 0x54 0x00 0x53 0x57 0x41 0x54 0x00 0x53 0x41 0x53 0x54 0x00
            0x43 0x41 0x54 0x00 0x57 0x41 0x53 0x54 0x00 0x00 0x00 0x00 0x00
            0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x0a 0x57 0x41
            0x54 0x2d 0x31 0x57 0x41 0x53 0x54 0x2c 0x4d 0x39 0x2e 0x31 0x2e
            0x30 0x2c 0x4d 0x34 0x2e 0x31 0x2e 0x30 0x0a
	}]
	close $f
	set ::tcl::clock::ZoneinfoPaths \
	    [linsert $::tcl::clock::ZoneinfoPaths 0 $tzdir]
	::tcl::clock::ClearCaches
	set ${clockns}::ZoneinfoPaths \
	    [linsert [set ${clockns}::ZoneinfoPaths] 0 $tzdir]
	${clockns}::ClearCaches
    }
    -body {
	clock format 1326054606 -timezone :Test/Windhoek
    }
    -cleanup {
	set ::tcl::clock::ZoneinfoPaths \
	    [lrange $::tcl::clock::ZoneinfoPaths 1 end]
	::tcl::clock::ClearCaches
	set ${clockns}::ZoneinfoPaths \
	    [lrange [set ${clockns}::ZoneinfoPaths] 1 end]
	${clockns}::ClearCaches
	removeFile Windhoek $tzdir2
	removeDirectory Test $tzdir
	removeDirectory zoneinfo
    }
    -result {Sun Jan 08 22:30:06 WAST 2012}
}

38257
38258
38259
38260
38261
38262
38263
38264

38265
38266
38267
38268
38269
38270
38271
38272

38273
38274
38275
38276
38277
38278
38279
38280

38281
38282
38283
38284
38285
38286
38287
38288

38289
38290
38291
38292
38293
38294

38295


38296
38297

38298


38299
38300
38301

38302


38303
38304

38305


38306
38307
38308
38309
38310

38311
38312
38313
38314
38315
38316
38317
38318
38319
38320
38321
38322
38323
38324
38325
38326

38327
38328
38329
38330
38331
38332
38333
38302
38303
38304
38305
38306
38307
38308

38309
38310
38311
38312
38313
38314
38315
38316

38317
38318
38319
38320
38321
38322
38323
38324

38325
38326
38327
38328
38329
38330
38331
38332

38333
38334
38335
38336
38337
38338
38339
38340

38341
38342
38343
38344
38345

38346
38347
38348
38349
38350
38351

38352
38353
38354
38355
38356

38357
38358
38359
38360
38361
38362

38363
38364
38365
38366
38367
38368
38369
38370
38371
38372
38373
38374
38375
38376
38377
38378

38379
38380
38381
38382
38383
38384
38385
38386







-
+







-
+







-
+







-
+






+
-
+
+


+
-
+
+



+
-
+
+


+
-
+
+




-
+















-
+







    clock scan "1 December 2000" -gmt true -format "%d %b %Y"
} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"]
test clock-60.12 {case insensitive month names} {
    clock scan "1 DECEMBER 2000" -gmt true -format "%d %b %Y"
} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"]

test clock-61.1 {overflow of a wide integer on output} {*}{
    -body {
    -constraints notclassic -body {
	clock format 0x8000000000000000 -format %s -gmt true
    }
    -result {integer value too large to represent}
    -errorCode {CLOCK badOption 0x8000000000000000}
    -returnCodes error
}
test clock-61.1b {overflow of a wide integer on base} {*}{
    -body {
    -constraints notclassic -body {
	clock scan "" -base 0x8000000000000000 -gmt true
    }
    -result {integer value too large to represent}
    -errorCode {CLOCK badOption 0x8000000000000000}
    -returnCodes error
}
test clock-61.2 {overflow of a wide integer on output} {*}{
    -body {
    -constraints notclassic -body {
	clock format -0x8000000000000001 -format %s -gmt true
    }
    -result {integer value too large to represent}
    -errorCode {CLOCK badOption -0x8000000000000001}
    -returnCodes error
}
test clock-61.2b {overflow of a wide integer on base} {*}{
    -body {
    -constraints notclassic -body {
	clock scan "" -base -0x8000000000000001 -gmt true
    }
    -result {integer value too large to represent}
    -errorCode {CLOCK badOption -0x8000000000000001}
    -returnCodes error
}
test clock-61.3 {
test clock-61.3 {near-miss overflow of a wide integer on output, very large datetime (upper range)} {
    near-miss overflow of a wide integer on output, very large datetime (upper range)
} notclassic {
    clock format 0x00F0000000000000 -format "%s %Y %EE" -gmt true
} [list [expr 0x00F0000000000000] 2140702833 C.E.]
test clock-61.4 {
test clock-61.4 {near-miss overflow of a wide integer on output, very small datetime (lower range)} {
    near-miss overflow of a wide integer on output, very small datetime (lower range)
} notclassic {
    clock format -0x00F0000000000000 -format "%s %Y %EE" -gmt true
} [list [expr -0x00F0000000000000] 2140654939 B.C.E.]

test clock-61.5 {
test clock-61.5 {overflow of possible date-time (upper range)} -body {
    overflow of possible date-time (upper range)
} -constraints notclassic -body {
    clock format 0x00F0000000000001 -gmt true
} -returnCodes error -result {integer value too large to represent} -errorCode {CLOCK badOption 0x00F0000000000001}
test clock-61.6 {
test clock-61.6 {overflow of possible date-time (lower range)} -body {
    overflow of possible date-time (lower range)
} -constraints notclassic -body {
    clock format -0x00F0000000000001 -gmt true
} -returnCodes error -result {integer value too large to represent} -errorCode {CLOCK badOption -0x00F0000000000001}

test clock-62.1 {Bug 1902423} {*}{
    -setup {::tcl::clock::ClearCaches}
    -setup {${clockns}::ClearCaches}
    -body {
	set s 1204049747
	set f1 [clock format $s -format {%Y-%m-%d %T} -locale C]
	set f2 [clock format $s -format {%Y-%m-%d %H:%M:%S} -locale C]
	if {$f1 ne $f2} {
	    subst "$f2 is not $f1"
	} else {
	    subst "ok"
	}
    }
    -result ok
}

test clock-63.1 {Incorrect use of internal ConvertLocalToUTC command} {*}{
    -body {
	::tcl::clock::ConvertLocalToUTC {immaterial stuff} {} 12345
	${clockns}::ConvertLocalToUTC {immaterial stuff} {} 12345
    }
    -returnCodes error
    -result {key "localseconds" not found in dictionary}
}

test clock-64.1 {:: in format string [Bug 2362156]} {*}{
    -body {
38358
38359
38360
38361
38362
38363
38364
38365

38366
38367
38368
38369
38370
38371
38372
38373
38374
38375
38376
38377
38378
38379
38380
38381
38382

38383
38384
38385
38386

38387
38388
38389
38390
38391
38392
38393
38411
38412
38413
38414
38415
38416
38417

38418
38419
38420
38421
38422
38423
38424
38425
38426
38427
38428
38429
38430
38431
38432
38433
38434

38435
38436
38437
38438

38439
38440
38441
38442
38443
38444
38445
38446







-
+
















-
+



-
+







    -match glob
    -returnCodes error
    -result {cannot use -gmt and -timezone in same call}
}

test clock-66.1 {clock scan, no date, never-before-seen timezone} {*}{
    -setup {
	::tcl::clock::ClearCaches
	${clockns}::ClearCaches
    }
    -body {
	clock scan 1200 \
	    -timezone {<EST>+05:00:00<EDT>+04:00:00,M3.2.0/02:00:00,M11.1.0/02:00:00} \
	    -base 1256529600 \
	    -format %H%M
    }
    -result 1256572800
}

test clock-67.1 {clock format, %% with a letter following [Bug 2819334]} {
    clock format [clock seconds] -format %%r
} %r

test clock-67.2 {Bug d19a30db57} -body {
    # error, not segfault
    tcl::clock::GetJulianDayFromEraYearMonthDay {} 2361222
    ${clockns}::GetJulianDayFromEraYearMonthDay {} 2361222
} -returnCodes error -match glob -result *
test clock-67.3 {Bug d19a30db57} -body {
    # error, not segfault
    tcl::clock::GetJulianDayFromEraYearWeekDay {} 2361222
    ${clockns}::GetJulianDayFromEraYearWeekDay {} 2361222
} -returnCodes error -match glob -result *
test clock-67.4 {Change format %x output on global locale change [Bug 4a0c163d24]} -setup {
    package require msgcat
    set current [msgcat::mclocale]
} -body {
    msgcat::mclocale de_de
    set res [regexp {^\d{2}\.\d{2}\.\d{4}$} [clock format 1 -locale current -format %x]]
38405
38406
38407
38408
38409
38410
38411


38412
38413
38414

38415
38416
38417
38418
38419
38420
38421
38458
38459
38460
38461
38462
38463
38464
38465
38466
38467
38468

38469
38470
38471
38472
38473
38474
38475
38476







+
+


-
+







    msgcat::mclocale en_uk
    # This will fail without the bug fix, as still de_de is active
    expr {$res == [clock scan "01/01/1970" -locale current -format %x -gmt 1]}
} -cleanup {
    msgcat::mclocale $current
} -result {1}

# END TESTS MARKER

# cleanup

::tcl::clock::ClearCaches
${clockns}::ClearCaches
rename test {}
namespace import -force ::tcltest::*
# adjust expected skipped (valid_off is an artificial constraint):
if {$valid_mode && [info exists ::tcltest::skippedBecause(valid_off)]} {
    incr ::tcltest::numTests(Total) -$::tcltest::skippedBecause(valid_off)
    incr ::tcltest::numTests(Skipped) -$::tcltest::skippedBecause(valid_off)
    unset ::tcltest::skippedBecause(valid_off)
Added tests/clockclassic.test.





























































































































































































































































































































































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Copyright © 2004 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.

# Copyright © 2024 Nathan Coulter.
# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# clockClassic.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.


namespace eval ::tcl::clockclassic::test {}
apply {{} {

global env
global errorCode

set chan [open [file join [file dirname [
    file normalize [info script]]] clock.test]]
try {
    set clocktestscript [read $chan]
} finally {
    close $chan
}
set status [regexp {\n# START TESTS MARKER\n(.*)\n# END TESTS MARKER\n} \
    $clocktestscript -> clocktestscript]

if {!$status} {
    error [list {could not extract tests from clock.test}]
}

namespace import ::tcl::clock::classic
rename [namespace current]::classic [namespace current]::clock
set clockns [namespace ensemble configure clock -namespace]
set valid_mode 0

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

if {[testConstraint win]} {
    if {[catch {
	    ::tcltest::loadTestedCommands
	    package require registry
	}]} {
	namespace eval $clockns {variable NoRegistry {}}
    }
}

package require msgcat 1.4

testConstraint notclassic 0
testConstraint valid_off 1


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}}]


# Note that all code between comments '# BEGIN' and '# END' is
# autogenerated by 'tools/makeTestCases.tcl'.  DO NOT EDIT CODE BETWEEN
# '# BEGIN' and '# END'.

# Define a fictitious locale, 'en_US_roman', for formatting of clock
# strings with localized numerics and eras.  This locale will be used
# in testing the 'clock' command.

namespace eval $clockns {
    ::msgcat::mcmset en_US_roman {
	LOCALE_ERAS {
	    {-62164627200 {} 0}
	    {-59008867200 c 100}
	    {-55853107200 cc 200}
	    {-52697347200 ccc 300}
	    {-49541587200 cd 400}
	    {-46385827200 d 500}
	    {-43230067200 dc 600}
	    {-40074307200 dcc 700}
	    {-36918547200 dccc 800}
	    {-33762787200 cm 900}
	    {-30607027200 m 1000}
	    {-27451267200 mc 1100}
	    {-24295507200 mcc 1200}
	    {-21139747200 mccc 1300}
	    {-17983987200 mcd 1400}
	    {-14828227200 md 1500}
	    {-11672467200 mdc 1600}
	    {-8516707200 mdcc 1700}
	    {-5364662400 mdccc 1800}
	    {-2208988800 mcm 1900}
	    {946684800 mm 2000}
	}
	LOCALE_NUMERALS {
	    ? i ii iii iv v vi vii viii ix
	    x xi xii xiii xiv xv xvi xvii xviii xix
	    xx xxi xxii xxiii xxiv xxv xxvi xxvii xxviii xxix
	    xxx xxxi xxxii xxxiii xxxiv xxxv xxxvi xxxvii xxxviii xxxix
	    xl xli xlii xliii xliv xlv xlvi xlvii xlviii xlix
	    l li lii liii liv lv lvi lvii lviii lix
	    lx lxi lxii lxiii lxiv lxv lxvi lxvii lxviii lxix
	    lxx lxxi lxxii lxxiii lxxiv lxxv lxxvi lxxvii lxxviii lxxix
	    lxxx lxxxi lxxxii lxxxiii lxxxiv lxxxv lxxxvi lxxxvii lxxxviii
	    lxxxix
	    xc xci xcii xciii xciv xcv xcvi xcvii xcviii xcix
	    c
	}
	DATE_FORMAT {%m/%d/%Y}
	TIME_FORMAT {%H:%M:%S}
	DATE_TIME_FORMAT {%x %X}
	LOCALE_DATE_FORMAT {die %Od mensis %Om annoque %EY}
	LOCALE_TIME_FORMAT {%OH h %OM m %OS s}
	LOCALE_DATE_TIME_FORMAT {%Ex %EX}
	BCE {Before Christ}
	CE {Anno Domini}
    }
}

#----------------------------------------------------------------------
#
# The tests for the Windows platform are careful *not* to muck with
# the system registry.  Instead, the 'registry' command is overridden
# in the $clockns namespace.
#
#----------------------------------------------------------------------

namespace eval ::testClock {
    namespace export registry
    set reg \
	[dict create \
	     HKEY_CURRENT_USER\\Control\ Panel\\International \
	     [dict create \
		  locale 0409 \
		  sShortDate dd-MMM-yyyy \
		  sLongDate "'the' dd''' day of' MMMM yyyy" \
		  sTimeFormat "h:mm:ss tt"] \
	     HKEY_LOCAL_MACHINE\\System\\CurrentControlSet\\Control\\TimeZoneInformation \
	     [dict create \
		  Bias 300 \
		  StandardBias 0 \
		  DaylightBias -60 \
		  StandardStart \x00\x00\x0B\x00\x01\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00 \
		  DaylightStart \x00\x00\x03\x00\x02\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00]]
}


proc ::testClock::registry { cmd path key } {
    variable reg
    if { $cmd ne {get} } {
	return -code error "test case attempts to write/query the registry"
    }
    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
} {1 {wrong # args: should be "clock format clockval ?-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.4 "clock format - bad flag" {*}{
    -body {
    list [catch {clock format 0 -oops badflag} msg] $msg $::errorCode
    }
    -match glob
    -result {1 {bad option "-oops": must be -format, -gmt, -locale, or -timezone} {CLOCK badOption -oops}}
}

# Test input conversions.

test clock-6.10 {input of seconds - overflow} {
    list [catch {clock scan 9223372036854775808 -format %s -gmt true} result opt] $result [dict getd $opt -errorcode ""]
} {1 {integer value too large to represent} {CLOCK dateTooLarge}}

test clock-6.10c {input of seconds - overflow ??, bug [1f40aa83c5]} knownBug {
    clock scan 27670116110564327423 -gmt true
} 89170590268800
test clock-6.10d {input of seconds - overflow ??, bug [1f40aa83c5]} knownBug {
  clock scan 27670116110564327424 -gmt true
} -90247104115200


try $clocktestscript


test clock-9.2 {Julian day takes precedence over ccyymmdd} {
    clock scan {2440588 20000101} -format {%J %Y%m%d} -gmt true
} 0

# BEGIN testcases11

# Test precedence among yyyymmdd and yyyyddd

test clock-11.1 {precedence of ccyyddd and ccyymmdd} {
    clock scan 19700101002 -format %Y%m%d%j -gmt 1
} 86400
test clock-11.2 {precedence of ccyyddd and ccyymmdd} {
    clock scan 01197001002 -format %m%Y%d%j -gmt 1
} 86400
test clock-11.3 {precedence of ccyyddd and ccyymmdd} {
    clock scan 01197001002 -format %d%Y%m%j -gmt 1
} 86400
test clock-11.4 {precedence of ccyyddd and ccyymmdd} {
    clock scan 00219700101 -format %j%Y%m%d -gmt 1
} 0
# END testcases11

# Legacy tests

# clock clicks

# clock scan
test clock-34.1 {clock scan tests} {
    list [catch {clock scan} msg] $msg
} {1 {wrong # args: should be "clock scan string ?-base seconds? ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"}}

test clock-34.9 {clock scan tests} {
    list [catch {clock scan "Jan 12" -bad arg} msg] $msg
} {1 {bad option "-bad": must be -base, -format, -gmt, -locale, or -timezone}}
# The following two two tests test the two year date policy
test {clock-34.12 nogmt} {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 nogmt} {clock scan, ISO 8601 base date format} {
    set time [clock scan "19921023"]
    clock format $time -format {%b %d, %Y}
} "Oct 23, 1992"
test {clock-34.14 nogmt} {clock scan, ISO 8601 expanded date format} {
    set time [clock scan "1992-10-23"]
    clock format $time -format {%b %d, %Y}
} "Oct 23, 1992"
test {clock-34.15 nogmt} {clock scan, DD-Mon-YYYY format} {
    set time [clock scan "23-Oct-1992"]
    clock format $time -format {%b %d, %Y}
} "Oct 23, 1992"
test {clock-34.16 nogmt} {clock scan, ISO 8601 point in time format} {
    set time [clock scan "19921023T235959"]
    clock format $time -format {%b %d, %Y %H:%M:%S}
} "Oct 23, 1992 23:59:59"
test {clock-34.17 nogmt} {clock scan, ISO 8601 point in time format} {
    set time [clock scan "19921023 235959"]
    clock format $time -format {%b %d, %Y %H:%M:%S}
} "Oct 23, 1992 23:59:59"
test {clock-34.18 nogmt} {clock scan, ISO 8601 point in time format} {
    set time [clock scan "19921023T000000"]
    clock format $time -format {%b %d, %Y %H:%M:%S}
} "Oct 23, 1992 00:00:00"

# CLOCK SCAN REAL TESTS
# We use 5am PST, 31-12-1999 as the base for these scans because irrespective
# of your local timezone it should always give us times on December 31, 1999
set 5amPST 946645200
test clock-34.19 {clock scan, number meridian} {
    set t1 [clock scan "5 am" -base $5amPST -gmt true]
    set t2 [clock scan "5 pm" -base $5amPST -gmt true]
    set t3 [clock scan "5 a.m." -base $5amPST -gmt true]
    set t4 [clock scan "5 p.m." -base $5amPST -gmt true]
    list \
	    [clock format $t1 -format {%b %d, %Y %H:%M:%S} -gmt true] \
	    [clock format $t2 -format {%b %d, %Y %H:%M:%S} -gmt true] \
	    [clock format $t3 -format {%b %d, %Y %H:%M:%S} -gmt true] \
	    [clock format $t4 -format {%b %d, %Y %H:%M:%S} -gmt true]
} [list "Dec 31, 1999 05:00:00" "Dec 31, 1999 17:00:00" \
	"Dec 31, 1999 05:00:00" "Dec 31, 1999 17:00:00"]
test clock-34.20 {clock scan, number:number meridian} {
    clock format [clock scan "5:30 pm" -base $5amPST -gmt true] \
	    -format {%b %d, %Y %H:%M:%S} -gmt true
} "Dec 31, 1999 17:30:00"

# weekday specification and base.

# clock seconds
test clock-37.1 {%s gmt testing} {
    set s [clock seconds]
    set a [clock format $s -format %s -gmt 0]
    set b [clock format $s -format %s -gmt 1]
    # %s, being the difference between local and Greenwich, does not
    # depend on the time zone.
    set c [expr {$b-$a}]
} {0}

test clock-45.1 {regression test - time zone containing only two digits} \
    -body {
	clock scan 1985-04-12T10:15:30+04 -format %Y-%m-%dT%H:%M:%S%Z
    } \
    -result 482134530

# case-insensitive matching of weekday and month names [Bug 1781282]

test clock-61.1 {overflow of a wide integer on output} {*}{
    -body {
	clock format 0x8000000000000000 -format %s -gmt true
    }
    -result {integer value too large to represent}
    -returnCodes error
}
test clock-61.2 {overflow of a wide integer on output} {*}{
    -body {
	clock format -0x8000000000000001 -format %s -gmt true
    }
    -result {integer value too large to represent}
    -returnCodes error
}
test clock-61.3 {near-miss overflow of a wide integer on output} {
    clock format 0x7fffffffffffffff -format %s -gmt true
} [expr {0x7fffffffffffffff}]
test clock-61.4 {near-miss overflow of a wide integer on output} {
    clock format -0x8000000000000000 -format %s -gmt true
} [expr {-0x8000000000000000}]

# cleanup

namespace delete ::testClock
${clockns}::ClearCaches
::tcltest::cleanupTests
return





#apply
} ::tcl::clockclassic::test}


# Local Variables:
# mode: tcl
# End:
Changes to tests/cmdAH.test.
1
2
3
4
5
6
7
8
9
10
11














12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+
+







# The file tests the tclCmdAH.c file.
#
# 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 © 1996-1998 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# The file tests the tclCmdAH.c file.
#
# 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.


if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
28
29
30
31
32
33
34
35

36
37
38
39
40
41
42
36
37
38
39
40
41
42

43
44
45
46
47
48
49
50







-
+







}]
testConstraint filetime64bit [expr {
    [testConstraint time64bit] && (
	![testConstraint unix] || [apply {{} {
	  # check whether disk may have 2038 problem, see [fd91b0ca09cb171f]:
	  set fn [makeFile "" foo.text]
	  if {[catch {
	    exec sh -c "TZ=:UTC LC_TIME=en_US touch -ma -t '207006290000' '$fn' && TZ=:UTC LC_TIME=en_US ls -l '$fn'"
	    exec sh -c "TZ=:UTC LC_TYME=en_US touch -ma -t '207006290000' '$fn' && TZ=:UTC LC_TYME=en_US ls -l '$fn'"
	  } res]} {
	    #puts "Check constraint failed:\t$res"
	    set res {}
	  }
	  removeFile $fn
	  regexp {\mJun\s+29\s+2070\M} $res
	}}]
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
340
341
342
343
344
345
346

347
348
349
350
351
352
353







-







    set system [encoding system]
} -body {
    encoding system iso8859-1
    encoding system
} -cleanup {
    encoding system $system
} -result iso8859-1

#
# encoding convertfrom 4.3.*

# Odd number of args is always invalid since last two args
# are ENCODING DATA and all options take a value
badnumargs cmdAH-4.3.1 {encoding convertfrom} {}
badnumargs cmdAH-4.3.2 {encoding convertfrom} {-failindex VAR ABC}
Changes to tests/cmdIL.test.
1
2
3
4
5
6
7
8
9












10
11
12
13
14
15
16




1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+







# This file contains a collection of tests for the procedures in the file
# tclCmdIL.c. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains a collection of tests for the procedures in the file
# tclCmdIL.c. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.


if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}


Changes to tests/cmdInfo.test.














1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+








-
-
-
-
-
-







# Copyright © 1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  none
#
# This file contains a collection of tests for Tcl_GetCommandInfo,
# Tcl_SetCommandInfo, Tcl_CreateCommand, Tcl_DeleteCommand, and
# Tcl_NameOfCommand.  Sourcing this file into Tcl runs the tests
# and generates output for errors.  No output means no errors were
# found.
#
# Copyright © 1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/cmdMZ.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# The tests in this file cover the procedures in tclCmdMZ.c.
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# The tests in this file cover the procedures in tclCmdMZ.c.
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

namespace eval ::tcl::test::cmdMZ {
Changes to tests/compExpr-old.test.













1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-
-







# Copyright © 1996-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered: expr
#
# This file contains the original set of tests for the compilation (and
# indirectly execution) of Tcl's expr command. A new set of tests covering
# the new implementation are in the files "parseExpr.test" and
# "compExpr.test". Sourcing this file into Tcl runs the tests and generates
# output for errors. No output means no errors were found.
#
# Copyright © 1996-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}


Changes to tests/compExpr.test.
1
2
3
4
5
6
7
8
9











10
11
12
13
14
15
16




1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+







# This file contains a collection of tests for the procedures in the file
# tclCompExpr.c.  Sourcing this file into Tcl runs the tests and generates
# output for errors.  No output means no errors were found.
#
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains a collection of tests for the procedures in the file
# tclCompExpr.c.  Sourcing this file into Tcl runs the tests and generates
# output for errors.  No output means no errors were found.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/compile.test.













1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
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
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-







# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains tests for the files tclCompile.c, tclCompCmds.c and
# tclLiteral.c
#
# 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 © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}


Changes to tests/concat.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  concat
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  concat
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

test concat-1.1 {simple concatenation} {
Changes to tests/config.test.
1
2
3
4
5
6
7
8
9
10
11
12
13













14
15
16
17
18
19
20







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
-
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# -*- tcl -*-
# Commands covered:  pkgconfig
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  pkgconfig
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

test pkgconfig-1.1 {query keys} -body {
Changes to tests/coroutine.test.












1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17





18
19
20
21
22
23
24
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-







# Copyright © 2008 Miguel Sofer.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  coroutine, yield, yieldto, [info coroutine]
#
# This file contains a collection of tests for experimental commands that are
# found in ::tcl::unsupported. The tests will migrate to normal test files
# if/when the commands find their way into the core.
#
# Copyright © 2008 Miguel Sofer.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/dcall.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  none
#
# This file contains a collection of tests for Tcl_CallWhenDeleted.
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright © 1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  none
#
# This file contains a collection of tests for Tcl_CallWhenDeleted.
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/dict.test.











1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17




18
19
20
21
22
23
24
+
+
+
+
+
+
+
+
+
+
+






-
-
-
-







# Copyright © 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.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This test file covers the dictionary object type and the dict command used
# to work with values of that type.
#
# 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 © 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

catch {
147
148
149
150
151
152
153







154
155
156
157
158
159
160
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174







+
+
+
+
+
+
+







    }}
} -returnCodes error -result {key "d" not known in dictionary}
test dict-3.16 {dict/list shimmering - Bug 3004007} testobj {
    set l [list p 1 p 2 q 3]
    dict get $l q
    list $l [testobj objtype $l]
} {{p 1 p 2 q 3} dict}
test dict-3.17 {dict/list shimmering - Bug 3004007} testobj {
    # In Tcl unchained the internal representation is converted to a list
    # because there are duplicate keys in the dictionary.
    set l [list p 1 p 2 q 3]
    dict get $l q
    list [llength $l] [testobj objtype $l]
} {6 list}

test dict-4.1 {dict replace command} {
    dict replace {a b c d}
} {a b c d}
test dict-4.2 {dict replace command} {
    dict replace {a b c d} e f
} {a b c d e f}
Changes to tests/dstring.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  none
#
# This file contains a collection of tests for Tcl's dynamic string library
# procedures. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright © 1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  none
#
# This file contains a collection of tests for Tcl's dynamic string library
# procedures. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/encoding.test.
1
2
3
4
5
6
7
8
9











10
11
12
13
14
15
16




1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+







# This file contains a collection of tests for tclEncoding.c
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains a collection of tests for tclEncoding.c
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}


35
36
37
38
39
40
41

42
43
44
45
46
47
48
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56







+







    variable x

# Some tests require the testencoding command
testConstraint testencoding [llength [info commands testencoding]]
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint teststringbytes [llength [info commands teststringbytes]]
testConstraint exec [llength [info commands exec]]


# TclInitEncodingSubsystem is tested by the rest of this file
# TclFinalizeEncodingSubsystem is not currently tested

test encoding-1.1 {Tcl_GetEncoding: system encoding} -setup {
    set old [encoding system]
} -constraints {testencoding} -body {
80
81
82
83
84
85
86
87

88
89
90
91
92
93
94
88
89
90
91
92
93
94

95
96
97
98
99
100
101
102







-
+







    encoding system iso8859-1
    llength shiftjis		;# Shimmer away any cache of Tcl_Encoding
    lappend x [catch {encoding convertto shiftjis 乎} msg] $msg
} -cleanup {
    encoding system iso8859-1
    encoding dirs $path
    encoding system $system
} -result "\x8C\xC1 1 {unknown encoding \"shiftjis\"}"
} -result "\x8c\xc1 1 {unknown encoding \"shiftjis\"}"

test encoding-3.1 {Tcl_GetEncodingName, NULL} -setup {
    set old [encoding system]
} -body {
    encoding system shiftjis
    encoding system
} -cleanup {
186
187
188
189
190
191
192
193

194
195
196
197
198
199
200
194
195
196
197
198
199
200

201
202
203
204
205
206
207
208







-
+







    set x [encoding convertfrom jis0208 $a]
    list [string length $x] [string index $x 0]
} "512 乎"

test encoding-8.1 {Tcl_ExternalToUtf} {
    set f [open [file join [temporaryDirectory] dummy] w]
    fconfigure $f -translation binary
    puts -nonewline $f "ab\x8C\xC1g"
    puts -nonewline $f "ab\x8c\xc1g"
    close $f
    set f [open [file join [temporaryDirectory] dummy] r]
    fconfigure $f -translation lf -encoding shiftjis
    set x [read $f]
    close $f
    file delete [file join [temporaryDirectory] dummy]
    return $x
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
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







-
+













-
+





-
+



-
+


-
+







    close $f
    set f [open [file join [temporaryDirectory] dummy] r]
    fconfigure $f -translation binary
    set x [read $f]
    close $f
    file delete [file join [temporaryDirectory] dummy]
    return $x
} "ab\x8C\xC1g"
} "ab\x8c\xc1g"

test encoding-11.1 {LoadEncodingFile: unknown encoding} {testencoding} {
    set system [encoding system]
    set path [encoding dirs]
    encoding system iso8859-1
    encoding dirs {}
    llength jis0208	;# Shimmer any cached Tcl_Encoding in shared literal
    set x [list [catch {encoding convertto jis0208 乎} msg] $msg]
    encoding dirs $path
    encoding system $system
    lappend x [encoding convertto jis0208 乎]
} {1 {unknown encoding "jis0208"} 8C}
test encoding-11.2 {LoadEncodingFile: single-byte} {
    encoding convertfrom jis0201 \xA1
    encoding convertfrom jis0201 \xa1
} 。
test encoding-11.3 {LoadEncodingFile: double-byte} {
    encoding convertfrom jis0208 8C
} 乎
test encoding-11.4 {LoadEncodingFile: multi-byte} {
    encoding convertfrom shiftjis \x8C\xC1
    encoding convertfrom shiftjis \x8c\xc1
} 乎
test encoding-11.5 {LoadEncodingFile: escape file} {
    encoding convertto iso2022 乎
} \x1B\$B8C\x1B(B
} \x1b\$B8C\x1b(B
test encoding-11.5.1 {LoadEncodingFile: escape file} {
    encoding convertto iso2022-jp 乎
} \x1B\$B8C\x1B(B
} \x1b\$B8C\x1b(B
test encoding-11.6 {LoadEncodingFile: invalid file} -constraints {testencoding} -setup {
    set system [encoding system]
    set path [encoding dirs]
    encoding system iso8859-1
} -body {
    cd [temporaryDirectory]
    encoding dirs [file join tmp encoding]
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
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







-
+


-
+













-
-
+
+












-
+



-
+










-
-
+
+

-
+

-
-
+
+



-
-
+
+




-
-
+
+




-
-
+
+




-
-
+
+




-
-
+
+




-
+





-
-
+
+




-
-
+
+




-
-
+
+




-
-
+
+




-
-
+
+

-
+












-
+




-
+




-
+














-
+






+
+
+
+
+
+
-
-
+
+





-
+








-
+










-
+

-
+

-
+

-
+





-
+

-
+











-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+


-
-
+
+

-
+






-
-
+
+

















+
+
+

-
-
+
+
+
+
+
+
+
+


-
-
+
+



-
+




-
+


-
+

-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+





-
+


-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+


-
+


-
+


-
+


-
-
+
+

-
+


-
+







    encoding convertto utf-16le 😹
} =Ø9Þ
test encoding-11.9 {encoding: extended Unicode UTF-16} {
    encoding convertto utf-16be 😹
} Ø=Þ9
test encoding-11.10 {encoding: extended Unicode UTF-32} {
    encoding convertto utf-32le 😹
} 9\xF6\x01\x00
} 9\xf6\x01\x00
test encoding-11.11 {encoding: extended Unicode UTF-32} {
    encoding convertto utf-32be 😹
} \x00\x01\xF69
} \x00\x01\xf69
# OpenEncodingFile is fully tested by the rest of the tests in this file.

test encoding-12.1 {LoadTableEncoding: normal encoding} {
    set x [encoding convertto iso8859-3 Ġ]
    append x [encoding convertto -profile tcl8 iso8859-3 Õ]
    append x [encoding convertfrom iso8859-3 Õ]
} "Õ?Ġ"
test encoding-12.2 {LoadTableEncoding: single-byte encoding} {
    set x [encoding convertto iso8859-3 abĠg]
    append x [encoding convertfrom iso8859-3 abÕg]
} "abÕgabĠg"
test encoding-12.3 {LoadTableEncoding: multi-byte encoding} {
    set x [encoding convertto shiftjis ab乎g]
    append x [encoding convertfrom shiftjis ab\x8C\xC1g]
} "ab\x8C\xC1gab乎g"
    append x [encoding convertfrom shiftjis ab\x8c\xc1g]
} "ab\x8c\xc1gab乎g"
test encoding-12.4 {LoadTableEncoding: double-byte encoding} {
    set x [encoding convertto jis0208 乎α]
    append x [encoding convertfrom jis0208 8C&A]
} "8C&A乎α"
test encoding-12.5 {LoadTableEncoding: symbol encoding} {
    set x [encoding convertto symbol γ]
    append x [encoding convertto symbol g]
    append x [encoding convertfrom symbol g]
} "ggγ"

test encoding-13.1 {LoadEscapeTable} {
    encoding convertto iso2022 ab乎棙g
} ab\x1B\$B8C\x1B\$\(DD%\x1B(Bg
} ab\x1b\$B8C\x1b\$\(DD%\x1b(Bg

test encoding-15.1 {UtfToUtfProc} {
    encoding convertto utf-8 £
} "\xC2\xA3"
} "\xc2\xa3"
test encoding-15.2 {UtfToUtfProc null character output} testbytestring {
    binary scan [testbytestring [encoding convertto utf-8 \x00]] H* z
    set z
} 00
test encoding-15.3 {UtfToUtfProc null character input} teststringbytes {
    set y [encoding convertfrom utf-8 [encoding convertto utf-8 \x00]]
    binary scan [teststringbytes $y] H* z
    set z
} c080
test encoding-15.4 {UtfToUtfProc emoji character input} -body {
    set x \xED\xA0\xBD\xED\xB8\x82
    set y [encoding convertfrom -profile tcl8 utf-8 \xED\xA0\xBD\xED\xB8\x82]
    set x \xed\xa0\xbd\xed\xb8\x82
    set y [encoding convertfrom -profile tcl8 utf-8 \xed\xa0\xbd\xed\xb8\x82]
    list [string length $x] $y
} -result "6 \uD83D\uDE02"
} -result "6 \ud83d\ude02"
test encoding-15.5 {UtfToUtfProc emoji character input} {
    set x \xF0\x9F\x98\x82
    set y [encoding convertfrom utf-8 \xF0\x9F\x98\x82]
    set x \xf0\x9f\x98\x82
    set y [encoding convertfrom utf-8 \xf0\x9f\x98\x82]
    list [string length $x] $y
} "4 😂"
test encoding-15.6 {UtfToUtfProc emoji character output} {
    set x \uDE02\uD83D\uDE02\uD83D
    set y [encoding convertto -profile tcl8 utf-8 \uDE02\uD83D\uDE02\uD83D]
    set x \ude02\ud83d\ude02\ud83d
    set y [encoding convertto -profile tcl8 utf-8 \ude02\ud83d\ude02\ud83d]
    binary scan $y H* z
    list [string length $y] $z
} {12 edb882eda0bdedb882eda0bd}
test encoding-15.7 {UtfToUtfProc emoji character output} {
    set x \uDE02\uD83D\uD83D
    set y [encoding convertto -profile tcl8 utf-8 \uDE02\uD83D\uD83D]
    set x \ude02\ud83d\ud83d
    set y [encoding convertto -profile tcl8 utf-8 \ude02\ud83d\ud83d]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {3 9 edb882eda0bdeda0bd}
test encoding-15.8 {UtfToUtfProc emoji character output} {
    set x \uDE02\uD83Dé
    set y [encoding convertto -profile tcl8 utf-8 \uDE02\uD83Dé]
    set x \ude02\ud83dé
    set y [encoding convertto -profile tcl8 utf-8 \ude02\ud83dé]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {3 8 edb882eda0bdc3a9}
test encoding-15.9 {UtfToUtfProc emoji character output} {
    set x \uDE02\uD83DX
    set y [encoding convertto -profile tcl8 utf-8 \uDE02\uD83DX]
    set x \ude02\ud83dx
    set y [encoding convertto -profile tcl8 utf-8 \ude02\ud83dX]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {3 7 edb882eda0bd58}
test encoding-15.10 {UtfToUtfProc high surrogate character output} {
    set x \uDE02é
    set y [encoding convertto -profile tcl8 utf-8 \uDE02é]
    set x \ude02é
    set y [encoding convertto -profile tcl8 utf-8 \ude02é]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {2 5 edb882c3a9}
test encoding-15.11 {UtfToUtfProc low surrogate character output} {
    set x \uDA02é
    set x \uda02é
    set y [encoding convertto -profile tcl8 utf-8 \uDA02é]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {2 5 eda882c3a9}
test encoding-15.12 {UtfToUtfProc high surrogate character output} {
    set x \uDE02Y
    set y [encoding convertto -profile tcl8 utf-8 \uDE02Y]
    set x \ude02Y
    set y [encoding convertto -profile tcl8 utf-8 \ude02Y]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {2 4 edb88259}
test encoding-15.13 {UtfToUtfProc low surrogate character output} {
    set x \uDA02Y
    set y [encoding convertto -profile tcl8 utf-8 \uDA02Y]
    set x \uda02Y
    set y [encoding convertto -profile tcl8 utf-8 \uda02Y]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {2 4 eda88259}
test encoding-15.14 {UtfToUtfProc high surrogate character output} {
    set x \uDE02
    set y [encoding convertto -profile tcl8 utf-8 \uDE02]
    set x \ude02
    set y [encoding convertto -profile tcl8 utf-8 \ude02]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {1 3 edb882}
test encoding-15.15 {UtfToUtfProc low surrogate character output} {
    set x \uDA02
    set y [encoding convertto -profile tcl8 utf-8 \uDA02]
    set x \uda02
    set y [encoding convertto -profile tcl8 utf-8 \uda02]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {1 3 eda882}
test encoding-15.16 {UtfToUtfProc: Invalid 4-byte UTF-8, see [ed29806ba]} {
    set x \xF0\xA0\xA1\xC2
    set y [encoding convertfrom -profile tcl8 utf-8 \xF0\xA0\xA1\xC2]
    set x \xf0\xa0\xa1\xc2
    set y [encoding convertfrom -profile tcl8 utf-8 \xf0\xa0\xa1\xc2]
    list [string length $x] $y
} "4 \xF0\xA0\xA1\xC2"
} "4 \xf0\xa0\xa1\xc2"
test encoding-15.17 {UtfToUtfProc emoji character output} {
    set x 😂
    set y [encoding convertto utf-8 😂]
    binary scan $y H* z
    list [string length $y] $z
} {4 f09f9882}
test encoding-15.18 {UtfToUtfProc CESU-8 6-byte sequence} {
    set y [encoding convertto cesu-8 \U10000]
    binary scan $y H* z
    list [string length $y] $z
} {6 eda080edb080}
test encoding-15.19 {UtfToUtfProc CESU-8 upper surrogate} {
    set y [encoding convertto cesu-8 \uD800]
    set y [encoding convertto cesu-8 \ud800]
    binary scan $y H* z
    list [string length $y] $z
} {3 eda080}
test encoding-15.20 {UtfToUtfProc CESU-8 lower surrogate} {
    set y [encoding convertto cesu-8 \uDC00]
    set y [encoding convertto cesu-8 \udc00]
    binary scan $y H* z
    list [string length $y] $z
} {3 edb080}
test encoding-15.21 {UtfToUtfProc CESU-8 noncharacter} {
    set y [encoding convertto cesu-8 \uFFFF]
    set y [encoding convertto cesu-8 \uffff]
    binary scan $y H* z
    list [string length $y] $z
} {3 efbfbf}
test encoding-15.22 {UtfToUtfProc CESU-8 bug [048dd20b4171c8da]} {
    set y [encoding convertto cesu-8 \x80]
    binary scan $y H* z
    list [string length $y] $z
} {2 c280}
test encoding-15.23 {UtfToUtfProc CESU-8 bug [048dd20b4171c8da]} {
    set y [encoding convertto cesu-8 \u100]
    binary scan $y H* z
    list [string length $y] $z
} {2 c480}
test encoding-15.24 {UtfToUtfProc CESU-8 bug [048dd20b4171c8da]} {
    set y [encoding convertto cesu-8 \u3FF]
    set y [encoding convertto cesu-8 \u3ff]
    binary scan $y H* z
    list [string length $y] $z
} {2 cfbf}
test encoding-15.25 {UtfToUtfProc CESU-8} {
    encoding convertfrom cesu-8 \x00
} \x00
test {encoding-15.26 cesu-8 tclnull default} {UtfToUtfProc CESU-8} -body {
    encoding convertfrom cesu-8 \xc0\x80
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
test {encoding-15.26 cesu-8 tclnull strict} {UtfToUtfProc CESU-8} -body {
    encoding convertfrom -profile strict cesu-8 \xc0\x80
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
test encoding-15.26 {UtfToUtfProc CESU-8} {
    encoding convertfrom -profile tcl8 cesu-8 \xC0\x80
test {encoding-15.26 cesu-8 tclnull tcl8} {UtfToUtfProc CESU-8} {
    encoding convertfrom -profile tcl8 cesu-8 \xc0\x80
} \x00
test encoding-15.27 {UtfToUtfProc -profile strict CESU-8} {
    encoding convertfrom -profile strict cesu-8 \x00
} \x00
test encoding-15.28 {UtfToUtfProc -profile strict CESU-8} -body {
    encoding convertfrom -profile strict cesu-8 \xC0\x80
    encoding convertfrom -profile strict cesu-8 \xc0\x80
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
test encoding-15.29 {UtfToUtfProc CESU-8} {
    encoding convertto cesu-8 \x00
} \x00
test encoding-15.30 {UtfToUtfProc -profile strict CESU-8} {
    encoding convertto -profile strict cesu-8 \x00
} \x00
test encoding-15.31 {UtfToUtfProc -profile strict CESU-8 (bytes F0-F4 are invalid)} -body {
    encoding convertfrom -profile strict cesu-8 \xF1\x86\x83\x9C
    encoding convertfrom -profile strict cesu-8 \xf1\x86\x83\x9c
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xF1'}
test encoding-15.32 {UtfToUtfProc CESU-8 [2f22a7364d]} -body {
    encoding convertto cesu-8 \U1f600
} -result \xED\xA0\xBD\xED\xB8\x80

test encoding-16.1 {Utf16ToUtfProc} -body {
    set val [encoding convertfrom utf-16 NN]
    list $val [format %x [scan $val %c]]
} -result "乎 4e4e"
test encoding-16.2 {Utf16ToUtfProc} -body {
    set val [encoding convertfrom utf-16 "\xD8\xD8\xDC\xDC"]
    set val [encoding convertfrom utf-16 "\xd8\xd8\xdc\xdc"]
    list $val [format %x [scan $val %c]]
} -result "\U460DC 460dc"
} -result "\U460dc 460dc"
test encoding-16.3 {Utf16ToUtfProc} -body {
    set val [encoding convertfrom -profile tcl8 utf-16 "\xDC\xDC"]
    set val [encoding convertfrom -profile tcl8 utf-16 "\xdc\xdc"]
    list $val [format %x [scan $val %c]]
} -result "\uDCDC dcdc"
} -result "\udcdc dcdc"
test encoding-16.4 {Ucs2ToUtfProc} -body {
    set val [encoding convertfrom ucs-2 NN]
    list $val [format %x [scan $val %c]]
} -result "乎 4e4e"
test encoding-16.5 {Ucs2ToUtfProc} -body {
    set val [encoding convertfrom ucs-2 "\xD8\xD8\xDC\xDC"]
    set val [encoding convertfrom ucs-2 "\xd8\xd8\xdc\xdc"]
    list $val [format %x [scan $val %c]]
} -result "\U460DC 460dc"
} -result "\U460dc 460dc"
test encoding-16.6 {Utf32ToUtfProc} -body {
    set val [encoding convertfrom utf-32le NN\0\0]
    list $val [format %x [scan $val %c]]
} -result "乎 4e4e"
test encoding-16.7 {Utf32ToUtfProc} -body {
    set val [encoding convertfrom utf-32be \0\0NN]
    list $val [format %x [scan $val %c]]
} -result "乎 4e4e"
test encoding-16.8 {Utf32ToUtfProc} -body {
    set val [encoding convertfrom -profile tcl8 utf-32 \x41\x00\x00\x41]
    list $val [format %x [scan $val %c]]
} -result "\uFFFD fffd"
} -result "\ufffd fffd"
test encoding-16.9 {Utf32ToUtfProc} -body {
    encoding convertfrom -profile tcl8 utf-32le \x00\xD8\x00\x00
} -result \uD800
    encoding convertfrom -profile tcl8 utf-32le \x00\xd8\x00\x00
} -result \ud800
test encoding-16.10 {Utf32ToUtfProc} -body {
    encoding convertfrom -profile tcl8 utf-32le \x00\xDC\x00\x00
} -result \uDC00
    encoding convertfrom -profile tcl8 utf-32le \x00\xdc\x00\x00
} -result \udc00
test encoding-16.11 {Utf32ToUtfProc} -body {
    encoding convertfrom -profile tcl8 utf-32le \x00\xD8\x00\x00\x00\xDC\x00\x00
} -result \uD800\uDC00
    encoding convertfrom -profile tcl8 utf-32le \x00\xd8\x00\x00\x00\xdc\x00\x00
} -result \ud800\udc00
test encoding-16.12 {Utf32ToUtfProc} -body {
    encoding convertfrom -profile tcl8 utf-32le \x00\xDC\x00\x00\x00\xD8\x00\x00
} -result \uDC00\uD800
    encoding convertfrom -profile tcl8 utf-32le \x00\xdc\x00\x00\x00\xd8\x00\x00
} -result \udc00\ud800
test encoding-16.13 {Utf16ToUtfProc} -body {
    encoding convertfrom -profile tcl8 utf-16le \x00\xD8
} -result \uD800
    encoding convertfrom -profile tcl8 utf-16le \x00\xd8
} -result \ud800
test encoding-16.14 {Utf16ToUtfProc} -body {
    encoding convertfrom -profile tcl8 utf-16le \x00\xDC
} -result \uDC00
    encoding convertfrom -profile tcl8 utf-16le \x00\xdc
} -result \udc00
test encoding-16.15 {Utf16ToUtfProc} -body {
    encoding convertfrom utf-16le \x00\xD8\x00\xDC
    encoding convertfrom utf-16le \x00\xd8\x00\xdc
} -result \U010000
test encoding-16.16 {Utf16ToUtfProc} -body {
    encoding convertfrom -profile tcl8 utf-16le \x00\xDC\x00\xD8
} -result \uDC00\uD800
    encoding convertfrom -profile tcl8 utf-16le \x00\xdc\x00\xd8
} -result \udc00\ud800
test encoding-16.17 {Utf32ToUtfProc} -body {
    list [encoding convertfrom -profile strict -failindex  idx utf-32le \x41\x00\x00\x00\x00\xD8\x00\x00\x42\x00\x00\x00] [set idx]
    list [encoding convertfrom -profile strict -failindex  idx utf-32le \x41\x00\x00\x00\x00\xd8\x00\x00\x42\x00\x00\x00] [set idx]
} -result {A 4}

test encoding-16.18 {
    Utf16ToUtfProc, Tcl_UniCharToUtf, surrogate pairs in utf-16
} -body {
    apply [list {} {
	for {set i 0xD800} {$i < 0xDBFF} {incr i} {
	    for {set j 0xDC00} {$j < 0xDFFF} {incr j} {
	for {set i 0xD800} {$i < 0xdbff} {incr i} {
	    for {set j 0xDC00} {$j < 0xdfff} {incr j} {
		set string [binary format S2 [list $i $j]]
		set status [catch {
		    set decoded [encoding convertfrom utf-16be $string]
		    set encoded [encoding convertto utf-16be $decoded]
		}]
		if {$status || ( $encoded ne $string )} {
		    return [list [format %x $i] [format %x $j]]
		}
	    }
	}
	return done
    } [namespace current]]
} -result done
test encoding-16.19.strict {Utf16ToUtfProc, bug [d19fe0a5b]} -body {
    encoding convertfrom -profile strict utf-16 "\x41\x41\x41"
} -returnCodes 1 -result {unexpected byte sequence starting at index 2: '\x41'}
test encoding-16.19.tcl8 {Utf16ToUtfProc, bug [d19fe0a5b]} -body {
    encoding convertfrom -profile strict utf-16 "\x41\x41\x41"
} -returnCodes 1 -result {unexpected byte sequence starting at index 2: '\x41'}
test encoding-16.19.tcl8 {Utf16ToUtfProc, bug [d19fe0a5b]} -body {
    encoding convertfrom -profile tcl8 utf-16 "\x41\x41\x41"
} -result \u4141\uFFFD
test encoding-16.20.tcl8 {Utf16ToUtfProc, bug [d19fe0a5b]} -body {
} -result \u4141\ufffd
test encoding-16.19.strict {Utf16ToUtfProc, bug [d19fe0a5b]} -body {
    encoding convertfrom -profile strict utf-16 "\x41\x41\x41"
} -returnCodes 1 -result {unexpected byte sequence starting at index 2: '\x41'}
test encoding-16.20 {utf16ToUtfProc, bug [d19fe0a5b]} -body {
    encoding convertfrom utf-16 "\xd8\xd8"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xD8'}
test encoding-16.20-tcl8 {utf16ToUtfProc, bug [d19fe0a5b]} -body {
    encoding convertfrom -profile tcl8 utf-16 "\xD8\xD8"
} -result \uD8D8
test encoding-16.20.strict {Utf16ToUtfProc, bug [d19fe0a5b]} -body {
    encoding convertfrom -profile strict utf-16 "\xD8\xD8"
test encoding-16.20-strict {utf16ToUtfProc, bug [d19fe0a5b]} -body {
    encoding convertfrom -profile strict utf-16 "\xd8\xd8"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xD8'}
test encoding-16.21.tcl8 {Utf32ToUtfProc, bug [d19fe0a5b]} -body {
    encoding convertfrom -profile tcl8 utf-32 "\x00\x00\x00\x00\x41\x41"
} -result \x00\uFFFD
} -result \x00\ufffd
test encoding-16.21.strict {Utf32ToUtfProc, bug [d19fe0a5b]} -body {
    encoding convertfrom -profile strict utf-32 "\x00\x00\x00\x00\x41\x41"
} -returnCodes 1 -result {unexpected byte sequence starting at index 4: '\x41'}
test encoding-16.22 {Utf16ToUtfProc, strict, bug [db7a085bd9]} -body {
    encoding convertfrom -profile strict utf-16le \x00\xD8
    encoding convertfrom -profile strict utf-16le \x00\xd8
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x00'}
test encoding-16.23 {Utf16ToUtfProc, strict, bug [db7a085bd9]} -body {
    encoding convertfrom -profile strict utf-16le \x00\xDC
    encoding convertfrom -profile strict utf-16le \x00\xdc
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x00'}
test encoding-16.24 {Utf32ToUtfProc} -body {
    encoding convertfrom -profile tcl8 utf-32 "\xFF\xFF\xFF\xFF"
} -result \uFFFD

test {encoding-16.24 utf-8 invalid default} {Parse invalid utf-8, strict} -body {
    string length [encoding convertfrom utf-8 "\xC0\x80"]
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
test {encoding-16.24 utf-8 invalid strict} {Parse invalid utf-8, strict} -body {
    string length [encoding convertfrom -profile strict utf-8 "\xc0\x80"]
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
test {encoding-16.24 utf-8 invalid tcl8} {UtfToUtfProc utf-8} {
    encoding convertfrom -profile tcl8 utf-8 \xc0\x80
} \x00
test {encoding-16.25 default} {Utf32ToUtfProc} -body {
    encoding convertfrom utf-32 "\x01\x00\x00\x01"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x01'}
test encoding-16.25.strict {Utf32ToUtfProc} -body {
    encoding convertfrom -profile strict utf-32 "\x01\x00\x00\x01"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x01'}
test encoding-16.25.tcl8 {Utf32ToUtfProc} -body {
    encoding convertfrom -profile tcl8 utf-32 "\x01\x00\x00\x01"
} -result \uFFFD
} -result \ufffd

test encoding-17.1 {UtfToUtf16Proc} -body {
    encoding convertto utf-16 "\U460DC"
} -result "\xD8\xD8\xDC\xDC"
    encoding convertto utf-16 "\U460dc"
} -result "\xd8\xd8\xdc\xdc"
test encoding-17.2 {UtfToUcs2Proc} -body {
    encoding convertfrom utf-16 \xD8\xD8\xDC\xDC
} -result "\U460DC"
    encoding convertfrom utf-16 \xd8\xd8\xdc\xdc
} -result "\U460dc"
test encoding-17.3 {UtfToUtf16Proc} -body {
    encoding convertto -profile tcl8 utf-16be "\uDCDC"
} -result "\xDC\xDC"
    encoding convertto -profile tcl8 utf-16be "\udcdc"
} -result "\xdc\xdc"
test encoding-17.4 {UtfToUtf16Proc} -body {
    encoding convertto -profile tcl8 utf-16le "\uD8D8"
} -result "\xD8\xD8"
    encoding convertto -profile tcl8 utf-16le "\ud8d8"
} -result "\xd8\xd8"
test encoding-17.5 {UtfToUtf32Proc} -body {
    encoding convertto utf-32le "\U460DC"
} -result "\xDC\x60\x04\x00"
    encoding convertto utf-32le "\U460dc"
} -result "\xdc\x60\x04\x00"
test encoding-17.6 {UtfToUtf32Proc} -body {
    encoding convertto utf-32be "\U460DC"
    encoding convertto utf-32be "\U460dc"
} -result "\x00\x04\x60\xDC"
test encoding-17.7 {UtfToUtf16Proc} -body {
    encoding convertto -profile strict utf-16be "\uDCDC"
    encoding convertto -profile strict utf-16be "\udcdc"
} -returnCodes error -result {unexpected character at index 0: 'U+00DCDC'}
test encoding-17.8 {UtfToUtf16Proc} -body {
    encoding convertto -profile strict utf-16le "\uD8D8"
    encoding convertto -profile strict utf-16le "\ud8d8"
} -returnCodes error -result {unexpected character at index 0: 'U+00D8D8'}
test encoding-17.9 {Utf32ToUtfProc} -body {
    encoding convertfrom -profile strict utf-32 "\xFF\xFF\xFF\xFF"
    encoding convertfrom -profile strict utf-32 "\xff\xff\xff\xff"
} -returnCodes error -result {unexpected byte sequence starting at index 0: '\xFF'}
test encoding-17.10 {Utf32ToUtfProc} -body {
    encoding convertfrom -profile tcl8 utf-32 "\xFF\xFF\xFF\xFF"
} -result \uFFFD
    encoding convertfrom -profile tcl8 utf-32 "\xff\xff\xff\xff"
} -result \ufffd
test encoding-17.11 {Utf32ToUtfProc} -body {
    encoding convertfrom -profile strict utf-32le "\x00\xD8\x00\x00"
    encoding convertfrom -profile strict utf-32le "\x00\xd8\x00\x00"
} -returnCodes error -result {unexpected byte sequence starting at index 0: '\x00'}
test encoding-17.12 {Utf32ToUtfProc} -body {
    encoding convertfrom -profile strict utf-32le "\x00\xDC\x00\x00"
    encoding convertfrom -profile strict utf-32le "\x00\xdc\x00\x00"
} -returnCodes error -result {unexpected byte sequence starting at index 0: '\x00'}

test encoding-18.1 {TableToUtfProc on invalid input} -body {
	list [catch {encoding convertto -profile tcl8 jis0208 \\} res] $res
} -result {0 !)}
test encoding-18.2 {TableToUtfProc on invalid input with -profile strict} -body {
	list [catch {encoding convertto -profile strict jis0208 \\} res] $res
664
665
666
667
668
669
670
671
672
673
674




675
676
677
678
679
680
681
697
698
699
700
701
702
703




704
705
706
707
708
709
710
711
712
713
714







-
-
-
-
+
+
+
+







test encoding-21.1 {EscapeToUtfProc} {
} {}

test encoding-22.1 {EscapeFromUtfProc} {
} {}

set iso2022encData "\x1B\$B;d\$I\$b\$G\$O!\"%A%C%W\$49XF~;~\$K\$4EPO?\$\$\$?\$@\$\$\$?\$4=;=j\$r%-%c%C%7%e%\"%&%H\$N:]\$N\x1B(B
\x1B\$B>.@Z<jAwIU@h\$H\$7\$F;HMQ\$7\$F\$*\$j\$^\$9!#62\$lF~\$j\$^\$9\$,!\"@5\$7\$\$=;=j\$r\$4EPO?\$7\$J\$*\x1B(B
\x1B\$B\$*4j\$\$\$\$\$?\$7\$^\$9!#\$^\$?!\"BgJQ62=L\$G\$9\$,!\"=;=jJQ99\$N\$\"\$H!\"F|K\\8l%5!<%S%9It!J\x1B(B
casino_japanese@___.com \x1B\$B!K\$^\$G\$4=;=jJQ99:Q\$NO\"Mm\$r\$\$\$?\$@\$1\$J\$\$\$G\x1B(B
\x1B\$B\$7\$g\$&\$+!)\x1B(B"
\x1b\$B>.@Z<jAwIU@h\$H\$7\$F;HMQ\$7\$F\$*\$j\$^\$9!#62\$lF~\$j\$^\$9\$,!\"@5\$7\$\$=;=j\$r\$4EPO?\$7\$J\$*\x1b(B
\x1b\$B\$*4j\$\$\$\$\$?\$7\$^\$9!#\$^\$?!\"BgJQ62=L\$G\$9\$,!\"=;=jJQ99\$N\$\"\$H!\"F|K\\8l%5!<%S%9It!J\x1b(B
casino_japanese@___.com \x1b\$B!K\$^\$G\$4=;=jJQ99:Q\$NO\"Mm\$r\$\$\$?\$@\$1\$J\$\$\$G\x1b(B
\x1b\$B\$7\$g\$&\$+!)\x1b(B"

set iso2022uniData [encoding convertfrom iso2022-jp $iso2022encData]
set iso2022uniData2 "私どもでは、チップご購入時にご登録いただいたご住所をキャッシュアウトの際の
小切手送付先として使用しております。恐れ入りますが、正しい住所をご登録しなお
お願いいたします。また、大変恐縮ですが、住所変更のあと、日本語サービス部(
casino_japanese@___.com )までご住所変更済の連絡をいただけないで
しょうか?"
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
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







-
+

















-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+

+
+
+
-
+


-
+


-
-
-
-
-
+
+
+
+
+

+
+
+
-
+


+
+
+
+
+
+
+
+
+

-
+


-
-
+
+




-
-
+
+

-
-
+
+

-
-
+
+

-
+
+
+
+








-
+


-
+


-
+





-
+


-
+


-
+


-
-
+
+

-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+


-
-
+
+

-
-
-
-
+
+
+
+
+
+
+


-
+


-
-
+
+

-
+


-
-
+
+


-
+

-
+







    runInSubprocess {
	encoding system cp1252;	# Bug #2891556 crash revelator
	fconfigure stdout -encoding iso2022-jp
	puts ab乎棙g
	set env(TCL_FINALIZE_ON_EXIT) 1
	exit
    }
} "ab\x1B\$B8C\x1B\$(DD%\x1B(Bg"
} "ab\x1b\$B8C\x1b\$(DD%\x1b(Bg"
test encoding-24.3 {EscapeFreeProc on open channels} {stdio} {
    # Bug #219314 - if we don't free escape encodings correctly on channel
    # closure, we go boom
    set file [makeFile {
	encoding system iso2022-jp
	set a "乎乞也"; # 3 Japanese Kanji letters
	puts $a
    } iso2022.tcl]
    set f [open "|[list [interpreter] $file]"]
    fconfigure $f -encoding iso2022-jp
    set count [gets $f line]
    close $f
    removeFile iso2022.tcl
    list $count $line
} [list 3 乎乞也]

test encoding-24.4.strict {Parse invalid utf-8, strict} -body {
    encoding convertfrom -profile strict utf-8 "\xC0\x80"
    encoding convertfrom -profile strict utf-8 "\xc0\x80"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
test encoding-24.4.tcl8 {UtfToUtfProc utf-8} {
    encoding convertfrom -profile tcl8 utf-8 \xC0\x80
    encoding convertfrom -profile tcl8 utf-8 \xc0\x80
} \x00
test encoding-24.5 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom -profile tcl8 utf-8 "\xC0\x81"]
    string length [encoding convertfrom -profile tcl8 utf-8 "\xc0\x81"]
} 2
test encoding-24.6 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom -profile tcl8 utf-8 "\xC1\xBF"]
    string length [encoding convertfrom -profile tcl8 utf-8 "\xc1\xBF"]
} 2
test encoding-24.7 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom utf-8 "\xC2\x80"]
    string length [encoding convertfrom utf-8 "\xc2\x80"]
} 1
test encoding-24.8 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom -profile tcl8 utf-8 "\xE0\x80\x80"]
    string length [encoding convertfrom -profile tcl8 utf-8 "\xe0\x80\x80"]
} 3
test encoding-24.9 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom -profile tcl8 utf-8 "\xE0\x9F\xBF"]
    string length [encoding convertfrom -profile tcl8 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"]
    string length [encoding convertfrom utf-8 "\xe0\xa0\x80"]
} 1
test encoding-24.11 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom -profile tcl8 utf-8 "\xEF\xBF\xBF"]
    string length [encoding convertfrom -profile tcl8 utf-8 "\xef\xbf\xbf"]
} 1
test encoding-24.12.default {Parse invalid utf-8} -body {
    encoding convertfrom utf-8 "\xC0\x81"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
test encoding-24.12 {Parse invalid utf-8} -body {
test encoding-24.12.tcl8 {Parse invalid utf-8} -body {
    encoding convertfrom -profile tcl8 utf-8 "\xC0\x81"
} -result \xC0\x81
test encoding-24.12.1 {Parse invalid utf-8} -body {
test encoding-24.12.strict {Parse invalid utf-8} -body {
    encoding convertfrom -profile strict utf-8 "\xC0\x81"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
test encoding-24.13 {Parse invalid utf-8} -body {
    encoding convertfrom -profile tcl8 utf-8 "\xC1\xBF"
} -result \xC1\xBF
test encoding-24.13.1 {Parse invalid utf-8} -body {
    encoding convertfrom -profile strict utf-8 "\xC1\xBF"
test encoding-24.13.default {Parse invalid utf-8} -body {
    encoding convertfrom -profile strict utf-8 "\xc1\xbf"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC1'}
test encoding-24.13.strict {Parse invalid utf-8} -body {
    encoding convertfrom -profile strict utf-8 "\xc1\xbf"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC1'}
test encoding-24.13.tcl8 {Parse invalid utf-8} -body {
    encoding convertfrom -profile tcl8 utf-8 "\xC1\xBF"
} -result \xC1\xBF
test encoding-24.14 {Parse valid utf-8} {
test encoding-24.14.default {Parse valid utf-8} {
    encoding convertfrom utf-8 "\xC2\x80"
} \x80
test encoding-24.14.strict {Parse valid utf-8} {
    encoding convertfrom -profile strict utf-8 "\xC2\x80"
} \x80
test encoding-24.14.tcl8 {Parse valid utf-8} {
    encoding convertfrom -profile tcl8 utf-8 "\xC2\x80"
} \x80
test encoding-24.15.default {Parse invalid utf-8, default} -body {
    encoding convertfrom -profile strict utf-8 "Z\xe0\x80"
} -returnCodes 1 -result "unexpected byte sequence starting at index 1: '\\xE0'"
test encoding-24.15.strict {Parse invalid utf-8, -profile strict} -body {
    encoding convertfrom -profile strict utf-8 "Z\xE0\x80"
    encoding convertfrom -profile strict utf-8 "Z\xe0\x80"
} -returnCodes 1 -result "unexpected byte sequence starting at index 1: '\\xE0'"
test encoding-24.15.tcl8 {Parse invalid utf-8, -profile tcl8} -body {
    encoding convertfrom -profile tcl8 utf-8 "Z\xE0\x80"
} -result Z\xE0\u20AC
    encoding convertfrom -profile tcl8 utf-8 "Z\xe0\x80"
} -result Z\xe0\u20ac
test encoding-24.16 {Parse valid or invalid utf-8} -constraints testbytestring -body {
    encoding convertto utf-8 [testbytestring "Z\u4343\x80"]
} -returnCodes 1 -result {expected byte sequence but character 1 was '䍃€' (U+004343)}
test encoding-24.17 {Parse valid or invalid utf-8} -constraints testbytestring -body {
    encoding convertto utf-8 [testbytestring "Z\xE0\x80"]
} -result "Z\xC3\xA0\xE2\x82\xAC"
    encoding convertto utf-8 [testbytestring "Z\xe0\x80"]
} -result "Z\xC3\xa0\xe2\x82\xac"
test encoding-24.18 {Parse valid or invalid utf-8} -constraints testbytestring -body {
    encoding convertto utf-8 [testbytestring "Z\xE0\x80xxxxxx"]
} -result "Z\xC3\xA0\xE2\x82\xACxxxxxx"
    encoding convertto utf-8 [testbytestring "Z\xe0\x80xxxxxx"]
} -result "Z\xc3\xa0\xe2\x82\xacxxxxxx"
test encoding-24.19.1 {Parse valid or invalid utf-8} -body {
    encoding convertto -profile tcl8 utf-8 "ZX\uD800"
} -result ZX\xED\xA0\x80
    encoding convertto -profile tcl8 utf-8 "ZX\ud800"
} -result ZX\xed\xa0\x80
test encoding-24.19.2 {Parse valid or invalid utf-8} -body {
    encoding convertto -profile strict utf-8 "ZX\uD800"
    encoding convertto -profile strict utf-8 "ZX\ud800"
} -returnCodes 1 -match glob -result "unexpected character at index 2: 'U+00D800'"
test encoding-24.19.3 {Parse valid or invalid utf-8} -body {
    encoding convertto utf-8 "ZX\ud800"
} -returnCodes 1 -match glob -result "unexpected character at index 2: 'U+00D800'"
test encoding-24.20 {Parse with -profile tcl8 but without providing encoding} -body {
    encoding convertfrom -profile tcl8 "\x20"
} -result {wrong # args: should be "::tcl::encoding::convertfrom ?-profile profile? ?-failindex var? encoding data" or "::tcl::encoding::convertfrom data"} -returnCodes error
test encoding-24.21 {Parse with -profile tcl8 but without providing encoding} -body {
    string length [encoding convertto -profile tcl8 "\x20"]
} -result {wrong # args: should be "::tcl::encoding::convertto ?-profile profile? ?-failindex var? encoding data" or "::tcl::encoding::convertto data"} -returnCodes error
test encoding-24.22 {Syntax error, two encodings} -body {
    encoding convertfrom iso8859-1 utf-8 "ZX\uD800"
    encoding convertfrom iso8859-1 utf-8 "ZX\ud800"
} -result {bad option "iso8859-1": must be -profile or -failindex} -returnCodes error
test encoding-24.23 {Syntax error, two encodings} -body {
    encoding convertto iso8859-1 utf-8 "ZX\uD800"
    encoding convertto iso8859-1 utf-8 "ZX\ud800"
} -result {bad option "iso8859-1": must be -profile or -failindex} -returnCodes error
test encoding-24.24 {Parse invalid utf-8 with -profile strict} -body {
    encoding convertfrom -profile strict utf-8 "\xC0\x80\x00\x00"
    encoding convertfrom -profile strict utf-8 "\xc0\x80\x00\x00"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
test encoding-24.25 {Parse invalid utf-8 with -profile strict} -body {
    encoding convertfrom -profile strict utf-8 "\x40\x80\x00\x00"
} -returnCodes 1 -result {unexpected byte sequence starting at index 1: '\x80'}
test encoding-24.26 {Parse valid utf-8 with -profile strict} -body {
    encoding convertfrom -profile strict utf-8 "\xF1\x80\x80\x80"
    encoding convertfrom -profile strict utf-8 "\xf1\x80\x80\x80"
} -result \U40000
test encoding-24.27 {Parse invalid utf-8 with -profile strict} -body {
    encoding convertfrom -profile strict utf-8 "\xF0\x80\x80\x80"
    encoding convertfrom -profile strict utf-8 "\xf0\x80\x80\x80"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xF0'}
test encoding-24.28 {Parse invalid utf-8 with -profile strict} -body {
    encoding convertfrom -profile strict utf-8 "\xFF\x00\x00"
    encoding convertfrom -profile strict utf-8 "\xff\x00\x00"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xFF'}
test encoding-24.29 {Parse invalid utf-8} -body {
    encoding convertfrom utf-8 \xEF\xBF\xBF
} -result \uFFFF
    encoding convertfrom utf-8 \xef\xbf\xbf
} -result \uffff
test encoding-24.30 {Parse noncharacter with -profile strict} -body {
    encoding convertfrom -profile strict utf-8 \xEF\xBF\xBF
} -result \uFFFF
    encoding convertfrom -profile strict utf-8 \xef\xbf\xbf
} -result \uffff
test encoding-24.31 {Parse invalid utf-8 with -profile tcl8} -body {
    encoding convertfrom -profile tcl8 utf-8 \xEF\xBF\xBF
} -result \uFFFF
test encoding-24.32 {Try to generate invalid utf-8} -body {
    encoding convertto utf-8 \uFFFF
} -result \xEF\xBF\xBF
    encoding convertfrom -profile tcl8 utf-8 \xef\xbf\xbf
} -result \uffff
test encoding-24.33 {Try to generate invalid utf-8} -body {
    encoding convertto utf-8 \uffff
} -result \xef\xbf\xbf
test encoding-24.33 {Try to generate invalid utf-8} -body {
    encoding convertto -profile strict utf-8 \uFFFF
} -result \xEF\xBF\xBF
    encoding convertto -profile strict utf-8 \uffff
} -result \xef\xbf\xbf
test encoding-24.34 {Try to generate invalid utf-8 with -profile tcl8} -body {
    encoding convertto -profile tcl8 utf-8 \uFFFF
} -result \xEF\xBF\xBF
    encoding convertto -profile tcl8 utf-8 \uffff
} -result \xef\xbf\xbf
test encoding-24.35 {Parse invalid utf-8} -body {
    encoding convertfrom -profile tcl8 utf-8 \xED\xA0\x80
} -result \uD800
    encoding convertfrom -profile tcl8 utf-8 \xed\xa0\x80
} -result \ud800
test encoding-24.36 {Parse invalid utf-8 with -profile strict} -body {
    encoding convertfrom -profile strict utf-8 \xED\xA0\x80
    encoding convertfrom -profile strict utf-8 \xed\xa0\x80
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xED'}
test encoding-24.37 {Parse invalid utf-8 with -profile tcl8} -body {
    encoding convertfrom -profile tcl8 utf-8 \xED\xA0\x80
} -result \uD800
    encoding convertfrom -profile tcl8 utf-8 \xed\xa0\x80
} -result \ud800
test encoding-24.38.1 {Try to generate invalid utf-8} -body {
    encoding convertto -profile tcl8 utf-8 \uD800
} -result \xED\xA0\x80
test encoding-24.38.2 {Try to generate invalid utf-8 - default profile} -body {
    encoding convertto utf-8 \uD800
    encoding convertto -profile tcl8 utf-8 \ud800
} -result \xed\xa0\x80
test {encoding-24.38.2 default} {Try to generate invalid utf-8} -body {
    encoding convertto -profile strict utf-8 \ud800
} -returnCodes 1 -result {unexpected character at index 0: 'U+00D800'}
test {encoding-24.38.2 strict} {Try to generate invalid utf-8} -body {
    encoding convertto -profile strict utf-8 \ud800
} -returnCodes 1 -result {unexpected character at index 0: 'U+00D800'}
test encoding-24.39 {Try to generate invalid utf-8 with -profile strict} -body {
    encoding convertto -profile strict utf-8 \uD800
    encoding convertto -profile strict utf-8 \ud800
} -returnCodes 1 -result {unexpected character at index 0: 'U+00D800'}
test encoding-24.40 {Try to generate invalid utf-8 with -profile tcl8} -body {
    encoding convertto -profile tcl8 utf-8 \uD800
} -result \xED\xA0\x80
    encoding convertto -profile tcl8 utf-8 \ud800
} -result \xed\xa0\x80
test encoding-24.41 {Parse invalid utf-8 with -profile strict} -body {
    encoding convertfrom -profile strict utf-8 \xED\xA0\x80\xED\xB0\x80
    encoding convertfrom -profile strict utf-8 \xed\xa0\x80\xed\xb0\x80
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xED'}
test encoding-24.42 {Parse invalid utf-8, fallback to cp1252 [885c86a9a0]} -body {
    encoding convertfrom -profile tcl8 utf-8 \xF0\x80\x80\x80
} -result \xF0\u20AC\u20AC\u20AC
    encoding convertfrom -profile tcl8 utf-8 \xf0\x80\x80\x80
} -result \xf0\u20ac\u20ac\u20ac
test encoding-24.43 {Parse invalid utf-8, fallback to cp1252 [885c86a9a0]} -body {
    encoding convertfrom -profile tcl8 utf-8 \x80
} -result \u20AC
} -result \u20ac
test encoding-24.44 {Try to generate invalid ucs-2 with -profile strict} -body {
    encoding convertto -profile strict ucs-2 \uD800
    encoding convertto -profile strict ucs-2 \ud800
} -returnCodes 1 -result {unexpected character at index 0: 'U+00D800'}
test encoding-24.45 {Try to generate invalid ucs-2 with -profile strict} -body {
    encoding convertto -profile strict ucs-2 \U10000
} -returnCodes 1 -result {unexpected character at index 0: 'U+010000'}

file delete [file join [temporaryDirectory] iso2022.txt]

960
961
962
963
964
965
966
967

968
969
970
971
972
973
974
1014
1015
1016
1017
1018
1019
1020

1021
1022
1023
1024
1025
1026
1027
1028







-
+







}
proc gen-jisx0208-euc-jp {code} {
    binary format cc \
	[expr {($code >> 8) | 0x80}] [expr {($code & 0xFF) | 0x80}]
}
proc gen-jisx0208-iso2022-jp {code} {
    binary format a3cca3 \
	"\x1B\$B" [expr {$code >> 8}] [expr {$code & 0xFF}] "\x1B(B"
	"\x1b\$B" [expr {$code >> 8}] [expr {$code & 0xFF}] "\x1b(B"
}
proc gen-jisx0208-cp932 {code} {
    set c1 [expr {($code >> 8) | 0x80}]
    set c2 [expr {($code & 0xff)| 0x80}]
    if {$c1 % 2} {
	set c1 [expr {($c1 >> 1) + ($c1 < 0xDF ? 0x31 : 0x71)}]
	incr c2 [expr {- (0x60 + ($c2 < 0xE0))}]
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
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







-
+






-
+






-
+






-
+

-
+







} -result 93

runtests

test encoding-bug-183a1adcc0-1 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
    testencoding
} -body {
    # Note - buffers are initialized to \xFF
    # Note - buffers are initialized to \xff
    list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 1} result] $result
} -result [list 0 [list nospace {} \xFF]]

test encoding-bug-183a1adcc0-2 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
    testencoding
} -body {
    # Note - buffers are initialized to \xFF
    # Note - buffers are initialized to \xff
    list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 0} result] $result
} -result [list 0 [list nospace {} {}]]

test encoding-bug-183a1adcc0-3 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
    testencoding
} -body {
    # Note - buffers are initialized to \xFF
    # Note - buffers are initialized to \xff
    list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 2} result] $result
} -result [list 0 [list nospace {} \x00\x00]]

test encoding-bug-183a1adcc0-4 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
    testencoding
} -body {
    # Note - buffers are initialized to \xFF
    # Note - buffers are initialized to \xff
    list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 3} result] $result
} -result [list 0 [list nospace {} \x00\x00\xFF]]
} -result [list 0 [list nospace {} \x00\x00\xff]]

test encoding-bug-183a1adcc0-5 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
    testencoding
} -body {
    list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 4} result] $result
} -result [list 0 [list ok {} [expr {$::tcl_platform(byteOrder) eq "littleEndian" ? "\x41\x00" : "\x00\x41"}]\x00\x00]]

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
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







-
+












-
+









-
-
+
+

-
+


-
-
+
+









-
+











-
+







        [testencoding nullength ksc5601]
} -result {1 2 4 2 2}

test encoding-30.0 {encoding convertto large strings UINT_MAX} -constraints {
    perf
} -body {
    # Test to ensure not misinterpreted as -1
    list [string length [set s [string repeat A 0xFFFFFFFF]]] [string equal $s [encoding convertto ascii $s]]
    list [string length [set s [string repeat A 0xffffffff]]] [string equal $s [encoding convertto ascii $s]]
} -result {4294967295 1}

test encoding-30.1 {encoding convertto large strings > 4GB} -constraints {
    perf
} -body {
    list [string length [set s [string repeat A 0x100000000]]] [string equal $s [encoding convertto ascii $s]]
} -result {4294967296 1}

test encoding-30.2 {encoding convertfrom large strings UINT_MAX} -constraints {
    perf
} -body {
    # Test to ensure not misinterpreted as -1
    list [string length [set s [string repeat A 0xFFFFFFFF]]] [string equal $s [encoding convertfrom ascii $s]]
    list [string length [set s [string repeat A 0xffffffff]]] [string equal $s [encoding convertfrom ascii $s]]
} -result {4294967295 1}

test encoding-30.3 {encoding convertfrom large strings > 4GB} -constraints {
    perf
} -body {
    list [string length [set s [string repeat A 0x100000000]]] [string equal $s [encoding convertfrom ascii $s]]
} -result {4294967296 1}

test encoding-bug-6a3e2cb0f0-1 {Bug [6a3e2cb0f0] - invalid bytes in escape encodings} -body {
    encoding convertfrom -profile tcl8 iso2022-jp x\x1B\x7Aaby
} -result x\uFFFDy
    encoding convertfrom -profile tcl8 iso2022-jp x\x1B\x7aaby
} -result x\ufffdy
test encoding-bug-6a3e2cb0f0-2 {Bug [6a3e2cb0f0] - invalid bytes in escape encodings} -body {
    encoding convertfrom -profile strict iso2022-jp x\x1B\x7Aaby
    encoding convertfrom -profile strict iso2022-jp x\x1b\x7aaby
} -returnCodes error -result {unexpected byte sequence starting at index 1: '\x1B'}
test encoding-bug-6a3e2cb0f0-3 {Bug [6a3e2cb0f0] - invalid bytes in escape encodings} -body {
    encoding convertfrom -profile replace iso2022-jp x\x1B\x7Aaby
} -result x\uFFFDy
    encoding convertfrom -profile replace iso2022-jp x\x1b\x7aaby
} -result x\ufffdy

test encoding-bug-66ffafd309-1-tcl8 {Bug [66ffafd309] - truncated DBCS} -body {
    encoding convertfrom -profile tcl8 gb12345 x
} -result x
test encoding-bug-66ffafd309-1-strict {Bug [66ffafd309] - truncated DBCS} -body {
    encoding convertfrom -profile strict gb12345 x
} -result {unexpected byte sequence starting at index 0: '\x78'} -returnCodes error
test encoding-bug-66ffafd309-1-replace {Bug [66ffafd309] - truncated DBCS} -body {
    encoding convertfrom -profile replace gb12345 x
} -result \uFFFD
} -result \ufffd
test encoding-bug-66ffafd309-2-tcl8 {Bug [66ffafd309] - invalid DBCS} -body {
    # Not truncated but invalid
    encoding convertfrom -profile tcl8 jis0208 \x78\x79
} -result \x78\x79
test encoding-bug-66ffafd309-2-strict {Bug [66ffafd309] - invalid DBCS} -body {
    # Not truncated but invalid
    encoding convertfrom -profile strict jis0208 \x78\x79
} -result {unexpected byte sequence starting at index 1: '\x79'} -returnCodes error
test encoding-bug-66ffafd309-2-replace {Bug [66ffafd309] - invalid DBCS} -body {
    # Not truncated but invalid
    encoding convertfrom -profile replace jis0208 \x78\x79
} -result \uFFFD\uFFFD
} -result \ufffd\ufffd

test encoding-bug-201c7a3aa6-strict {Crash encoding non-BMP to iso2022} -body {
    encoding convertto -profile strict iso2022 \U1f600
} -result {unexpected character at index 0: 'U+01F600'} -returnCodes error

test encoding-bug-201c7a3aa6-replace {Crash encoding non-BMP to iso2022} -body {
    encoding convertto -profile replace iso2022 \U1f600
Changes to tests/encodingVectors.tcl.







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

16
17
18
19
20
21
22
+
+
+
+
+
+
+








-







# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains test vectors for verifying various encodings. They are
# stored in a common file so that they can be sourced into the various test
# modules that are dependent on encodings. This file contains statically defined
# test vectors. In addition, it sources the ICU-generated test vectors from
# icuUcmTests.tcl.
#
# Note that sourcing the file will reinitialize any existing encoding test
# vectors.
#

# List of defined encoding profiles
set encProfiles {tcl8 strict replace}
set encDefaultProfile strict; # Should reflect the default from implementation

# encValidStrings - Table of valid strings.
#
Changes to tests/env.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  none (tests environment variable implementation)
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  none (tests environment variable implementation)
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

source [file join [file dirname [info script]] tcltests.tcl]
Changes to tests/error.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  error, catch, throw, try
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  error, catch, throw, try
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

testConstraint memory [llength [info commands memory]]
Changes to tests/eval.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  eval
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  eval
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

test eval-1.1 {single argument} {
Changes to tests/event.test.
1
2
3
4
5
6
7
8
9
10












11
12
13
14
15
16
17





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+







# This file contains a collection of tests for the procedures in the file
# tclEvent.c, which includes the "update", and "vwait" Tcl commands.  Sourcing
# this file into Tcl runs the tests and generates output for errors.  No
# output means no errors were found.
#
# Copyright © 1995-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains a collection of tests for the procedures in the file
# tclEvent.c, which includes the "update", and "vwait" Tcl commands.  Sourcing
# this file into Tcl runs the tests and generates output for errors.  No
# output means no errors were found.

package require tcltest 2.5
namespace import -force ::tcltest::*

catch {
    ::tcltest::loadTestedCommands
    package require -exact tcl::test [info patchlevel]
Changes to tests/exec.test.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15













16
17
18
19
20
21
22






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
-
-
-
-
-
-









+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  exec
#
# 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 © 1991-1994 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# There is no point in running Valgrind on cases where [exec] forks but then
# fails and the child process doesn't go through full cleanup.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  exec
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
source [file join [file dirname [info script]] tcltests.tcl]

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
715
716
717
718
719
720
721





























722
723
724
725
726
727
728







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    viewFile $log
} -result "\"Testing exec-20.0\""
test exec-20.1 {exec .CMD file} -constraints {win} -body {
    set log [makeFile {} exec201.log]
    exec [makeFile "echo %1> $log" exec201.CMD] "Testing exec-20.1"
    viewFile $log
} -result "\"Testing exec-20.1\""

# Test with encoding mismatches (Bug 0f1ddc0df7fb7)
test exec-21.1 {exec encoding mismatch on stdout} -setup {
    set path(script) [makeFile {
        fconfigure stdout -translation binary
        puts a\xe9b
    } script]
    set enc [encoding system]
    encoding system utf-8
} -cleanup {
    removeFile $path(script)
    encoding system $enc
} -body {
    exec [info nameofexecutable] $path(script)
} -result a\uFFFDb
test exec-21.2 {exec encoding mismatch on stderr} -setup {
    set path(script) [makeFile {
        fconfigure stderr -translation binary
        puts stderr a\xe9b
    } script]
    set enc [encoding system]
    encoding system utf-8
} -cleanup {
    removeFile $path(script)
    encoding system $enc
} -body {
    list [catch {exec [info nameofexecutable] $path(script)} r] $r
} -result [list 1 a\uFFFDb]


# ----------------------------------------------------------------------
# cleanup

foreach file {gorp.file gorp.file2 echo echo2 cat wc sh sh2 sleep exit err} {
    removeFile $file
}
Changes to tests/execute.test.













1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
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
+
+
+
+
+
+
+
+
+
+
+
+
+









-
-
-
-
-
-







# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains tests for the tclExecute.c source file. Tests appear in
# the same order as the C code that they test. The set of tests is currently
# incomplete since it currently includes only new tests for code changed for
# the addition of Tcl namespaces. Other execution-related tests appear in
# several other test files including namespace.test, basic.test, eval.test,
# for.test, etc.
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/expr-old.test.














1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+








-
-
-
-
-
-







# Copyright © 1991-1994 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-2000 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered: expr
#
# This file contains the original set of tests for Tcl's expr command.
# Since the expr command is now compiled, a new set of tests covering
# the new implementation are in the files "parseExpr.test" and
# "compExpr.test". Sourcing this file into Tcl runs the tests and generates
# output for errors. No output means no errors were found.
#
# Copyright © 1991-1994 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-2000 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/expr.test.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered: expr
#
# 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 © 1996-1997 Sun Microsystems, Inc.
# Copyright © 1998-2000 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered: expr
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/fCmd.test.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# This file tests the tclFCmd.c file.
#
# 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 © 1996-1997 Sun Microsystems, Inc.
# Copyright © 1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file tests the tclFCmd.c file.
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/fileName.test.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# This file tests the filename manipulation routines.
#
# 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 © 1995-1996 Sun Microsystems, Inc.
# Copyright © 1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file tests the filename manipulation routines.
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}


Changes to tests/fileSystem.test.












1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17





18
19
20
21
22
23
24
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-







# Copyright © 2002 Vincent Darley.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file tests the filesystem and vfs internals.
#
# 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 © 2002 Vincent Darley.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

namespace eval ::tcl::test::fileSystem {

    if {"::tcltest" ni [namespace children]} {
	package require tcltest 2.5
	namespace import -force ::tcltest::*
    }
Changes to tests/fileSystemEncoding.test.
1
2
3








4
5
6
7
8
9
10
1
2

3
4
5
6
7
8
9
10
11
12
13
14
15
16
17


-
+
+
+
+
+
+
+
+







#!  /usr/bin/env tclsh

# Copyright © 2019 Poor Yorick
# Copyright © 2019 Nathan Coulter 
#
# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[string equal $::tcl_platform(os) "Windows NT"]} {
    return
}

namespace eval ::tcl::test::fileSystemEncoding {

Changes to tests/for-old.test.













1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-
-







# Copyright © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  for, continue, break
#
# This file contains the original set of tests for Tcl's for command.
# Since the for command is now compiled, a new set of tests covering
# the new implementation is in the file "for.test". Sourcing this file
# into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# Check "for" and its use of continue and break.
Changes to tests/for.test.












1
2
3
4
5
6

7
8
9
10
11
12
13
14
15
16
17
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
+
+
+
+
+
+
+
+
+
+
+
+





-
+
-
-
-
-







# Copyright © 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  for, continue, break
#
# 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 © 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# Used for constraining memory leak tests
Changes to tests/foreach.test.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  foreach, continue, break
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994-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.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  foreach, continue, break
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

catch {unset a}
Changes to tests/format.test.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  format
#
# 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 © 1991-1994 The Regents of the University of California.
# Copyright © 1994-1998 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  format
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# %z/%t/%p output depends on pointerSize, so some tests are not portable.
Changes to tests/get.test.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  none
#
# This file contains a collection of tests for the procedures in the
# file tclGet.c.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright © 1995-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  none
#
# This file contains a collection of tests for the procedures in the
# file tclGet.c.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/history.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  history
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  history
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# The history command might be autoloaded...
Changes to tests/http.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  http::config, http::geturl, http::wait, http::reset
#
# This file contains a collection of tests for the http script library.
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-2000 Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  http::config, http::geturl, http::wait, http::reset
#
# This file contains a collection of tests for the http script library.
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

package require http 2.10
Changes to tests/http11.test.
1
2
3
4
5
6
7
8











9
10
11
12
13
14
15




1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
-
-
-
-




+
+
+
+
+
+
+
+
+
+
+







# http11.test --                                                -*- tcl-*-
#
#	Test HTTP/1.1 features.
#
# Copyright © 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# http11.test --                                                -*- tcl-*-
#
#	Test HTTP/1.1 features.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

package require http 2.10
Changes to tests/httpPipeline.test.
1
2
3
4
5
6
7
8
9












10
11
12
13
14
15
16





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
-
-
-
-
-




+
+
+
+
+
+
+
+
+
+
+
+







# httpPipeline.test
#
#	Test HTTP/1.1 concurrent requests including
#	queueing, pipelining and retries.
#
# Copyright © 2018 Keith Nash <kjnash@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# httpPipeline.test
#
#	Test HTTP/1.1 concurrent requests including
#	queueing, pipelining and retries.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

package require http 2.10
Changes to tests/httpProxy.test.
1
2
3
4
5
6
7
8
9
10
11
12
13













14
15
16
17
18
19
20






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
-
-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered: http::geturl when using a proxy server.
#
# This file contains a collection of tests for the http script library.
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-2000 Ajuba Solutions.
# Copyright © 2022-2023 Keith Nash.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered: http::geturl when using a proxy server.
#
# This file contains a collection of tests for the http script library.
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

package require http 2.10
Changes to tests/httpTest.tcl.












1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17




18
19
20
21
22
23
24
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-







# Copyright © 2018 Keith Nash <kjnash@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# httpTest.tcl
#
#	Test HTTP/1.1 concurrent requests including
#	queueing, pipelining and retries.
#
# Copyright © 2018 Keith Nash <kjnash@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# ------------------------------------------------------------------------------
# "Package" httpTest for analysis of Log output of http requests.
# ------------------------------------------------------------------------------
# This is a specialised test kit for examining the presence, ordering, and
# overlap of multiple HTTP transactions over a persistent ("Keep-Alive")
# connection; and also for testing reconnection in accordance with RFC 7230 when
Changes to tests/httpTestScript.tcl.












1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17




18
19
20
21
22
23
24
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-







# Copyright © 2018 Keith Nash <kjnash@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# httpTestScript.tcl
#
#	Test HTTP/1.1 concurrent requests including
#	queueing, pipelining and retries.
#
# Copyright © 2018 Keith Nash <kjnash@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# ------------------------------------------------------------------------------
# "Package" httpTestScript for executing test scripts written in a convenient
# shorthand.
# ------------------------------------------------------------------------------

# ------------------------------------------------------------------------------
Changes to tests/httpcookie.test.












1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17





18
19
20
21
22
23
24
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-







# Copyright © 2014 Donal K. Fellows.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  http::cookiejar
#
# This file contains a collection of tests for the cookiejar package.
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright © 2014 Donal K. Fellows.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/httpd.
1
2
3
4
5
6
7
8
9









10
11
12
13
14
15
16




1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
-
-
-
-





+
+
+
+
+
+
+
+
+







# -*- tcl -*-
#
# The httpd_ procedures implement a stub http server.
#
# Copyright © 1997-1998 Sun Microsystems, Inc.
# Copyright © 1999-2000 Scriptics Corporation
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# The httpd_ procedures implement a stub http server.

#set httpLog 1

# Do not use [info hostname].
# Name resolution is often a problem on OSX; not focus of HTTP package anyway.
# Also a problem on other platforms for http-4.14 (test with bad port number).
set HOST localhost
Changes to tests/httpd11.tcl.
1
2
3
4
5
6
7
8
9












10
11
12
13
14
15
16





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
-
-
-
-
-




+
+
+
+
+
+
+
+
+
+
+
+







# httpd11.tcl --                                                -*- tcl -*-
#
#	A simple httpd for testing HTTP/1.1 client features.
#	Not suitable for use on a internet connected port.
#
# Copyright © 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# httpd11.tcl --                                                -*- tcl -*-
#
#	A simple httpd for testing HTTP/1.1 client features.
#	Not suitable for use on a internet connected port.

package require Tcl

proc ::tcl::dict::get? {dict key} {
    if {[dict exists $dict $key]} {
        return [dict get $dict $key]
    }
Changes to tests/icuUcmTests.tcl.






1
2
3
4
5
6
7
1
2
3
4
5
6
7
8
9
10
11
12
13
+
+
+
+
+
+







# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file is automatically generated by ucm2tests.tcl.
# Edits will be overwritten on next generation.
#
# Tests comparing Tcl encodings to ICU.
# This file is NOT standalone. It should be sourced into a test script.

Changes to tests/if-old.test.














1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-
-
-







# Copyright © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  if
#
# This file contains the original set of tests for Tcl's if command.
# Since the if command is now compiled, a new set of tests covering
# the new implementation is in the file "if.test". Sourcing this file
# into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

test if-old-1.1 {taking proper branch} {
Changes to tests/if.test.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  if
#
# 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 © 1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  if
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# Basic "if" operation.
Changes to tests/incr-old.test.














1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-
-
-







# Copyright © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  incr
#
# This file contains the original set of tests for Tcl's incr command.
# Since the incr command is now compiled, a new set of tests covering
# the new implementation is in the file "incr.test". Sourcing this file
# into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

catch {unset x}
Changes to tests/incr.test.






1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
1
2
3
4
5
6
7
8
9
10
11






12
13
14
15
16
17
18
+
+
+
+
+
+





-
-
-
-
-
-







# Copyright © 1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  incr
#
# 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 © 1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

unset -nocomplain x i
Changes to tests/indexObj.test.
1
2
3
4
5
6
7
8
9











10
11
12
13
14
15
16




1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+







# This file is a Tcl script to test out the procedures in file
# tkIndexObj.c, which implement indexed table lookups.  The tests here are
# organized in the standard fashion for Tcl tests.
#
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file is a Tcl script to test out the procedures in file
# tkIndexObj.c, which implement indexed table lookups.  The tests here are
# organized in the standard fashion for Tcl tests.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/info.test.
1
2
3
4
5
6
7
8
9
10
11
12
13
14






















15
16
17
18
19
20
21







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
-
-
-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







# -*- tcl -*-
# Commands covered:  info
#
# 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 © 1991-1994 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
# Copyright © 2006 ActiveState
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  info
#
# 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.
#
# The tests below hard-code line numbers in this very script in order to test
# for correct reporting of line-numbers.  In order to provide at least some
# space where lines may be added without messing up these tests, the last line
# of this comment is used to obtain an offset that is then used to make the
# hard-coded line numbers not sensitive to changes in the number of lines at
# the beginning of this file. When developing/debugging, it can be useful to
# temporarily delete enough lines from the top of this file that the offset
# becomes 0.
#
# DO NOT DELETE THIS LINE

if {{::tcltest} ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
29
30
31
32
33
34
35










36
37
38
39
40
41
42
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67







+
+
+
+
+
+
+
+
+
+







catch {namespace delete test_ns_info1 test_ns_info2}

namespace eval test_ns_info1 {
    namespace export *
    proc p {x} {return "x=$x"}
    proc q {{y 27} {z {}}} {return "y=$y"}
}

set chan [open [info script]]
set thisscript [read $chan]
close $chan
set topcomments [regexp -inline {^.*?DO NOT DELETE THIS LINE\n} $thisscript]
set offset [llength [split $topcomments \n]]
# The original 9 lines in the top comments are already counted in the
# hard-coded values in this file
incr offset -7


test info-1.1 {info args option} {
    proc t1 {a bbb c} {return foo}
    info args t1
} {a bbb c}
test info-1.2 {info args option} {
    proc t1 {{a default1} {bbb default2} {c default3} args} {return foo}
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
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







-
+


-
+


-
+


-
+


-
+


-
-
-
+
+
+







test info-22.2 {info frame, bad level absolute} {!singleTestInterp} {
    # catch is another level!, i.e. we have 8, not 7
    catch {info frame 9} msg
    set msg
} {bad level "9"}
test info-22.3 {info frame, current, relative} -match glob -body {
    info frame 0
} -result {type source line 750 file */info.test cmd {info frame 0} proc ::tcltest::RunTest}
} -result "type source line [expr {$offset + 750}] file */info.test cmd {info frame 0} proc ::tcltest::RunTest"
test info-22.4 {info frame, current, relative, nested} -match glob -body {
    set res [info frame 0]
} -result {type source line 753 file */info.test cmd {info frame 0} proc ::tcltest::RunTest} -cleanup {unset res}
} -result "type source line [expr {$offset + 753}] file */info.test cmd {info frame 0} proc ::tcltest::RunTest" -cleanup {unset res}
test info-22.5 {info frame, current, absolute} -constraints {!singleTestInterp} -match glob -body {
    reduce [info frame 7]
} -result {type source line 756 file info.test cmd {info frame 7} proc ::tcltest::RunTest}
} -result "type source line [expr {$offset + 756}] file info.test cmd {info frame 7} proc ::tcltest::RunTest"
test info-22.6 {info frame, global, relative} {!singleTestInterp} {
    reduce [info frame -6]
} {type source line 758 file info.test cmd test\ info-22.6\ \{info\ frame,\ global,\ relative\}\ \{!singleTestInter level 0}
} "type source line [expr {$offset + 758}] file info.test cmd test\\ info-22.6\\ \\{info\\ frame,\\ global,\\ relative\\}\\ \\{!singleTestInter level 0"
test info-22.7 {info frame, global, absolute} {!singleTestInterp} {
    reduce [info frame 1]
} {type source line 761 file info.test cmd test\ info-22.7\ \{info\ frame,\ global,\ absolute\}\ \{!singleTestInter level 0}
} "type source line [expr {$offset + 761}] file info.test cmd test\\ info-22.7\\ \\{info\\ frame,\\ global,\\ absolute\\}\\ \\{!singleTestInter level 0"
test info-22.8 {info frame, basic trace} -match glob -body {
    join [lrange [etrace] 0 2] \n
} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type source line 765 file info.test cmd etrace proc ::tcltest::RunTest}
* {type source line * file tcltest* cmd {uplevel 1 $script} proc ::tcltest::RunTest}}
} -result "* {type source line [expr {$offset + 730}] file info.test cmd {info frame \$level} proc ::etrace level 0}
* {type source line [expr {$offset + 765}] file info.test cmd etrace proc ::tcltest::RunTest}
* {type source line * file tcltest* cmd {uplevel 1 \$script} proc ::tcltest::RunTest}"
unset -nocomplain msg






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
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







-
+










-
+

-
+







    i eval {	set script {info frame}
		eval $script}
} -setup {interp create i} -cleanup {interp delete i} -result 2
test info-23.3 {eval'd info frame, literal} -match glob -body {
    eval {
	info frame 0
    }
} -result {type source line 793 file * cmd {info frame 0} proc ::tcltest::RunTest}
} -result "type source line [expr {$offset + 793}] file * cmd {info frame 0} proc ::tcltest::RunTest"
test info-23.4 {eval'd info frame, semi-dynamic} {
    eval info frame 0
} {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest}
test info-23.5 {eval'd info frame, dynamic} -cleanup {unset script} -body {
    set script {info frame 0}
    eval $script
} -result {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest}
test info-23.6 {eval'd info frame, trace} -match glob -cleanup {unset script} -body {
    set script {etrace}
    join [lrange [eval $script] 0 2] \n
} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
} -result "* {type source line [expr {$offset + 730}] file info.test cmd {info frame \$level} proc ::etrace level 0}
* {type eval line 1 cmd etrace proc ::tcltest::RunTest}
* {type source line 805 file info.test cmd {eval $script} proc ::tcltest::RunTest}}
* {type source line [expr {$offset + 805}] file info.test cmd {eval \$script} proc ::tcltest::RunTest}"

# -------------------------------------------------------------------------

# Procedures defined in scripts which are arguments to control
# structures (like 'namespace eval', 'interp eval', 'if', 'while',
# 'switch', 'catch', 'for', 'foreach', etc.) have no absolute
# location. The command implementations execute such scripts through
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
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







-
+













-
+














-
+












-
+













-
+













-
+
















-
+














-
+







    proc bar {} {info frame 0}
}

test info-24.0 {info frame, interaction, namespace eval} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 825 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 825}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------

set flag 1
if {$flag} {
    namespace eval foo {}
    proc ::foo::bar {} {info frame 0}
}

test info-24.1 {info frame, interaction, if} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 839 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 839}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------

set flag 1
while {$flag} {
    namespace eval foo {}
    proc ::foo::bar {} {info frame 0}
    set flag 0
};unset flag

test info-24.2 {info frame, interaction, while} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 853 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 853}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------

catch {
    namespace eval foo {}
    proc ::foo::bar {} {info frame 0}
}

test info-24.3 {info frame, interaction, catch} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 867 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 867}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------

foreach var val {
    namespace eval foo {}
    proc ::foo::bar {} {info frame 0}
    break
}; unset var

test info-24.4 {info frame, interaction, foreach} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 880 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 880}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------

for {} {1} {} {
    namespace eval foo {}
    proc ::foo::bar {} {info frame 0}
    break
}

test info-24.5 {info frame, interaction, for} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 894 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 894}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------

namespace eval foo {}
set x foo
switch -exact -- $x {
    foo {
	proc ::foo::bar {} {info frame 0}
    }
}

test info-24.6.0 {info frame, interaction, switch, list body} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
    unset x
} -result {type source line 910 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 910}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------

namespace eval foo {}
set x foo
switch -exact -- $x foo {
    proc ::foo::bar {} {info frame 0}
}

test info-24.6.1 {info frame, interaction, switch, multi-body} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
    unset x
} -result {type source line 926 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 926}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------

namespace eval foo {}
set x foo
switch -exact -- $x [list foo {
    proc ::foo::bar {} {info frame 0}
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
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







-
+













-
+














-
+












-
+






-
+

















-
+







namespace eval foo {}
dict for {k v} {foo bar} {
    proc ::foo::bar {} {info frame 0}
}

test info-24.7 {info frame, interaction, dict for} {
    reduce [foo::bar]
} {type source line 955 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} "type source line [expr {$offset + 955}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

namespace delete foo; unset k v

# -------------------------------------------------------------------------

namespace eval foo {}
set thedict {foo bar}
dict with thedict {
    proc ::foo::bar {} {info frame 0}
}

test info-24.8 {info frame, interaction, dict with} {
    reduce [foo::bar]
} {type source line 969 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} "type source line [expr {$offset + 969}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

namespace delete foo
unset thedict foo

# -------------------------------------------------------------------------

namespace eval foo {}
dict filter {foo bar} script {k v} {
    proc ::foo::bar {} {info frame 0}
    set x 1
}; unset k v x

test info-24.9 {info frame, interaction, dict filter} {
    reduce [foo::bar]
} {type source line 983 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} "type source line [expr {$offset + 983}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

namespace delete foo
#unset x

# -------------------------------------------------------------------------

eval {
    proc bar {} {info frame 0}
}

test info-25.0 {info frame, proc in eval} {
    reduce [bar]
} {type source line 997 file info.test cmd {info frame 0} proc ::bar level 0}
} "type source line [expr {$offset + 997}] file info.test cmd {info frame 0} proc ::bar level 0"
# Don't need to clean up yet...

proc bar {} {info frame 0}

test info-25.1 {info frame, regular proc} {
    reduce [bar]
} {type source line 1005 file info.test cmd {info frame 0} proc ::bar level 0}
} "type source line [expr {$offset + 1005}] file info.test cmd {info frame 0} proc ::bar level 0"

rename bar {}

# -------------------------------------------------------------------------
# More info-30.x test cases at the end of the file.
test info-30.0 {bs+nl in literal words} -cleanup {unset res} -body {
    if {1} {
	set res \
	    [reduce [info frame 0]];#1018
    }
    return $res
    # This was reporting line 3 instead of the correct 4 because the
    # bs+nl combination is subst by the parser before the 'if'
    # command, and the bcc, see the word. Fixed by recording the
    # offsets of all bs+nl sequences in literal words, then using the
    # information in the bcc and other places to bump line numbers when
    # parsing over the location. Also affected: testcases 22.8 and 23.6.
} -result {type source line 1018 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} -result "type source line [expr {$offset + 1018}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"

# -------------------------------------------------------------------------
# See 24.0 - 24.5 for similar situations, using literal scripts.

set body {set flag 0
    set a c
    set res [info frame 0]} ;# line 3!
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
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







-
+















-
+










-
+







    foo
    {proc bar {} {info frame 0}}
}
test info-33.0 {{*}, literal, direct} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 1115 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 1115}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------

namespace eval foo {}
proc foo::bar {} {
    set flag 1
    if {*}{
	{$flag}
	{info frame 0}
    }
}
test info-33.1 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 1130 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 1130}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------

namespace {*}"
    eval
    foo
    {proc bar {} {info frame 0}}
"
test info-33.2 {{*}, literal, direct} {
    reduce [foo::bar]
} {type source line 1144 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} "type source line [expr {$offset + 1144}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

namespace delete foo

# -------------------------------------------------------------------------

namespace {*}"eval\nfoo\n{proc bar {} {info frame 0}}\n"

1167
1168
1169
1170
1171
1172
1173
1174

1175
1176
1177
1178
1179
1180
1181
1192
1193
1194
1195
1196
1197
1198

1199
1200
1201
1202
1203
1204
1205
1206







-
+







    if {*}"
	{1}
	{info frame 0}
    "
}
test info-33.3 {{*}, literal, simple, bytecompiled} {
    reduce [foo::bar]
} {type source line 1169 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} "type source line [expr {$offset + 1169}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

namespace delete foo

# -------------------------------------------------------------------------

namespace eval foo {}
proc foo::bar {} {
1229
1230
1231
1232
1233
1234
1235
1236

1237
1238
1239

1240
1241
1242
1243
1244
1245
1246
1254
1255
1256
1257
1258
1259
1260

1261
1262
1263

1264
1265
1266
1267
1268
1269
1270
1271







-
+


-
+







    apply {
	{x y}
	{info frame 0}
    } 0 0
}
test info-35.0 {apply, literal} {
    reduce [foo]
} {type source line 1231 file info.test cmd {info frame 0} lambda {
} "type source line [expr {$offset + 1231}] file info.test cmd {info frame 0} lambda {
	{x y}
	{info frame 0}
    } level 0}
    } level 0"
rename foo {}

set lambda {
    {x y}
    {info frame 0}
}
test info-35.1 {apply, dynamic} {
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
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







-
+
















-
+














-
+







    dict for {k v} {foo bar} {
	set x [info frame 0]
    }
    set x
}
test info-36.0 {info frame, dict for, bcc} -body {
    reduce [foo::bar]
} -result {type source line 1259 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 1259}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

namespace delete foo

# -------------------------------------------------------------------------

namespace eval foo {}
proc foo::bar {} {
    set x foo
    switch -exact -- $x {
	foo {set y [info frame 0]}
    }
    set y
}

test info-36.1.0 {switch, list literal, bcc} -body {
    reduce [foo::bar]
} -result {type source line 1275 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 1275}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

namespace delete foo

# -------------------------------------------------------------------------

namespace eval foo {}
proc foo::bar {} {
    set x foo
    switch -exact -- $x foo {set y [info frame 0]}
    set y
}

test info-36.1.1 {switch, multi-body literals, bcc} -body {
    reduce [foo::bar]
} -result {type source line 1291 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 1291}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

namespace delete foo

# -------------------------------------------------------------------------

test info-37.0 {eval pure list, single line} -match glob -body {
    # Basically, counting the newline in the word seen through $foo
1314
1315
1316
1317
1318
1319
1320
1321

1322
1323

1324
1325
1326
1327
1328
1329
1330
1339
1340
1341
1342
1343
1344
1345

1346
1347

1348
1349
1350
1351
1352
1353
1354
1355







-
+

-
+







	c}
    set cmd [list foreach $foo {x y} {
	set res [join [lrange [etrace] 0 2] \n]
	break
    }]
    eval $cmd
    return $res
} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
} -result "* {type source line [expr {$offset + 730}] file info.test cmd {info frame \$level} proc ::etrace level 0}
* {type eval line 2 cmd etrace proc ::tcltest::RunTest}
* {type eval line 1 cmd foreac proc ::tcltest::RunTest}} -cleanup {unset foo cmd res b c}
* {type eval line 1 cmd foreac proc ::tcltest::RunTest}" -cleanup {unset foo cmd res b c}

# -------------------------------------------------------------------------

# 6 cases.
## DV. direct-var          - unchanged
## DPV direct-proc-var     - ditto
## PPV proc-proc-var       - ditto
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
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







-
+

-
+
















-
+

-
-
+
+













-
+

-
-
-
+
+
+












-
+

-
-
+
+















-
-
-
+
+
+















-
+







-
+





-
+







-
+










-
+




-
+









-
+







-
+








-
+








-
+






-
+









-
+










-
+











-
+















-
+












-
-
-
+
+
+






-
+








test info-38.1 {location information for uplevel, dv, direct-var} -match glob -body {
    set script {
	set y DV.
	etrace
    }
    join [lrange [uplevel \#0 $script] 0 2] \n
} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
} -result "* {type source line [expr {$offset + 730}] file info.test cmd {info frame \$level} proc ::etrace level 0}
* {type eval line 3 cmd etrace proc ::tcltest::RunTest}
* {type source line 1361 file info.test cmd {uplevel \\#0 $script} proc ::tcltest::RunTest}} -cleanup {unset script y}
* {type source line [expr {$offset + 1361}] file info.test cmd {uplevel \\\\#0 \$script} proc ::tcltest::RunTest}" -cleanup {unset script y}

# 38.2 moved to bottom to not disturb other tests with the necessary changes to this one.








test info-38.3 {location information for uplevel, dpv, direct-proc-var} -match glob -body {
    set script {
	set y DPV
	etrace
    }
    join [lrange [control y $script] 0 3] \n
} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
} -result "* {type source line [expr {$offset + 730}] file info.test cmd {info frame \$level} proc ::etrace level 0}
* {type eval line 3 cmd etrace proc ::control}
* {type source line 1338 file info.test cmd {uplevel 1 $script} proc ::control}
* {type source line 1380 file info.test cmd {control y $script} proc ::tcltest::RunTest}} -cleanup {unset script y}
* {type source line [expr {$offset + 1338}] file info.test cmd {uplevel 1 \$script} proc ::control}
* {type source line [expr {$offset + 1380}] file info.test cmd {control y \$script} proc ::tcltest::RunTest}" -cleanup {unset script y}

# 38.4 moved to bottom to not disturb other tests with the necessary changes to this one.









test info-38.5 {location information for uplevel, ppv, proc-proc-var} -match glob -body {
    join [lrange [datav] 0 4] \n
} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
} -result "* {type source line [expr {$offset + 730}] file info.test cmd {info frame \$level} proc ::etrace level 0}
* {type eval line 3 cmd etrace proc ::control}
* {type source line 1338 file info.test cmd {uplevel 1 $script} proc ::control}
* {type source line 1353 file info.test cmd {control y $script} proc ::datav level 1}
* {type source line 1397 file info.test cmd datav proc ::tcltest::RunTest}}
* {type source line [expr {$offset + 1338}] file info.test cmd {uplevel 1 \$script} proc ::control}
* {type source line [expr {$offset + 1353}] file info.test cmd {control y \$script} proc ::datav level 1}
* {type source line [expr {$offset + 1397}] file info.test cmd datav proc ::tcltest::RunTest}"

# 38.6 moved to bottom to not disturb other tests with the necessary changes to this one.







testConstraint testevalex [llength [info commands testevalex]]
test info-38.7 {location information for arg substitution} -constraints testevalex -match glob -body {
    join [lrange [testevalex {return -level 0 [etrace]}] 0 3] \n
} -result {* {type source line 730 file info.test cmd {info frame \$level} proc ::etrace level 0}
} -result "* {type source line [expr {$offset + 730}] file info.test cmd {info frame \$level} proc ::etrace level 0}
* {type eval line 1 cmd etrace proc ::tcltest::RunTest}
* {type source line 1414 file info.test cmd {testevalex {return -level 0 \[etrace]}} proc ::tcltest::RunTest}
* {type source line * file tcltest* cmd {uplevel 1 $script} proc ::tcltest::RunTest}}
* {type source line [expr {$offset + 1414}] file info.test cmd {testevalex {return -level 0 \\\[etrace]}} proc ::tcltest::RunTest}
* {type source line * file tcltest* cmd {uplevel 1 \$script} proc ::tcltest::RunTest}"

# -------------------------------------------------------------------------
# literal sharing

test info-39.0 {location information not confused by literal sharing} -body {
    namespace eval ::foo {}
    proc ::foo::bar {} {
	lappend res {}
	lappend res [reduce [eval {info frame 0}]]
	lappend res [reduce [eval {info frame 0}]]
	return $res
    }
    set res [::foo::bar]
    namespace delete ::foo
    join $res \n
} -cleanup {unset res} -result {
type source line 1427 file info.test cmd {info frame 0} proc ::foo::bar level 0
type source line 1428 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -cleanup {unset res} -result "
type source line [expr {$offset + 1427}] file info.test cmd {info frame 0} proc ::foo::bar level 0
type source line [expr {$offset + 1428}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
# Additional tests for info-30.*, handling of continuation lines (bs+nl sequences).

test info-30.1 {bs+nl in literal words, procedure body, compiled} -body {
    proc abra {} {
	if {1} \
	    {
		return \
		    [reduce [info frame 0]];# line 1446
	    }
    }
    abra
} -cleanup {
    rename abra {}
} -result {type source line 1446 file info.test cmd {info frame 0} proc ::abra level 0}
} -result "type source line [expr {$offset + 1446}] file info.test cmd {info frame 0} proc ::abra level 0"

test info-30.2 {bs+nl in literal words, namespace script} {
    namespace eval xxx {
	variable res \
	    [info frame 0];# line 1457
    }
    return [reduce $xxx::res]
} {type source line 1457 file info.test cmd {info frame 0} level 0}
} "type source line [expr {$offset + 1457}] file info.test cmd {info frame 0} level 0"

test info-30.3 {bs+nl in literal words, namespace multi-word script} {
    namespace eval xxx variable res \
	[list [reduce [info frame 0]]];# line 1464
    return $xxx::res
} {type source line 1464 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} "type source line [expr {$offset + 1464}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"

test info-30.4 {bs+nl in literal words, eval script} -cleanup {unset res} -body {
    eval {
	set ::res \
	    [reduce [info frame 0]];# line 1471
    }
    return $res
} -result {type source line 1471 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} -result "type source line [expr {$offset + 1471}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"

test info-30.5 {bs+nl in literal words, eval script, with nested words} -body {
    eval {
	if {1} \
	    {
		set ::res \
		    [reduce [info frame 0]];# line 1481
	    }
    }
    return $res
} -cleanup {unset res} -result {type source line 1481 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} -cleanup {unset res} -result "type source line [expr {$offset + 1481}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"

test info-30.6 {bs+nl in computed word} -cleanup {unset res} -body {
    set res "\
[reduce [info frame 0]]";# line 1489
} -result { type source line 1489 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} -result " type source line [expr {$offset + 1489}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"

test info-30.7 {bs+nl in computed word, in proc} -body {
    proc abra {} {
	return "\
[reduce [info frame 0]]";# line 1495
    }
    abra
} -cleanup {
    rename abra {}
} -result { type source line 1495 file info.test cmd {info frame 0} proc ::abra level 0}
} -result " type source line [expr {$offset + 1495}] file info.test cmd {info frame 0} proc ::abra level 0"

test info-30.8 {bs+nl in computed word, nested eval} -body {
    eval {
	set \
	    res "\
[reduce [info frame 0]]";# line 1506
}
} -cleanup {unset res} -result { type source line 1506 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} -cleanup {unset res} -result " type source line [expr {$offset + 1506}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"

test info-30.9 {bs+nl in computed word, nested eval} -body {
    eval {
	set \
	    res "\
[reduce \
     [info frame 0]]";# line 1515
}
} -cleanup {unset res} -result { type source line 1515 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} -cleanup {unset res} -result " type source line [expr {$offset + 1515}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"

test info-30.10 {bs+nl in computed word, key to array} -body {
    set tmp([set \
	    res "\
[reduce \
     [info frame 0]]"]) x ; #1523
    unset tmp
    set res
} -cleanup {unset res} -result { type source line 1523 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} -cleanup {unset res} -result " type source line [expr {$offset + 1523}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"

test info-30.11 {bs+nl in subst arguments} -body {
    subst {[set \
	    res "\
[reduce \
     [info frame 0]]"]} ; #1532
} -cleanup {unset res} -result { type source line 1532 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} -cleanup {unset res} -result " type source line [expr {$offset + 1532}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"

test info-30.12 {bs+nl in computed word, nested eval} -body {
    eval {
	set \
	    res "\
[set x {}] \
[reduce \
     [info frame 0]]";# line 1541
}
} -cleanup {unset res x} -result {   type source line 1541 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} -cleanup {unset res x} -result "   type source line [expr {$offset + 1541}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"

test info-30.13 {bs+nl in literal words, uplevel script, with nested words} -body {
    subinterp ; set res [interp eval sub { uplevel #0 {
	if {1} \
	    {
		set ::res \
		    [reduce [info frame 0]];# line 1550
	    }
    }
    set res }] ; interp delete sub ; set res
} -cleanup {unset res} -result {type source line 1550 file info.test cmd {info frame 0} level 0}
} -cleanup {unset res} -result "type source line [expr {$offset + 1550}] file info.test cmd {info frame 0} level 0"

test info-30.14 {bs+nl, literal word, uplevel through proc} {
    subinterp ; set res [interp eval sub { proc abra {script} {
	uplevel 1 $script
    }
    set res [abra {
	return "\
[reduce [info frame 0]]";# line 1562
    }]
    rename abra {}
    set res }] ; interp delete sub ; set res
} { type source line 1562 file info.test cmd {info frame 0} proc ::abra}
} " type source line [expr {$offset + 1562}] file info.test cmd {info frame 0} proc ::abra"

test info-30.15 {bs+nl in literal words, nested proc body, compiled} {
    proc a {} {
	proc b {} {
	    if {1} \
		{
		    return \
			[reduce [info frame 0]];# line 1574
		}
	}
    }
    a ; set res [b]
    rename a {}
    rename b {}
    set res
} {type source line 1574 file info.test cmd {info frame 0} proc ::b level 0}
} "type source line [expr {$offset + 1574}] file info.test cmd {info frame 0} proc ::b level 0"

test info-30.16 {bs+nl in multi-body switch, compiled} {
    proc a {value} {
	switch -regexp -- $value \
	    ^key     { info frame 0; # 1587 } \
	    \t###    { info frame 0; # 1588 } \
	    {[0-9]*} { info frame 0; # 1589 }
    }
    set res {}
    lappend res [reduce [a {key   }]]
    lappend res [reduce [a {1alpha}]]
    set res "\n[join $res \n]"
} {
type source line 1587 file info.test cmd {info frame 0} proc ::a level 0
type source line 1589 file info.test cmd {info frame 0} proc ::a level 0}
} "
type source line [expr {$offset + 1587}] file info.test cmd {info frame 0} proc ::a level 0
type source line [expr {$offset + 1589}] file info.test cmd {info frame 0} proc ::a level 0"

test info-30.17 {bs+nl in multi-body switch, direct} {
    switch -regexp -- {key    } \
	^key     { reduce [info frame 0] ;# 1601 } \
        \t###    { } \
        {[0-9]*} { }
} {type source line 1601 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} "type source line [expr {$offset + 1601}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"

test info-30.18 {bs+nl, literal word, uplevel through proc, appended, loss of primary tracking data} {
    proc abra {script} {
	append script "\n# end of script"
	uplevel 1 $script
    }
    set res [abra {
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
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







-
-
-
+
+
+









-
+











-
-
-
+
+
+













-
+












-
-
-
+
+
+
















-
-
-
+
+
+



-
+



-
+



-
-
+
+



-
+



-
+



-
-
+
+


-
+



-
+



-
+



-
+




-
-
+
+



-
-
+
+




-
+

-
+



-
+




-
+







-
+








-
-
+
+







-
+





-
+





-
+





-
+


-
+




-
+








-
+







			   [info frame 0] }
	}
    }
    set res {}
    lappend res [a {key   }]
    lappend res [a {1alpha}]
    set res "\n[join $res \n]"
} {
type source line 1624 file info.test cmd {info frame 0} proc ::a level 0
type source line 1628 file info.test cmd {info frame 0} proc ::a level 0}
} "
type source line [expr {$offset + 1624}] file info.test cmd {info frame 0} proc ::a level 0
type source line [expr {$offset + 1628}] file info.test cmd {info frame 0} proc ::a level 0"

test info-30.20 {bs+nl in single-body switch, direct} {
    switch -regexp -- {key    } { \

	^key     { reduce \
		       [info frame 0] }
	\t###    { }
        {[0-9]*} { }
    }
} {type source line 1643 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} "type source line [expr {$offset + 1643}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"

test info-30.21 {bs+nl in if, full compiled} {
    proc a {value} {
	if {$value} \
	    {info frame 0} \
	    {info frame 0} ; # 1653
    }
    set res {}
    lappend res [reduce [a 1]]
    lappend res [reduce [a 0]]
    set res "\n[join $res \n]"
} {
type source line 1652 file info.test cmd {info frame 0} proc ::a level 0
type source line 1653 file info.test cmd {info frame 0} proc ::a level 0}
} "
type source line [expr {$offset + 1652}] file info.test cmd {info frame 0} proc ::a level 0
type source line [expr {$offset + 1653}] file info.test cmd {info frame 0} proc ::a level 0"

test info-30.22 {bs+nl in computed word, key to array, compiled} {
    proc a {} {
	set tmp([set \
		     res "\
[reduce \
     [info frame 0]]"]) x ; #1668
    unset tmp
    set res
    }
    set res [a]
    rename a {}
    set res
} { type source line 1668 file info.test cmd {info frame 0} proc ::a level 0}
} " type source line [expr {$offset + 1668}] file info.test cmd {info frame 0} proc ::a level 0"

test info-30.23 {bs+nl in multi-body switch, full compiled} {
    proc a {value} {
	switch -exact -- $value \
	    key     { info frame 0; # 1680 } \
	    xxx     { info frame 0; # 1681 } \
	    000     { info frame 0; # 1682 }
    }
    set res {}
    lappend res [reduce [a key]]
    lappend res [reduce [a 000]]
    set res "\n[join $res \n]"
} {
type source line 1680 file info.test cmd {info frame 0} proc ::a level 0
type source line 1682 file info.test cmd {info frame 0} proc ::a level 0}
} "
type source line [expr {$offset + 1680}] file info.test cmd {info frame 0} proc ::a level 0
type source line [expr {$offset + 1682}] file info.test cmd {info frame 0} proc ::a level 0"

test info-30.24 {bs+nl in single-body switch, full compiled} {
    proc a {value} {
	switch -exact -- $value {
	    key { reduce \
		      [info frame 0] }
	    xxx { reduce \
		      [info frame 0] }
	    000 { reduce \
		      [info frame 0] }
	}
    }
    set res {}
    lappend res [a key]
    lappend res [a 000]
    set res "\n[join $res \n]"
} {
type source line 1696 file info.test cmd {info frame 0} proc ::a level 0
type source line 1700 file info.test cmd {info frame 0} proc ::a level 0}
} "
type source line [expr {$offset + 1696}] file info.test cmd {info frame 0} proc ::a level 0
type source line [expr {$offset + 1700}] file info.test cmd {info frame 0} proc ::a level 0"

test info-30.25 {TIP 280 for compiled [subst]} {
    subst {[reduce [info frame 0]]} ; # 1712
} {type source line 1712 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} "type source line [expr {$offset + 1712}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"
test info-30.26 {TIP 280 for compiled [subst]} {
    subst \
	    {[reduce [info frame 0]]} ; # 1716
} {type source line 1716 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} "type source line [expr {$offset + 1716}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"
test info-30.27 {TIP 280 for compiled [subst]} {
    subst {
[reduce [info frame 0]]} ; # 1720
} {
type source line 1720 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} "
type source line [expr {$offset + 1720}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"
test info-30.28 {TIP 280 for compiled [subst]} {
    subst {\
[reduce [info frame 0]]} ; # 1725
} { type source line 1725 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} " type source line [expr {$offset + 1725}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"
test info-30.29 {TIP 280 for compiled [subst]} {
    subst {foo\
[reduce [info frame 0]]} ; # 1729
} {foo type source line 1729 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} "foo type source line [expr {$offset + 1729}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"
test info-30.30 {TIP 280 for compiled [subst]} {
    subst {foo
[reduce [info frame 0]]} ; # 1733
} {foo
type source line 1733 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} "foo
type source line [expr {$offset + 1733}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"
test info-30.31 {TIP 280 for compiled [subst]} {
    subst {[][reduce [info frame 0]]} ; # 1737
} {type source line 1737 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} "type source line [expr {$offset + 1737}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"
test info-30.32 {TIP 280 for compiled [subst]} {
    subst {[\
][reduce [info frame 0]]} ; # 1741
} {type source line 1741 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} "type source line [expr {$offset + 1741}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"
test info-30.33 {TIP 280 for compiled [subst]} {
    subst {[
][reduce [info frame 0]]} ; # 1745
} {type source line 1745 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} "type source line [expr {$offset + 1745}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"
test info-30.34 {TIP 280 for compiled [subst]} {
    subst {[format %s {}
][reduce [info frame 0]]} ; # 1749
} {type source line 1749 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} "type source line [expr {$offset + 1749}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"
test info-30.35 {TIP 280 for compiled [subst]} {
    subst {[format %s {}
]
[reduce [info frame 0]]} ; # 1754
} {
type source line 1754 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} "
type source line [expr {$offset + 1754}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"
test info-30.36 {TIP 280 for compiled [subst]} {
    subst {
[format %s {}][reduce [info frame 0]]} ; # 1759
} {
type source line 1759 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} "
type source line [expr {$offset + 1759}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"
test info-30.37 {TIP 280 for compiled [subst]} {
    subst {
[format %s {}]
[reduce [info frame 0]]} ; # 1765
} {
} "

type source line 1765 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
type source line [expr {$offset + 1765}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"
test info-30.38 {TIP 280 for compiled [subst]} {
    subst {\
[format %s {}][reduce [info frame 0]]} ; # 1771
} { type source line 1771 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} " type source line [expr {$offset + 1771}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"
test info-30.39 {TIP 280 for compiled [subst]} {
    subst {\
[format %s {}]\
[reduce [info frame 0]]} ; # 1776
} {  type source line 1776 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} "  type source line [expr {$offset + 1776}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"
test info-30.40 {TIP 280 for compiled [subst]} -setup {
    unset -nocomplain empty
} -body {
    set empty {}
    subst {$empty[reduce [info frame 0]]} ; # 1782
} -cleanup {
    unset empty
} -result {type source line 1782 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} -result "type source line [expr {$offset + 1782}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"
test info-30.41 {TIP 280 for compiled [subst]} -setup {
    unset -nocomplain empty
} -body {
    set empty {}
    subst {$empty
[reduce [info frame 0]]} ; # 1791
} -cleanup {
    unset empty
} -result {
type source line 1791 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} -result "
type source line [expr {$offset + 1791}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"
test info-30.42 {TIP 280 for compiled [subst]} -setup {
    unset -nocomplain empty
} -body {
    set empty {}; subst {$empty\
[reduce [info frame 0]]} ; # 1800
} -cleanup {
    unset empty
} -result { type source line 1800 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} -result " type source line [expr {$offset + 1800}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"
test info-30.43 {TIP 280 for compiled [subst]} -body {
    unset -nocomplain a\nb
    set a\nb {}
    subst {${a
b}[reduce [info frame 0]]} ; # 1808
} -cleanup {unset a\nb} -result {type source line 1808 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} -cleanup {unset a\nb} -result "type source line [expr {$offset + 1808}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"
test info-30.44 {TIP 280 for compiled [subst]} {
    unset -nocomplain a
    set a(\n) {}
    subst {$a(
)[reduce [info frame 0]]} ; # 1814
} {type source line 1814 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} "type source line [expr {$offset + 1814}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"
test info-30.45 {TIP 280 for compiled [subst]} {
    unset -nocomplain a
    set a() {}
    subst {$a([
return -level 0])[reduce [info frame 0]]} ; # 1820
} {type source line 1820 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} "type source line [expr {$offset + 1820}] file info.test cmd {info frame 0} proc ::tcltest::RunTest"
test info-30.46 {TIP 280 for compiled [subst]} {
    unset -nocomplain a
    set a(1825) YES;  set a(1824) 1824; set a(1826) 1826
    set a([expr {$offset + 1825}]) YES;  set a([expr {$offset + 1824}]) [expr {$offset + 1824}]; set a([expr {$offset + 1826}]) [expr {$offset + 1826}]
    subst {$a([dict get [info frame 0] line])} ; # 1825
} YES
test info-30.47 {TIP 280 for compiled [subst]} {
    unset -nocomplain a
    set a(\n1831) YES;  set a(\n1830) 1830; set a(\n1832) 1832
    set a(\n[expr {$offset + 1831}]) YES;  set a(\n[expr {$offset + 1830}]) 1830; set a(\n[expr {$offset + 1832}]) [expr {$offset + 1832}]
    subst {$a(
[dict get [info frame 0] line])} ; # 1831
} YES
unset -nocomplain a

test info-30.48 {Bug 2850901} testevalex {
    testevalex {return -level 0 [format %s {}
][reduce [info frame 0]]} ; # line 2 of the eval
} {type eval line 2 cmd {info frame 0} proc ::tcltest::RunTest}
} "type eval line 2 cmd {info frame 0} proc ::tcltest::RunTest"


# -------------------------------------------------------------------------
# literal sharing 2, bug 2933089

test info-39.1 {location information not confused by literal sharing, bug 2933089} -setup {
    set result {}
1871
1872
1873
1874
1875
1876
1877
1878
1879


1880
1881
1882
1883
1884
1885
1886
1896
1897
1898
1899
1900
1901
1902


1903
1904
1905
1906
1907
1908
1909
1910
1911







-
-
+
+







    test_info_frame;
    join $result \n
} -cleanup {
    trace remove execution print_one enter get_frame_info
    rename get_frame_info {}
    rename test_info_frame {}
    rename print_one {}
} -result {type source line 1854 file info.test cmd print_one proc ::test_info_frame level 1
type source line 1859 file info.test cmd print_one proc ::test_info_frame level 1}
} -result "type source line [expr {$offset + 1854}] file info.test cmd print_one proc ::test_info_frame level 1
type source line [expr {$offset + 1859}] file info.test cmd print_one proc ::test_info_frame level 1"

# -------------------------------------------------------------------------
# Tests moved to the end to not disturb other tests and their locations.

test info-38.6 {location information for uplevel, ppl, proc-proc-literal} -match glob -setup {subinterp} -body {
    interp eval sub {
	proc etrace {} {
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911





1912
1913
1914
1915
1916
1917
1918
1925
1926
1927
1928
1929
1930
1931





1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943







-
-
-
-
-
+
+
+
+
+







	    control y {
		set y PPL
		etrace
	    }
	}
	join [lrange [datal] 0 4] \n
    }
} -result {* {type source line 1890 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type source line 1902 file info.test cmd etrace proc ::control}
* {type source line 1897 file info.test cmd {uplevel 1 $script} proc ::control}
* {type source line 1900 file info.test cmd control proc ::datal level 1}
* {type source line 1905 file info.test cmd datal level 2}} -cleanup {interp delete sub}
} -result "* {type source line [expr {$offset + 1890}] file info.test cmd {info frame \$level} proc ::etrace level 0}
* {type source line [expr {$offset + 1902}] file info.test cmd etrace proc ::control}
* {type source line [expr {$offset + 1897}] file info.test cmd {uplevel 1 \$script} proc ::control}
* {type source line [expr {$offset + 1900}] file info.test cmd control proc ::datal level 1}
* {type source line [expr {$offset + 1905}] file info.test cmd datal level 2}" -cleanup {interp delete sub}

test info-38.4 {location information for uplevel, dpv, direct-proc-literal} -match glob -setup {subinterp} -body {
    interp eval sub {
	proc etrace {} {
	    set res {}
	    set level [info frame]
	    while {$level} {
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
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







-
-
-
-
+
+
+
+

















-
-
-
+
+
+




















-
+













-
+














-
+














-
+














-
+














-
+














-
+














-
+












-
+














-
+













-
+













-
+












-
+











-
+











-
+












-
+











-
+












-
+












-
+













-
+













-
+













-
+













-
+












-
+












-
+












-
+












-
+












-
+











-
+












-
+











-
+












-
+







	    return [uplevel 1 $script]
	}
	join [lrange [control y {
	    set y DPL
	    etrace
	}] 0 3] \n
    }
} -result {* {type source line 1919 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type source line 1930 file info.test cmd etrace proc ::control}
* {type source line 1926 file info.test cmd {uplevel 1 $script} proc ::control}
* {type source line 1928 file info.test cmd control level 1}} -cleanup {interp delete sub}
} -result "* {type source line [expr {$offset + 1919}] file info.test cmd {info frame \$level} proc ::etrace level 0}
* {type source line [expr {$offset + 1930}] file info.test cmd etrace proc ::control}
* {type source line [expr {$offset + 1926}] file info.test cmd {uplevel 1 \$script} proc ::control}
* {type source line [expr {$offset + 1928}] file info.test cmd control level 1}" -cleanup {interp delete sub}

test info-38.2 {location information for uplevel, dl, direct-literal} -match glob -setup {subinterp} -body {
    interp eval sub {
	proc etrace {} {
	    set res {}
	    set level [info frame]
	    while {$level} {
		lappend res [list $level [reduce [info frame $level]]]
		incr level -1
	    }
	    return $res
	}
	join [lrange [uplevel \#0 {
	    set y DL.
	    etrace
	}] 0 2] \n
    }
} -result {* {type source line 1944 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type source line 1951 file info.test cmd etrace level 1}
* {type source line 1949 file info.test cmd uplevel\\ \\\\ level 1}} -cleanup {interp delete sub}
} -result "* {type source line [expr {$offset + 1944}] file info.test cmd {info frame \$level} proc ::etrace level 0}
* {type source line [expr {$offset + 1951}] file info.test cmd etrace level 1}
* {type source line [expr {$offset + 1949}] file info.test cmd uplevel\\\\ \\\\\\\\ level 1}" -cleanup {interp delete sub}

# This test at the end of this file _only_ to avoid disturbing above line
# numbers. It _belongs_ after info-9.12
test info-9.13 {info level option, value in global context} -body {
    uplevel #0 {info level 2}
} -returnCodes error -result {bad level "2"}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    catch {*}{
	{info frame 0}
	res
    }
    return $res
}
test info-33.4 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 1968 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 1968}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    dict for {a b} {c d} {*}{
	{set res [info frame 0]}
    }
    return $res
}
test info-33.5 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 1983 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 1983}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    set d {a b}
    dict update d x y {*}{
	{set res [info frame 0]}
    }
    return $res
}
test info-33.6 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 1998 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 1998}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    set d {}
    dict with d {*}{
	{set res [info frame 0]}
    }
    return $res
}
test info-33.7 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2013 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2013}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    for {*}{
	{set res [info frame 0]}
	{1} {} {break}
    }
    return $res
}
test info-33.8 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2027 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2027}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    for {*}{
	{} {1} {}
	{set res [info frame 0]; break}
    }
    return $res
}
test info-33.9 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2043 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2043}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    for {*}{
	{} {1}
	{return [info frame 0]}
	{}
    }
}
test info-33.10 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2058 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2058}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    for {*}{
	{}
	{[return [info frame 0]]}
	{} {}
    }
}
test info-33.11 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2073 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2073}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    foreach {*}{
	x
    } [return [info frame 0]] {}
}
test info-33.12 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2088 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2088}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    foreach {*}{
	x y
	{set res [info frame 0]}
    }
    return $res
}
test info-33.13 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2101 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2101}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    if {*}{
	{[return [info frame 0]]}
	{}
    }
}
test info-33.14 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2115 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2115}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    if 0 {*}{
	{} else
	{return [info frame 0]}
    }
}
test info-33.15 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2130 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2130}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    incr {*}{
	x
    } [return [info frame 0]]
}
test info-33.16 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2144 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2144}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    info level {*}{
    } [return [info frame 0]]
}
test info-33.17 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2156 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2156}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    string match {*}{
    } [return [info frame 0]] {}
}
test info-33.18 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2168 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2168}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    string match {*}{
	{}
    } [return [info frame 0]]
}
test info-33.19 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2181 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2181}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    string length {*}{
    } [return [info frame 0]]
}
test info-33.20 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2193 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2193}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    while {*}{
	{[return [info frame 0]]}
    } {}
}
test info-33.21 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2205 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2205}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    switch -- {*}{
    } [return [info frame 0]] {*}{
    } x y
}
test info-33.22 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2218 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2218}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    try {*}{
	{set res [info frame 0]}
    }
    return $res
}
test info-33.23 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2231 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2231}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    try {*}{
	{set res [info frame 0]}
    } finally {}
    return $res
}
test info-33.24 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2245 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2245}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    try {*}{
	{set res [info frame 0]}
    } on ok {} {}
    return $res
}
test info-33.25 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2259 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2259}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    try {*}{
	{set res [info frame 0]}
    } on ok {} {} finally {}
    return $res
}
test info-33.26 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2273 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2273}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    while 1 {*}{
	{return [info frame 0]}
    }
}
test info-33.27 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2287 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2287}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    try {} finally {*}{
	{return [info frame 0]}
    }
}
test info-33.28 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2300 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2300}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    try {} on ok {} {} finally {*}{
	{return [info frame 0]}
    }
}
test info-33.29 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2313 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2313}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    try {} on ok {} {*}{
	{return [info frame 0]}
    }
}
test info-33.30 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2326 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2326}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    try {} on ok {} {*}{
	{return [info frame 0]}
    } finally {}
}
test info-33.31 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2339 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2339}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    binary format {*}{
    } [return [info frame 0]]
}
test info-33.32 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2352 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2352}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    set format format
    binary $format {*}{
    } [return [info frame 0]]
}
test info-33.33 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2365 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2365}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    append x {*}{
    } [return [info frame 0]]
}
test info-33.34 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2377 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2377}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    append {*}{
    } x([return [info frame 0]]) {*}{
    } a
}
test info-33.35 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2389 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result "type source line [expr {$offset + 2389}] file info.test cmd {info frame 0} proc ::foo::bar level 0"

# -------------------------------------------------------------------------

namespace eval ::testinfocmdtype {
    apply {cmds {
	foreach c $cmds {rename $c {}}
    } ::testinfocmdtype} [info commands ::testinfocmdtype::*]
Changes to tests/init.test.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# Functionality covered: this file contains a collection of tests for the auto
# loading and namespaces.
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Functionality covered: this file contains a collection of tests for the auto
# loading and namespaces.
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# Clear out any namespaces called test_ns_*
Changes to tests/internals.tcl.












1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17





18
19
20
21
22
23
24
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-







# Copyright © 2020 Sergey G. Brester (sebres).
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains internal facilities for Tcl tests.
#
# Source this file in the related tests to include from tcl-tests:
#
#   source [file join [file dirname [info script]] internals.tcl]
#
# Copyright © 2020 Sergey G. Brester (sebres).
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[namespace which -command ::tcltest::internals::scriptpath] eq ""} {namespace eval ::tcltest::internals {

namespace path ::tcltest

::tcltest::ConstraintInitializer testWithLimit { expr {[testConstraint macOrUnix] && ![catch { exec prlimit --version }]} }

Changes to tests/interp.test.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# This file tests the multiple interpreter facility of Tcl
#
# 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 © 1995-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file tests the multiple interpreter facility of Tcl
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
3340
3341
3342
3343
3344
3345
3346
3347

3348
3349
3350
3351
3352
3353
3354
3347
3348
3349
3350
3351
3352
3353

3354
3355
3356
3357
3358
3359
3360
3361







-
+







	    after 100
	    log 2
	}
    } msg
    interp delete $i
    lappend result $msg
} -result {1 {time limit exceeded}}
test interp-34.11 {time limit extension in callbacks} -constraints knownBug -setup {
test interp-34.11 {time limit extension in callbacks} -setup {
    proc cb1 {i args} {
	global result
	lappend result cb1
	$i limit time {*}[_ms_limit_args {*}$args] -command cb2
    }
    proc cb2 {} {
	global result
Changes to tests/io.test.
1
2
3
4
5
6
7
8
9
10
11
12
13
14














15
16
17
18
19
20
21








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
-
-
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+







# -*- tcl -*-
# Functionality covered: operation of all IO commands, and all procedures
# defined in generic/tclIO.c.
#
# 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 © 1991-1994 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Functionality covered: operation of all IO commands, and all procedures
# defined in generic/tclIO.c.
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
}

namespace eval ::tcl::test::io {
    namespace import ::tcltest::*
1183
1184
1185
1186
1187
1188
1189
1190

1191
1192
1193
1194
1195
1196
1197
1189
1190
1191
1192
1193
1194
1195

1196
1197
1198
1199
1200
1201
1202
1203







-
+







    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding shiftjis -profile tcl8
    set x [list [gets $f line] $line [eof $f]]
    close $f
    set x
} [list 10 "1234567890" 0]
test io-7.3 {FilterInputBytes: split up character at EOF} {testchannel} {
test io-7.3 {FilterInputBytes: split up character at EOF} testchannel {
    set f [open $path(test1) w]
    fconfigure $f -translation binary
    puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding shiftjis -profile tcl8
    set x [list [gets $f line] $line]
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
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







-
-
+
+
-
-
-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding utf-8 -buffersize 10
    set in [read $f]
    close $f
    scan [string index $in end] %c
} 160
test io-12.9 {ReadChars: multibyte chars split} -body {
    set f [open $path(test1) w]


    fconfigure $f -translation binary
    puts -nonewline $f [string repeat a 9]\xC2
    close $f
    set f [open $path(test1)]
apply [list {} {
    fconfigure $f -encoding utf-8 -profile tcl8 -buffersize 10
    set in [read $f]
    set template {
    read $f
    scan [string index $in end] %c
} -cleanup {
    catch {close $f}
} -result 194
test io-12.10 {ReadChars: multibyte chars split} -body {
    set f [open $path(test1) w]
    fconfigure $f -translation binary
    puts -nonewline $f [string repeat a 9]\xC2
    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding utf-8 -profile strict -buffersize 10
    set in [read $f]
    close $f
    scan [string index $in end] %c
} -cleanup {
    catch {close $f}
} -returnCodes 1 -match glob -result {error reading "file*":\
	test {io-12.9 @variant@} {ReadChars: multibyte chars split, default (strict)} -body {
	    set res {}
	    set f [open $path(test1) w]
	    fconfigure $f -translation binary
	    puts -nonewline $f [string repeat a 9]\xC2
	    close $f
	    set f [open $path(test1)]
	    fconfigure $f -encoding utf-8 @strict@ -buffersize 10
	    set status [catch {read $f} cres copts]
	    if {$status} {
		if {[dict exists $copts -result read]} {
		    set in [dict get $copts -result read]
		} else {
		    set in {}
		}
	    } else {
		set in $cres 
	    }
	    lappend res $in
	    lappend res $status $cres
	    set scan [scan [string index $in end] %c]
	    lappend res $scan

	    set status [catch {read $f} cres copts]
	    if {$status} {
		if {[dict exists $copts -result read]} {
	invalid or incomplete multibyte or wide character}
test io-12.11 {ReadChars: multibyte chars split} -body {
    set f [open $path(test1) w]
		    set in [dict get $copts -result read]
    fconfigure $f -translation binary
    puts -nonewline $f [string repeat a 9]\xC2
    close $f
		} else {
    set f [open $path(test1)]
    fconfigure $f -encoding utf-8 -profile tcl8 -buffersize 10
    set in [read $f]
    close $f
    scan [string index $in end] %c
} -cleanup {
    catch {close $f}
} -result 194
		    set in {}
		}
	    } else {
		set in $cres 
	    }
	    lappend res $in
	    lappend res $status $cres
	    set scan [scan [string index $in end] %c]
	    lappend res $scan
	    set res
	} -cleanup {
	    catch {close $f}
	} -match glob -result @result@
    }

    set errorres {aaaaaaaaa 1 {error reading "file*":\
	invalid or incomplete multibyte or wide character} 97\
	{} 1 {error reading "file*":\
	invalid or incomplete multibyte or wide character} {}}

    # if default encoding is not currently to strict
    # foreach variant {default encodingstrict} strict {{} {-encodingstrict 1}} 
    foreach variant {
	{profile default} {profile strict} {profile tcl8}
    } strict {{} {-profile strict} {-profile tcl8}} result [list \
	$errorres $errorres [
	    list aaaaaaaaa\xC2 0 aaaaaaaaa\xC2 194 {} 0 {} {}]
    ] {
	set script [string map [
	    list @result@ [list $result] @variant@ $variant @strict@ $strict] $template] 
	uplevel 1 $script
    }
} [namespace current]]


test io-13.1 {TranslateInputEOL: cr mode} {} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\rdef\r"
    close $f
    set f [open $path(test1)]
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
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







-
+


-
-


+


-
+
+


-
+
-
-
-
-
-
-













-
+
-
-
-
+
+






-
+




-
-





-
+



















-
-
-
-
+
+
+
+









test io-28.6 {
	close channel in write event handler

	Should not produce a segmentation fault in a Tcl built with
	--enable-symbols and -DPURIFY
} -body {
} debugpurify {
    variable done
    variable res
    # Not a complete / correct channel implementation. Just enough
    # to exercise the crash - closing from a write handler
    after 0 [list coroutine c1 apply [list {} {
	variable done
	# just enough of a refchan for the purpose of the test
	set chan [chan create w {apply {{cmd chan args} {
	    switch $cmd {
		blocking - finalize {
		initialize {
		    list initialize finalize watch write configure blocking
		}
		watch {
		    lappend ::timers286 [after 0 chan postevent $chan write]
		    chan postevent $chan write
		}
		initialize {
		    list initialize finalize watch read write configure blocking
		}
		default {
		    error [list {unexpected command} $cmd]
		}
	    }
	}}}]
	chan configure $chan -blocking 0
	while 1 {
	    chan event $chan writable [list [info coroutine]]
	    yield
	    close $chan
	    set done 1
	    return
	}
    } [namespace current]]]
    vwait [namespace current]::done
    return success
return success
} -cleanup {
    foreach timer $::timers286 {after cancel $timer}
} -result success
} success


test io-28.7 {
    close channel in read event handler

	Should not produce a segmentation fault in a Tcl built with
	--enable-symbols and -DPURIFY
} -body  {
} debugpurify {
    variable done
    variable res
    after 0 [list coroutine c1 apply [list {} {
	variable done
        # Not a complete / correct channel implementation. Just enough
        # to exercise the crash - closing from a read handler
	set chan [chan create r {apply {{cmd chan args} {
	    switch $cmd {
		blocking - finalize {
		}
		watch {
		    lappend ::timers287 [after 0 chan postevent $chan read]
		    chan postevent $chan read
		}
		initialize {
		    list initialize finalize watch read write configure blocking
		}
		default {
		    error [list {unexpected command} $cmd]
		}
	    }
	}}}]
	chan configure $chan -blocking 0
	while 1 {
	    chan event $chan readable [list [info coroutine]]
	    yield
	    close $chan
	    set done 1
	    return
	}
    } [namespace current]]]
    vwait [namespace current]::done
    return success
} -cleanup {
    foreach timer $::timers287 {after cancel $timer}
} -result success
return success
} success



test io-29.1 {Tcl_WriteChars, channel not writable} {
    list [catch {puts stdin hello} msg] $msg
} {1 {channel "stdin" wasn't opened for writing}}
test io-29.2 {Tcl_WriteChars, empty string} {
    file delete $path(test1)
    set f [open $path(test1) w]
5844
5845
5846
5847
5848
5849
5850
5851

5852
5853
5854
5855
5856
5857
5858
5859
5860
5861
5862
5863

5864
5865
5866
5867
5868
5869
5870
5867
5868
5869
5870
5871
5872
5873

5874
5875
5876
5877
5878
5879
5880
5881
5882
5883
5884
5885

5886
5887
5888
5889
5890
5891
5892
5893







-
+











-
+







    update
    fconfigure $s2 -translation {auto auto}
    set modes [fconfigure $s2 -translation]
    close $s1
    close $s2
    set modes
} {auto crlf}
test io-39.22 {Tcl_SetChannelOption, invariance} -constraints {unix deprecated} -body {
test io-39.22 {Tcl_SetChannelOption, invariance} -constraints unix -body {
    file delete $path(test1)
    set f1 [open $path(test1) w+]
    set l ""
    lappend l [fconfigure $f1 -eofchar]
    fconfigure $f1 -eofchar {O {}}
    lappend l [fconfigure $f1 -eofchar]
    fconfigure $f1 -eofchar D
    lappend l [fconfigure $f1 -eofchar]
    close $f1
    set l
} -result {{} O D}
test io-39.22a {Tcl_SetChannelOption, invariance} -constraints deprecated -body {
test io-39.22a {Tcl_SetChannelOption, invariance} -body {
    file delete $path(test1)
    set f1 [open $path(test1) w+]
    set l [list]
    fconfigure $f1 -eofchar {O {}}
    lappend l [fconfigure $f1 -eofchar]
    fconfigure $f1 -eofchar D
    lappend l [fconfigure $f1 -eofchar]
6232
6233
6234
6235
6236
6237
6238
6239
6240
6241
6242
6243

6244
6245
6246
6247
6248

6249
6250
6251
6252
6253
6254
6255
6256
6257
6258
6259

6260
6261
6262
6263
6264
6265
6266
6267
6268
6269
6270
6271
6272
6273
6274
6275
6276
6277
6278



6279
6280
6281
6282


6283
6284
6285
6286
6287
6288
6289
6290
6291
6292
6293



6294
6295
6296
6297
6298
6299
6300
6301
6302



6303
6304
6305
6306
6307
6308
6309
6310
6311
6312
6313
6314
6315
6316
6317
6318

6319
6320
6321
6322
6323
6324
6325
6326
6327
6328
6329
6330
6331
6332
6333
6334
6335
6336
6337
6338
6339
6340
6341
6342
6343
6344
6345
6346
6347
6348
6349
6350
6351
6352
6353
6354
6355
6356
6357
6358
6359
6360
6361
6362
6363
6364
6365
6366
6367
6368
6369
6370
6371
6372
6373
6374
6375
6376
6255
6256
6257
6258
6259
6260
6261



6262

6263
6264
6265
6266
6267

6268

6269
6270


6271
6272
6273
6274
6275

6276
6277
6278
6279
6280
6281
6282
6283
6284
6285
6286
6287
6288
6289






6290
6291
6292




6293
6294











6295
6296
6297









6298
6299
6300

6301
6302
6303
6304
6305
6306
6307
6308
6309
6310
6311
6312
6313


6314
6315
6316
6317
6318
6319
6320
6321
6322
6323










































6324
6325
6326
6327
6328
6329
6330







-
-
-

-
+




-
+
-


-
-





-
+













-
-
-
-
-
-
+
+
+
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
-













-
-
+









-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    set x
} -cleanup {
    close $f4
} -result {initial foo eof}

close $f

# Bug https://core.tcl-lang.org/tcl/info/de232b49f26da1c1 with a corrected
# refchan implementation. refchans should be responsible for their own
# event generation and the one in the bug report was not doing so.
test io-44.6 {FileEventProc procedure: write-only non-blocking channel} -setup {
} -constraints {stdio fileevent} -body {
} -constraints {stdio fileevent openpipe} -body {

    namespace eval refchan {
	namespace ensemble create
	namespace export *
        # Change to taste depending on how much CPU you want to hog

        variable delay 0

	proc finalize {chan args} {
            namespace upvar c_$chan timer timer
            catch {after cancel $timer}
	    namespace delete c_$chan
	}

	proc initialize {chan args} {
	    namespace eval c_$chan {}
	    namespace upvar c_$chan watching watching timer timer
	    namespace upvar c_$chan watching watching
	    set watching {}
	    list finalize initialize seek watch write
	}


	proc watch {chan args} {
	    namespace upvar c_$chan watching watching
	    foreach arg $args {
		switch $arg {
		    write {
			if {$arg ni $watching} {
			    lappend watching $arg
			}
		    }
		}
	    }
            update $chan
	}

			chan postevent $chan $arg
		    }
		}
	proc write {chan args} {
	    return 1
	}

	    }
	}
        # paraphrased from tcllib
        proc update {chan} {
            namespace upvar c_$chan watching watching timer timer
            variable delay
            catch {after cancel $timer}
            if {"write" in $watching} {
                set timer [after idle after $delay \
                               [namespace code [list post $chan]]]
            }
        }



	proc write {chan args} {
        # paraphrased from tcllib
        proc post {chan} {
            variable delay
            namespace upvar c_$chan watching watching timer timer
            if {"write" in $watching} {
                set timer [after idle after $delay \
                               [namespace code [list post $chan]]]
                chan postevent $chan write
            }
	    chan postevent $chan write
	    return 1
	}
        }
    }
    set f [chan create w [namespace which refchan]]
    chan configure $f -blocking 0
    set data "some data"
    set x 0
    chan event $f writable [namespace code {
	puts $f $data
	incr count [string length $data]
	if {$count > 262144} {
	    chan event $f writable {}
	    set x done
	}
    }]
    # Note: timeout needs to be very long under valgrind
    set token [after 240000 [namespace code {
    set token [after 10000 [namespace code {
	set x timeout
    }]]
    vwait [namespace which -variable x]
    return $x
} -cleanup {
    after cancel $token
    catch {chan close $f}
} -result done

# Bug https://core.tcl-lang.org/tcl/info/67a5eabbd3d1 with a corrected
# refchan implementation. refchans that are not reentrant should use
# event loop to post events and the script in the bug report was not
# doing so.
test io-44.7 {refchan + coroutine yield error } -setup {
    set bghandler [interp bgerror {}]
    namespace eval schan {
        namespace ensemble create
        namespace export *
        proc open {} {
            set chan [chan create read [namespace current]]

        }
        proc initialize {chan mode} {
            return [list initialize finalize read watch]
        }
        proc finalize args {}
        proc read {chan count} {}
        proc watch {chan eventspec} {
            foreach event $eventspec {
                after idle after 0 chan postevent $chan $event
            }
        }
    }
} -cleanup {
    interp bgerror {} $bghandler
    unset -nocomplain ::io-44.7-result
    namespace delete schan
} -body {
    interp bgerror {} [list apply {{res opts} {
        set ::io-44.7-result [dict get $opts -errorinfo]
    }}]
    coroutine c1 apply [list {} {
        set chan [schan::open]
        chan event $chan readable [list [info coroutine]]
        yield
        close $chan
        set ::io-44.7-result success
    } [namespace current]]
    vwait ::io-44.7-result
    set ::io-44.7-result
} -result success

makeFile "foo bar" foo

test io-45.1 {DeleteFileEvent, cleanup on close} {fileevent} {
    set f [open $path(foo) r]
    fileevent $f readable [namespace code {
	lappend x "binding triggered: \"[gets $f]\""
7392
7393
7394
7395
7396
7397
7398
7399
7400


7401
7402
7403
7404
7405
7406
7407
7408
7409
7410
7411
7412
7413
7414
7415
7416
7417


7418
7419
7420
7421

7422
7423

7424
7425
7426
7427
7428
7429


7430
7431
7432
7433

7434
7435

7436
7437
7438
7439
7440
7441
7442
7346
7347
7348
7349
7350
7351
7352


7353
7354
7355
7356
7357
7358
7359
7360
7361
7362
7363
7364
7365
7366
7367
7368
7369


7370
7371
7372
7373
7374
7375
7376
7377

7378
7379
7380
7381
7382


7383
7384
7385
7386
7387
7388
7389
7390

7391
7392
7393
7394
7395
7396
7397
7398







-
-
+
+















-
-
+
+




+

-
+




-
-
+
+




+

-
+







    close $f3
    string compare $msg "channel \"$f2\" is busy"
} {0}
test io-52.3 {TclCopyChannel} {fcopy} {
    file delete $path(test1)
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0
    fconfigure $f2 -translation cr -encoding iso8859-1 -blocking 0
    fconfigure $f1 -encoding utf-8 -translation lf -encoding iso8859-1 -blocking 0
    fconfigure $f2 -encoding utf-8 -translation cr -encoding iso8859-1 -blocking 0
    set s0 [fcopy $f1 $f2]
    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
    close $f1
    close $f2
    set s1 [file size $thisScript]
    set s2 [file size $path(test1)]
    if {("$s1" == "$s2") && ($s0 == $s1)} {
	lappend result ok
    }
    set result
} {0 0 ok}
test io-52.4 {TclCopyChannel} {fcopy} {
    file delete $path(test1)
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    fconfigure $f1 -translation lf -blocking 0
    fconfigure $f2 -translation cr -blocking 0
    fconfigure $f1 -encoding utf-8 -translation lf -blocking 0
    fconfigure $f2 -encoding utf-8 -translation cr -blocking 0
    fcopy $f1 $f2 -size 40
    set result [list [fblocked $f1] [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
    close $f1
    close $f2
    # the file size is 41 because "©" is encoded in two bytes
    lappend result [file size $path(test1)]
} {0 0 0 40}
} {0 0 0 41}
test io-52.4.1 {TclCopyChannel} {fcopy} {
    file delete $path(test1)
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    fconfigure $f1 -translation lf -blocking 0 -buffersize 10000000
    fconfigure $f2 -translation cr -blocking 0
    fconfigure $f1 -encoding utf-8 -translation lf -blocking 0 -buffersize 10000000
    fconfigure $f2 -encoding utf-8 -translation cr -blocking 0
    fcopy $f1 $f2 -size 40
    set result [list [fblocked $f1] [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
    close $f1
    close $f2
    # the file size is 41 because "©" is encoded in two bytes
    lappend result [file size $path(test1)]
} {0 0 0 40}
} {0 0 0 41}
test io-52.5 {TclCopyChannel, all} {fcopy} {
    file delete $path(test1)
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0
    fconfigure $f2 -translation lf -encoding iso8859-1 -blocking 0
    fcopy $f1 $f2 -size -1 ;# -1 means 'copy all', same as if no -size specified.
7523
7524
7525
7526
7527
7528
7529
7530

7531
7532
7533
7534
7535
7536
7537
7538
7539
7540
7541

7542
7543
7544

7545
7546

7547
7548
7549
7550
7551
7552
7553
7479
7480
7481
7482
7483
7484
7485

7486
7487
7488
7489
7490
7491
7492
7493
7494
7495
7496

7497
7498
7499
7500
7501
7502

7503
7504
7505
7506
7507
7508
7509
7510







-
+










-
+



+

-
+







    file delete $path(pipe)
    set f1 [open $path(pipe) w]
    fconfigure $f1 -translation lf
    puts $f1 "
	puts ready
	gets stdin
	set f1 \[open [list $thisScript] r\]
	fconfigure \$f1 -translation lf
	fconfigure \$f1 -encoding utf-8 -translation lf
	puts \[read \$f1 100\]
	close \$f1
    "
    close $f1
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    fconfigure $f1 -translation lf
    gets $f1
    puts $f1 ready
    flush $f1
    set f2 [open $path(test1) w]
    fconfigure $f2 -translation lf
    fconfigure $f2 -encoding utf-8 -translation lf
    set s0 [fcopy $f1 $f2 -size 40]
    catch {close $f1}
    close $f2
    # the file size is 41 because "©" is encoded in two bytes
    list $s0 [file size $path(test1)]
} {40 40}
} {40 41}
# Empty files, to register them with the test facility
set path(kyrillic.txt)   [makeFile {} kyrillic.txt]
set path(utf8-fcopy.txt) [makeFile {} utf8-fcopy.txt]
set path(utf8-rp.txt)    [makeFile {} utf8-rp.txt]
# Create kyrillic file, use lf translation to avoid os eol issues
set out [open $path(kyrillic.txt) w]
fconfigure $out -encoding koi8-r -translation lf
7781
7782
7783
7784
7785
7786
7787






























7788
7789
7790
7791
7792
7793
7794
7738
7739
7740
7741
7742
7743
7744
7745
7746
7747
7748
7749
7750
7751
7752
7753
7754
7755
7756
7757
7758
7759
7760
7761
7762
7763
7764
7765
7766
7767
7768
7769
7770
7771
7772
7773
7774
7775
7776
7777
7778
7779
7780
7781







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    fconfigure $out -encoding koi8-r -translation lf

    fcopy $in $out
} -cleanup {
    close $in
    close $out
} -returnCodes 1 -match glob -result {error reading "file*": invalid or incomplete multibyte or wide character}

test io-52.20.1 {TclCopyChannel & read encoding error & tell position, bug [a173f9229]} -setup {
    set out [open $path(utf8-fcopy.txt) w]
    fconfigure $out -encoding utf-8 -translation lf
    puts $out "AÁ"
    close $out
} -constraints {fcopy knownBug} -body {
    # binary to encoding => the input has to be
    # in utf-8 to make sense to the encoder

    set in  [open $path(utf8-fcopy.txt) r]
    set out [open $path(kyrillic.txt) w]

    # Using "-encoding ascii" means reading the "Á" gives an error
    fconfigure $in  -encoding ascii -profile strict
    fconfigure $out -encoding koi8-r -translation lf

    set l {}
	# should fail, so 1 is added
    lappend l [catch {fcopy $in $out}]
	# should be at position 1, after the first correct byte, so 1 is read.
    lappend l [tell $in]
    # not sure, if flush required, but anyway
    flush $out
	# should be at position 1, after the first correct byte, so 1 is written.
    lappend l [tell $out]
} -cleanup {
    close $in
    close $out
} -returnCodes 0 -result {1 1 1}

test io-52.20.2 {TclCopyChannel & encoding error on same encoding} -setup {
    set out [open $path(utf8-fcopy.txt) w]
    fconfigure $out -encoding utf-8 -translation lf
    puts $out "AÁ"
    close $out
} -constraints {fcopy} -body {
9395
9396
9397
9398
9399
9400
9401




















9402



9403
9404
9405
9406
9407
9408
9409
9382
9383
9384
9385
9386
9387
9388
9389
9390
9391
9392
9393
9394
9395
9396
9397
9398
9399
9400
9401
9402
9403
9404
9405
9406
9407
9408

9409
9410
9411
9412
9413
9414
9415
9416
9417
9418







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+







    binary scan $d H* hd
    set hd
} -cleanup {
    close $f
    removeFile io-75.5
} -result 4181

test io-75.6.read {invalid utf-8 encoding, read is not ignored (-encodingstrict 1)} -setup {
    set fn [makeFile {} io-75.6]
    set f [open $fn w+]
    fconfigure $f -translation binary
    # \x81 is invalid in utf-8
    puts -nonewline $f A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf \
	-profile strict
} -body {
    set status [catch {read $f} cres copts]
    set d [dict get $copts -result read]
    binary scan $d H* hd
    lappend hd $status $cres
} -cleanup {
    close $f
    removeFile io-75.6
} -match glob -result {41 1 {error reading "file*":\
	invalid or incomplete multibyte or wide character}}
test io-75.6 {incomplete utf-8 encoding, blocking gets is not ignored (-profile strict)} -setup {


test io-75.6.gets {invalid utf-8 encoding, gets is not ignored (-profile strict)} -setup {
    set fn [makeFile {} io-75.6]
    set f [open $fn w+]
    fconfigure $f -translation binary
    # \x81 is an incomplete byte sequence in utf-8
    puts -nonewline $f A\x81
    flush $f
    seek $f 0
9491
9492
9493
9494
9495
9496
9497
9498























9499
9500
9501
9502
9503
9504
9505
9506
9507
9508
9509
9510
9511

9512
9513
9514
9515
9516
9517
9518






























9519






9520
9521
9522
9523
9524


9525
9526
9527
9528
9529
9530
9531
9532
9533

9534
9535
9536
9537
9538
9539
9540
9541































9542


9543
9544
9545
9546
9547
9548
9549
9550
9551
9552
9553
9554






9555
9556
9557
9558







9559
9560
9561
9562
9563
9564
9565
9566
9567
9568
9569
9570
9571
9572
9573
9574
9575
9576
9577
9578
9579








9580
9581
9582
9583
9584

9585
9586
9587
9588
9589
9590
9591
9592
9593
9594
9595
9596
9597
9598
9599
9600
9601























9602













9603
9604
9605
9606
9607
9608
9609
9500
9501
9502
9503
9504
9505
9506

9507
9508
9509
9510
9511
9512
9513
9514
9515
9516
9517
9518
9519
9520
9521
9522
9523
9524
9525
9526
9527
9528
9529
9530
9531
9532
9533
9534
9535
9536
9537
9538
9539
9540
9541

9542
9543
9544
9545
9546
9547
9548
9549
9550
9551
9552
9553
9554
9555
9556
9557
9558
9559
9560
9561
9562
9563
9564
9565
9566
9567
9568
9569
9570
9571
9572
9573
9574
9575
9576
9577
9578
9579

9580
9581
9582
9583
9584
9585
9586
9587
9588


9589
9590
9591
9592
9593
9594
9595
9596
9597
9598
9599
9600
9601
9602
9603
9604
9605
9606
9607
9608
9609
9610
9611
9612
9613
9614
9615
9616
9617
9618
9619
9620
9621
9622
9623
9624
9625
9626
9627
9628
9629
9630
9631
9632
9633
9634
9635
9636
9637
9638
9639

9640
9641
9642
9643
9644
9645
9646
9647
9648
9649
9650
9651
9652

9653
9654
9655
9656
9657
9658
9659
9660
9661

9662
9663
9664
9665
9666
9667
9668
9669
9670
9671
9672
9673
9674
9675
9676
9677
9678
9679
9680
9681
9682
9683
9684
9685
9686
9687
9688

9689
9690
9691
9692
9693
9694
9695
9696
9697
9698
9699
9700
9701
9702
9703
9704
9705
9706
9707
9708
9709
9710
9711
9712
9713
9714
9715
9716
9717
9718
9719
9720
9721
9722
9723
9724
9725
9726
9727
9728
9729
9730
9731
9732
9733
9734
9735
9736
9737
9738
9739
9740
9741
9742

9743
9744
9745
9746
9747
9748
9749
9750
9751
9752
9753
9754
9755
9756
9757
9758
9759
9760
9761
9762







-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+












-
+







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+



-
-
+
+









+








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+











-
+
+
+
+
+
+



-
+
+
+
+
+
+
+




















-
+
+
+
+
+
+
+
+





+

















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+







	gets $f
} -cleanup {
    close $f
    removeFile io-75.6.4
} -match glob -returnCodes 1 -result {error reading "file*":\
	invalid or incomplete multibyte or wide character}

test io-75.7 {
test io-75.7.gets {
    invalid utf-8 encoding gets is not ignored (-profile strict)
} -setup {
    set fn [makeFile {} io-75.7]
    set f [open $fn w+]
    fconfigure $f -translation binary
    # \x81 is invalid in utf-8
    puts -nonewline $f A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar {} -translation lf \
	    -profile strict
} -body {
    list [catch {gets $f} msg] $msg
} -cleanup {
    close $f
    removeFile io-75.7
    unset msg f fn
} -match glob -result {1 {error reading "file*":\
    invalid or incomplete multibyte or wide character}}


test io-75.7.read {
    invalid utf-8 encoding read is not ignored (-profile strict)
} -setup {
    set fn [makeFile {} io-75.7]
    set f [open $fn w+]
    fconfigure $f -translation binary
    # \x81 is invalid in utf-8
    puts -nonewline $f A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -translation lf \
	    -profile strict
} -body {
    list [catch {read $f} msg data] $msg [dict get $data -data]
    list [catch {read $f} msg data] $msg [dict get $data -result read]
} -cleanup {
    close $f
    removeFile io-75.7
    unset msg data f fn
} -match glob -result {1 {error reading "file*":\
    invalid or incomplete multibyte or wide character} A}

test {io-75.8 {invalid input before eof}} {invalid utf-8 before eof (-profile strict)} -setup {
	set hd {}
    set fn [makeFile {} io-75.7]
    set f [open $fn w+]
    fconfigure $f -translation binary
    # \xA1 is invalid in utf-8. -eofchar is not detected, because it comes later.
    puts -nonewline $f A\xA1\x1A
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \
	-translation lf -profile strict
} -body {
    set status [catch {read $f} cres copts]
    if {[dict exists $copts -result read]} {
	set d [dict get $copts -result read]
    } else {
	set d {}
    }
    binary scan $d H* hd
    lappend hd [eof $f]
    lappend hd $status
    lappend hd $cres
    fconfigure $f -encoding iso8859-1
    lappend hd [read $f];# We changed encoding, so now we can read the \xA1
    close $f
    set hd
} -cleanup {
    removeFile io-75.7
} -match glob -result {41 0 1 {error reading "file*":\
	invalid or incomplete multibyte or wide character} ¡}
test io-75.8 {invalid utf-8 encoding eof first handling (-profile strict)} -setup {


test {io-75.8 {incomplete input after eof}} {
    incomplete utf-8 char after eof char is not an error (-profile strict)
} -setup {
    set hd {}
    set fn [makeFile {} io-75.8]
    set f [open $fn w+]
    fconfigure $f -translation binary
    # \x81 is invalid in utf-8, but since \x1A comes first, -eofchar takes
    # precedence.
	# \x81 is invalid in utf-8, but since the eof character \x1A comes first,
	# -eofchar takes precedence.
    puts -nonewline $f A\x1A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \
	-translation lf -profile strict
} -body {
    set d [read $f]
    binary scan $d H* hd
    lappend hd [eof $f]
    # there should be no error on additional reads
    lappend hd [read $f]
    set hd
} -cleanup {
    close $f
    removeFile io-75.8
    unset f d hd
} -result {41 1 {}}


test {io-75.8 {invalid input after eof}} {
	invalid utf-8 after eof char is not an error (-profile strict)
} -setup {
    set res {}
    set fn [makeFile {} io-75.8]
    set f [open $fn w+]
    fconfigure $f -translation binary
    # \xc0\x80 is invalid utf-8 data, but because the eof character \x1A
    # appears first, it's not an error.
    puts -nonewline $f A\x1a\xc0\x80
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \
	-translation lf -profile strict
} -body {
    set d [read $f]
    foreach char [split $d {}] {
	lappend res [format %x [scan $char %c]]
    }
    lappend res [eof $f]
    # there should be no error on additional reads
    lappend res [read $f]
    close $f
    set res
} -cleanup {
    removeFile io-75.8
} -result {41 1 {}}


test {io-75.8 {invalid input before eof}} {
test io-75.8.eoflater {invalid utf-8 encoding eof after handling (-profile strict)} -setup {
	invalid utf-8 encoding eof handling (-profile strict)
} -setup {
    set fn [makeFile {} io-75.8]
    set f [open $fn w+]
    # This also configures the channel encoding profile as strict.
    fconfigure $f -translation binary
    # \x81 is invalid in utf-8. -eofchar is not detected, because it comes later.
    puts -nonewline $f A\x81\x81\x1A
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \
	-translation lf -profile strict
} -body {
    set res [list [catch {read $f} msg data] [eof $f] [dict get $data -data]]
    set res [list [catch {read $f} msg data] [eof $f]]
    if {[dict exists $data -result read]} {
	lappend res [dict get $data -result read]
    } else {
	lappend res {}
    }
    chan configure $f -encoding iso8859-1
    lappend res [read $f 1]
    chan configure $f -encoding utf-8
    lappend res [catch {read $f 1} msg data] $msg [dict get $data -data]
    lappend res [catch {read $f 1} msg data] $msg
    if {[dict exists $data -result read]} {
	lappend res [dict get $data -result read]
    } else {
	lappend res {}
    }
    return $res
} -cleanup {
    close $f
    removeFile io-75.8
    unset res msg data fn f
} -match glob -result "1 0 A \x81 1 {error reading \"*\":\
    invalid or incomplete multibyte or wide character} {}"


test io-strict-multibyte-eof {
    incomplete utf-8 sequence immediately prior to eof character

    See issue 25cdcb7e8fb381fb
} -setup {
    set chan [file tempfile];
    fconfigure $chan -translation binary
    puts -nonewline $chan \x81\x1A
    flush $chan
    seek $chan 0
    chan configure $chan -encoding utf-8 -profile strict
} -body {
    list [catch {read $chan 1} msg data] $msg [dict get $data -data]
    list [catch {read $chan 1} msg data] $msg [if {
	    [dict exists $data -result read]
	} {
	    dict get $data -result read
	} else {
	    lindex {}
	}
    ]
} -cleanup {
    close $chan
    unset msg chan data
} -match glob -result {1 {error reading "*":\
    invalid or incomplete multibyte or wide character} {}}


test io-75.9 {unrepresentable character write throws error in strict profile} -setup {
    set fn [makeFile {} io-75.9]
    set f [open $fn w+]
    fconfigure $f -encoding iso8859-1 -profile strict
} -body {
    catch {puts -nonewline $f "A\u2022"} msg
    flush $f
    seek $f 0
    list [read $f] $msg
} -cleanup {
    close $f
    removeFile io-75.9
    unset f
} -match glob -result [list {A} {error writing "*":\
    invalid or incomplete multibyte or wide character}]

apply [list {} {
    set template {
	test {io-75.10 ${mode}} {
	    incomplete multibyte encoding read is an error
	} -setup {
	    set res {}
	    set fn [makeFile {} io-75.10]
	    set f [open $fn w+]
	    fconfigure $f -translation binary
	    puts -nonewline $f A\xC0
	    flush $f
	    seek $f 0
	    fconfigure $f -encoding utf-8 -buffering none {*}${option}
	} -body {
	    set status [catch {read $f} cres copts]
	    set d [dict get $copts -result read]
	    close $f
	    binary scan $d H* hd
	    lappend res $hd
	    lappend res $status
	    lappend res $cres
	    return $res
	} -cleanup {
test io-75.10 {
	    removeFile io-75.10
	} -match glob -result {41 1 {error reading "file*":\
		invalid or incomplete multibyte or wide character}}
    }
	# the default encoding mode is not currently strict
    #foreach mode {default strict} option {{} {-encodingstrict 1}} 
    foreach mode {{profile strict}} option {{-profile strict}} {
	set test [string map [
	    list {${mode}} [list $mode] {${option}} [list $option]] $template]
	uplevel $test
    }
} [namespace current]]
test {io-75.10 {profile tcl8}} {
    incomplete multibyte encoding read is not ignored because "binary" sets
    profile to strict
} -setup {
    set res {}
    set fn [makeFile {} io-75.10]
    set f [open $fn w+]
    fconfigure $f -translation binary
9642
9643
9644
9645
9646
9647
9648
9649


9650
9651
9652
9653
9654
9655
9656



9657
9658
9659






































9660
9661
9662
9663
9664
9665
9666
9795
9796
9797
9798
9799
9800
9801

9802
9803
9804
9805
9806
9807
9808
9809
9810
9811
9812
9813



9814
9815
9816
9817
9818
9819
9820
9821
9822
9823
9824
9825
9826
9827
9828
9829
9830
9831
9832
9833
9834
9835
9836
9837
9838
9839
9840
9841
9842
9843
9844
9845
9846
9847
9848
9849
9850
9851
9852
9853
9854
9855
9856
9857
9858







-
+
+







+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    flush $f
    seek $f 0
    fconfigure $f -encoding shiftjis -blocking 0 -translation lf \
	-profile strict
} -body {
    set d [read $f]
    binary scan $d H* hd
    lappend hd [catch {set d [read $f]} msg data] $msg [dict exists $data -data]
    lappend hd [catch {set d [read $f]} msg data] $msg [
	dict exists $data -result read]
} -cleanup {
    close $f
    removeFile io-75.11
    unset d hd msg data f
} -match glob -result {41 1 {error reading "file*":\
    invalid or incomplete multibyte or wide character} 0}


apply [list {} {
    set template {
test io-75.12 {
    invalid utf-8 encoding read is not ignored because setting the encoding to
    "binary" also set the profile to strict
	test {io-75.12 ${mode}} {
	    invalid utf-8 encoding read returns an error
	} -setup {
	    set res {}
	    set fn [makeFile {} io-75.12]
	    set f [open $fn w+]
	    fconfigure $f -translation binary
	    puts -nonewline $f A\x81
	    flush $f
	    seek $f 0
	    fconfigure $f -encoding utf-8 -buffering none -eofchar {} \
		    -translation lf {*}${option}
	} -body {
	    set status [catch {read $f} cres copts]
	    set d [dict get $copts -result read]
	    close $f
	    binary scan $d H* hd
	    lappend res $hd $status $cres
	    return $res
	} -cleanup {
	    removeFile io-75.12
	} -match glob -result {41 1 {error reading "file*":\
		invalid or incomplete multibyte or wide character}}
    }

    # the default encoding mod is not currently strict
    #foreach mode {default strict} option {{} {-encodingstrict 1}}
    foreach mode {{profile strict}} option {{-profile strict}} {
	set test [string map [
	    list {${mode}} [list $mode] {${option}} [list $option]] $template]
	uplevel $test
    }
} [namespace current]]


test {io-75.12 {profile tcl8}} {
    invalid utf-8 encoding read, is not ignored because setting the encoding to
    "binary" also sets the profile to strict
} -setup {
    set res {}
    set fn [makeFile {} io-75.12]
    set f [open $fn w+]
    fconfigure $f -translation binary
    puts -nonewline $f A\x81
    flush $f
9678
9679
9680
9681
9682
9683
9684























9685
9686
9687
9688
9689
9690
9691
9692
9693
9694
9695
9696
9697
9698
9699
9700
9701

9702
9703
9704
9705
9706
9707
9708
9870
9871
9872
9873
9874
9875
9876
9877
9878
9879
9880
9881
9882
9883
9884
9885
9886
9887
9888
9889
9890
9891
9892
9893
9894
9895
9896
9897
9898
9899
9900
9901
9902
9903
9904
9905
9906
9907
9908
9909
9910
9911
9912
9913
9914
9915

9916
9917
9918
9919
9920
9921
9922
9923







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
















-
+







} -cleanup {
    close $f
    removeFile io-75.12
    unset res
} -match glob -result {{error reading "file*":\
    invalid or incomplete multibyte or wide character} 4181}
test io-75.13 {
    In blocking mode [read] produces an error and leaves the data succesfully
    read so far in the return options dictionary.
} -setup {
    set fn [makeFile {} io-75.13]
    set f [open $fn w+]
    fconfigure $f -translation binary
    # \x81 is invalid in utf-8
    puts -nonewline $f A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -eofchar "" -translation lf -profile strict
} -body {
    set status [catch {read $f} cres copts]
    set d [dict get $copts -result read]
    binary scan $d H* hd
    lappend hd $status
    lappend hd $cres
} -cleanup {
    close $f
    removeFile io-75.13
} -match glob -result {41 1 {error reading "file*":\
	invalid or incomplete multibyte or wide character}}
test io-75.13.nonblocking {
    In nonblocking mode when there is an encoding error the data that has been
    successfully read so far is returned first and then the error is returned
    on the next call to [read].
} -setup {
    set fn [makeFile {} io-75.13]
    set f [open $fn w+]
    fconfigure $f -translation binary
    # \x81 is invalid in utf-8
    puts -nonewline $f A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -blocking 0 -translation lf \
	-profile strict
} -body {
    set d [read $f]
    binary scan $d H* hd
    lappend hd [catch {read $f} msg data] $msg [dict exists $data -data]
    lappend hd [catch {read $f} msg data] $msg [dict exists $data -result read]
} -cleanup {
    close $f
    removeFile io-75.13
    unset d hd msg data f fn
} -match glob -result {41 1 {error reading "file*":\
    invalid or incomplete multibyte or wide character} 0}

9718
9719
9720
9721
9722
9723
9724
9725







9726
9727
9728
9729
9730
9731
9732
9733
9734

9735
9736
9737
9738
9739
9740
9741
9742
9743
9744
9745
9746
9747
9748
9749
9750
9751
9752
9753


9754
9755
9756
9757
9758
9759
9760
9761
9762
9763
9764
9765
9766
9767
9768






























































9769
9770
9771
9772
9773
9774
9775
9933
9934
9935
9936
9937
9938
9939

9940
9941
9942
9943
9944
9945
9946
9947
9948
9949
9950
9951
9952
9953
9954

9955
9956
9957
9958
9959
9960
9961
9962
9963
9964
9965
9966
9967
9968
9969
9970
9971
9972


9973
9974
9975
9976
9977
9978
9979
9980
9981
9982
9983
9984
9985
9986
9987
9988
9989
9990
9991
9992
9993
9994
9995
9996
9997
9998
9999
10000
10001
10002
10003
10004
10005
10006
10007
10008
10009
10010
10011
10012
10013
10014
10015
10016
10017
10018
10019
10020
10021
10022
10023
10024
10025
10026
10027
10028
10029
10030
10031
10032
10033
10034
10035
10036
10037
10038
10039
10040
10041
10042
10043
10044
10045
10046
10047
10048
10049
10050
10051
10052
10053
10054
10055
10056
10057
10058







-
+
+
+
+
+
+
+








-
+

















-
-
+
+















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    flush $chan
    seek $chan 0
    fconfigure $chan -encoding utf-8 -buffering none \
	-translation auto -profile strict
} -body {
    set res [gets $chan]
    lappend res [gets $chan]
    lappend res [catch {gets $chan} msg data] $msg [dict exists $data -data]
    lappend res [catch {gets $chan} msg data] $msg [
	if {[dict exists $data -result read]} {
	    dict get $data -result read
	} else {
	    lindex {}
	}
    ]
    chan configure $chan -profile tcl8
    lappend res [gets $chan]
    lappend res [gets $chan]
    return $res
} -cleanup {
    close $chan
    unset chan res msg data
} -match glob -result {a b 1 {error reading "*":\
    invalid or incomplete multibyte or wide character} 0 cÀ d}
    invalid or incomplete multibyte or wide character} {} cÀ d}

test io-75.15 {
    invalid utf-8 encoding strict
    gets does not hang
    gets succeeds for the first two lines
} -setup {
    set res {}
    set chan [file tempfile]
    fconfigure $chan -translation binary
    # \xC0\x40 is an invalid utf-8 sequence
    puts $chan hello\nAB\nCD\xC0\x40EF\nGHI
	seek $chan 0
} -body {
    #Now try to read it with [gets]
    fconfigure $chan -encoding utf-8 -profile strict
    lappend res [gets $chan]
    lappend res [gets $chan]
    lappend res [catch {gets $chan} msg data] $msg [dict exists $data -data]
    lappend res [catch {gets $chan} msg data] $msg [dict exists $data -data]
    lappend res [catch {gets $chan} msg data] $msg [dict exists $data -result read]
    lappend res [catch {gets $chan} msg data] $msg [dict exists $data -result read]
	chan configure $chan -translation binary
	set data [read $chan 4]
	foreach char [split $data {}] {
		scan $char %c ord
		lappend res [format %x $ord]
	}
    fconfigure $chan -encoding utf-8 -profile strict -translation auto
	lappend res [gets $chan]
	lappend res [gets $chan]
    return $res
} -cleanup {
    close $chan
    unset chan res msg data
} -match glob -result {hello AB 1 {error reading "*": invalid or incomplete multibyte or wide character}\
    0 1 {error reading "*": invalid or incomplete multibyte or wide character} 0 43 44 c0 40 EF GHI}

test io-75.14 {invalid utf-8 encoding [gets] continues in non-strict mode after error} -setup {
    set res {}
    set fn [makeFile {} io-75.14]
    set f [open $fn w+]
    fconfigure $f -translation binary
    # \xc0 is invalid in utf-8
    puts -nonewline $f a\nb\xc0\nc\n
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar {} -translation lf -profile strict
} -body {
    lappend res [gets $f]
    set status [catch {gets $f} cres copts]
    lappend res $status $cres
    chan configure $f -profile tcl8 
    lappend res [gets $f]
    lappend res [gets $f]
    close $f
    return $res
} -cleanup {
    removeFile io-75.14
} -match glob -result {a 1 {error reading "file*":\
	invalid or incomplete multibyte or wide character} bÀ c}


test io-75.15 {invalid utf-8 encoding strict gets should not hang} -setup {
    set res {}
    set fn [makeFile {} io-75.15]
    set chan [open $fn w+]
    fconfigure $chan -translation binary
    # This is not valid UTF-8
    puts $chan hello\nAB\xc0\x40CD\nEFG
    close $chan
} -body {
    #Now try to read it with [gets]
    set chan [open $fn]
    fconfigure $chan -encoding utf-8 -profile strict
    lappend res [gets $chan]
    set status [catch {gets $chan} cres copts]
    lappend res $status $cres
    set status [catch {gets $chan} cres copts]
    lappend res $status $cres
    lappend res [
	if {[dict exists $copts -result read]} {
	    dict get $copts -result read
	} else {
	    lindex {}
	}
    ]

    chan configure $chan -translation binary
    foreach char [split [read $chan 2] {}] {
	lappend res [format %x [scan $char %c]]
    }
    return $res
} -cleanup {
    close $chan
    removeFile io-75.15
} -match glob -result {hello 1 {error reading "file*":\
	invalid or incomplete multibyte or wide character} 1 {error reading "file*":\
	invalid or incomplete multibyte or wide character} {} 41 42}

# ### ### ### ######### ######### #########



test io-76.0 {channel modes} -setup {
    set datafile [makeFile {some characters} dummy]
9886
9887
9888
9889
9890
9891
9892
9893
9894
9895
9896
9897
9898
9899
9900
9901
9902
9903
9904
9905
9906
9907
9908
9909
9910
9911
9912
9913
9914
9915
9916
9917
9918
9919
9920
9921
9922
9923
9924
9925
9926
9927
9928
9929
9930
9931
9932
9933
9934
9935
10169
10170
10171
10172
10173
10174
10175

































10176
10177
10178
10179
10180
10181
10182
10183
10184
10185







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-










    testchannel mremove-rd $f
    testchannel mremove-wr $f
} -returnCodes error -cleanup {
    close $f
    removeFile dummy
} -match glob -result {Tcl_RemoveChannelMode error:\
    Bad mode, would make channel inacessible. Channel: "*"}

# Encoding errors on pipeline
# Ensures fix for exec bug [0f1ddc0df7] does not affect open
# It should still fail unless -profile is explicitly set to replace
test io-77.1 {open pipe encoding mismatch} -setup {
    set scriptFile [makeFile {
        fconfigure stdout -translation binary
        puts -nonewline a\xe9b
        flush stdout
    } script]
} -cleanup {
    close $fd
    removeFile $scriptFile
} -body {
    set fd [open |[list [info nameofexecutable] $scriptFile r+]]
    fconfigure $fd -encoding utf-8
    list [catch {read $fd} result opts] [string match {error reading "*": invalid or incomplete multibyte or wide character} $result] [dict get $opts -errorcode]
} -result [list 1 1 {POSIX EILSEQ {invalid or incomplete multibyte or wide character}}]
test io-77.2 {open pipe encoding mismatch - use replace profile} -setup {
    set scriptFile [makeFile {
        fconfigure stdout -translation binary
        puts -nonewline a\xe9b
        flush stdout
    } script]
} -cleanup {
    close $fd
    removeFile $scriptFile
} -body {
    set fd [open |[list [info nameofexecutable] $scriptFile r+]]
    fconfigure $fd -encoding utf-8 -profile replace
    read $fd
} -result a\uFFFDb


# cleanup
foreach file [list fooBar longfile script2 output test1 pipe my_script \
	test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
    removeFile $file
}
cleanupTests
}
namespace delete ::tcl::test::io
return
Changes to tests/ioCmd.test.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15















16
17
18
19
20
21
22









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
-
-
-
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







# -*- tcl -*-
# Commands covered: open, close, gets, read, puts, seek, tell, eof, flush,
#		    fblocked, fconfigure, open, channel, fcopy,
#		    readFile, writeFile, foreachLine
#
# 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 © 1991-1994 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered: open, close, gets, read, puts, seek, tell, eof, flush,
#		    fblocked, fconfigure, open, channel, fcopy,
#		    readFile, writFile, foreachLine
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
source [file join [file dirname [info script]] tcltests.tcl]

963
964
965
966
967
968
969











970
971
972
973
974
975
976
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







+
+
+
+
+
+
+
+
+
+
+







    return -code return $args
}
proc onfinal {} {
    upvar args hargs
    if {[lindex $hargs 0] ne "finalize"} {return}
    return -code return ""
}

proc onwatch {} {
    upvar args hargs
    lassign $hargs watch chan eventspec
    if {$watch ne "watch"} return
    foreach spec $eventspec {
	chan postevent $chan $spec
    }
    return
}

}

# Set everything up in the main thread.
eval $helperscript

# --- --- --- --------- --------- ---------
# method finalize
1388
1389
1390
1391
1392
1393
1394
1395

1396
1397
1398
1399
1400
1401
1402
1405
1406
1407
1408
1409
1410
1411

1412
1413
1414
1415
1416
1417
1418
1419







-
+







    note [fconfigure $c]
    close $c
    rename foo {}
    set res
} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -profile * -translation {auto *}}}
test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body {
    set res {}
    proc foo args {oninit cget cgetall; onfinal; track; return ""}
    proc foo args {oninit cget cgetall; onfinal; track; return {}}
    set c [chan create {r w} foo]
    note [fconfigure $c]
    close $c
    rename foo {}
    set res
} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -profile * -translation {auto *}}}
test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body {
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
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







-
+












-
+












+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    set stop [after 15000 {lappend res TIMEOUT; set tock 1}]
    after  1000 {note [chan postevent $c r]}
    vwait ::tock
    catch {after cancel $stop}
    close $c
    rename foo {}
    set res
} -result {{watch rc* read} {} TOCK {} {watch rc* {}}}
} -result {{watch rc* read} {} {} TOCK {watch rc* {}}}
test iocmd-31.7 {chan postevent, posted events do happen} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; return}
    set c [chan create {r w} foo]
    note [fileevent $c writable {lappend res TOCK; set tock 1}]
    set stop [after 15000 {lappend res TIMEOUT; set tock 1}]
    after  1000 {note [chan postevent $c w]}
    vwait ::tock
    catch {after cancel $stop}
    close $c
    rename foo {}
    set res
} -result {{watch rc* write} {} TOCK {} {watch rc* {}}}
} -result {{watch rc* write} {} {} TOCK {watch rc* {}}}
test iocmd-31.8 {chan postevent after close throws error} -match glob -setup {
    proc foo {args} {oninit; onfinal; track; return}
    proc dummy args { return }
    set c [chan create {r w} foo]
    fileevent $c readable dummy
} -body {
    close $c
    chan postevent $c read
} -cleanup {
    rename foo   {}
    rename dummy {}
} -returnCodes error -result {can not find reflected channel named "rc*"}
test iocmd-31.9 {
    chan postevent

    call to current coroutine

    see 67a5eabbd3d1
} -match glob -body {
    set res {}
    proc foo {args} {oninit; onwatch; onfinal; track; return}
    set c [chan create {r w} foo]
    after 0 [list ::apply [list c {
	coroutine c1 ::apply [list c {
	    chan event $c readable [list [info coroutine]]
	    yield
	    set ::done READING
	} [namespace current]] $c
    } [namespace current]] $c]
    set stop [after 10000 {set done TIMEOUT}]
    vwait ::done
    catch {after cancel $stop}
    lappend res $done
    close $c
    rename foo {}
    set res
} -result {{watch rc* read} READING {watch rc* {}}}

# --- === *** ###########################
# 'Pull the rug' tests. Create channel in a interpreter A, move to
# other interpreter B, destroy the origin interpreter (A) before or
# during access from B. Must not crash, must return proper errors.

test iocmd-32.0 {origin interpreter of moved channel gone} -match glob -body {
Changes to tests/ioTrans.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19







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
-
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# -*- tcl -*-
# Functionality covered: operation of the reflected transformation
#
# 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 © 2007 Andreas Kupries <andreask@activestate.com>
#                                    <akupries@shaw.ca>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Functionality covered: operation of the reflected transformation
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/iogt.test.
1
2


3
4

5
6
7
8
9
10
11











12
13
14
15
16
17
18


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
-
-
+
+

-
+



-
-
-
-
+
+
+
+
+
+
+
+
+
+
+







# -*- tcl -*-
# Commands covered:  transform, and stacking in general
# Copyright © 2000 Ajuba Solutions.
# Copyright © 2000 Andreas Kupries.
#
# This file contains a collection of tests for Giot
# All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# Copyright © 2000 Ajuba Solutions.
# Copyright © 2000 Andreas Kupries.
# All rights reserved.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  transform, and stacking in general
#
# This file contains a collection of tests for Giot

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/join.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  join
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  join
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

test join-1.1 {basic join commands} {
Changes to tests/lindex.test.
1
2
3
4
5
6
7
8
9
10
11
12
13













14
15
16
17
18
19
20






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
-
-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  lindex
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
# Copyright © 2001 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.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  lindex
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/link.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  none
#
# This file contains a collection of tests for Tcl_LinkVar and related library
# procedures. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright © 1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  none
#
# This file contains a collection of tests for Tcl_LinkVar and related library
# procedures. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/linsert.test.
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





















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
-
-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Commands covered:  linsert
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  linsert
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

proc newlist list {
    return $list
}

variable tests {

    foreach map {
	{
	    @mode@ compiled
	    @linsert@ linsert
	}
	{
	    @mode@ uncompiled
	    @linsert@ {[lindex linsert]}
	}
    } {
	set script [string map $map {
catch {unset lis}
catch {rename p ""}
	    catch {unset lis}
	    catch {rename p ""}

test linsert-1.1 {linsert command} {
    linsert {1 2 3 4 5} 0 a
} {a 1 2 3 4 5}
test linsert-1.2 {linsert command} {
    linsert {1 2 3 4 5} 1 a
} {1 a 2 3 4 5}
test linsert-1.3 {linsert command} {
    linsert {1 2 3 4 5} 2 a
} {1 2 a 3 4 5}
test linsert-1.4 {linsert command} {
    linsert {1 2 3 4 5} 3 a
} {1 2 3 a 4 5}
test linsert-1.5 {linsert command} {
    linsert {1 2 3 4 5} 4 a
} {1 2 3 4 a 5}
test linsert-1.6 {linsert command} {
    linsert {1 2 3 4 5} 5 a
} {1 2 3 4 5 a}
test linsert-1.7 {linsert command} {
    linsert {1 2 3 4 5} 2 one two \{three \$four
} {1 2 one two \{three {$four} 3 4 5}
test linsert-1.8 {linsert command} {
    linsert {\{one \$two \{three \ four \ five} 2 a b c
} {\{one {$two} a b c \{three { four} { five}}
test linsert-1.9 {linsert command} {
    linsert {{1 2} {3 4} {5 6} {7 8}} 2 {x y} {a b}
} {{1 2} {3 4} {x y} {a b} {5 6} {7 8}}
test linsert-1.10 {linsert command} {
    linsert {} 2 a b c
} {a b c}
test linsert-1.11 {linsert command} {
    linsert {} 2 {}
} {{}}
test linsert-1.12 {linsert command} {
    linsert {a b "c c" d e} 3 1
} {a b {c c} 1 d e}
	    test linsert-1.1-@mode@ {linsert command} {
		@linsert@ [newlist {1 2 3 4 5}] 0 a
	    } {a 1 2 3 4 5}
	    test linsert-1.2-@mode@ {linsert command} {
		@linsert@ [newlist {1 2 3 4 5}] 1 a
	    } {1 a 2 3 4 5}
	    test linsert-1.3-@mode@ {linsert command} {
		@linsert@ [newlist {1 2 3 4 5}] 2 a
	    } {1 2 a 3 4 5}
	    test linsert-1.4-@mode@ {linsert command} {
		@linsert@ [newlist {1 2 3 4 5}] 3 a
	    } {1 2 3 a 4 5}
	    test linsert-1.5-@mode@ {linsert command} {
		@linsert@ [newlist {1 2 3 4 5}] 4 a
	    } {1 2 3 4 a 5}
	    test linsert-1.6-@mode@ {linsert command} {
		@linsert@ [newlist {1 2 3 4 5}] 5 a
	    } {1 2 3 4 5 a}
	    test linsert-1.7-@mode@ {linsert command} {
		@linsert@ [newlist {1 2 3 4 5}] 2 one two \{three \$four
	    } {1 2 one two \{three {$four} 3 4 5}
	    test linsert-1.8-@mode@ {linsert command} {
		@linsert@ [newlist {\{one \$two \{three \ four \ five}] 2 a b c
	    } {\{one {$two} a b c \{three { four} { five}}
	    test linsert-1.9-@mode@ {linsert command} {
		@linsert@ [newlist {{1 2} {3 4} {5 6} {7 8}}] 2 {x y} {a b}
	    } {{1 2} {3 4} {x y} {a b} {5 6} {7 8}}
	    test linsert-1.10-@mode@ {linsert command} {
		@linsert@ [newlist {}] 2 a b c
	    } {a b c}
	    test linsert-1.11-@mode@ {linsert command} {
		@linsert@ [newlist {}] 2 {}
	    } {{}}
	    test linsert-1.12-@mode@ {linsert command} {
		@linsert@ [newlist {a b "c c" d e}] 3 1
	    } {a b {c c} 1 d e}
test linsert-1.13 {linsert command} {
    linsert { a b c d} 0 1 2
} {1 2 a b c d}
test linsert-1.14 {linsert command} {
    linsert {a b c {d e f}} 4 1 2
} {a b c {d e f} 1 2}
test linsert-1.15 {linsert command} {
    linsert {a b c \{\  abc} 4 q r
} {a b c \{\  q r abc}
test linsert-1.16 {linsert command} {
    linsert {a b c \{ abc} 4 q r
} {a b c \{ q r abc}
test linsert-1.17 {linsert command} {
    linsert {a b c} end q r
} {a b c q r}
test linsert-1.18 {linsert command} {
    linsert {a} end q r
} {a q r}
test linsert-1.19 {linsert command} {
    linsert {} end q r
} {q r}
test linsert-1.20 {linsert command, use of end-int index} {
    linsert {a b c d} end-2 e f
} {a b e f c d}
	    test linsert-1.13-@mode@ {linsert command} {
		@linsert@ [newlist { a b c d}] 0 1 2
	    } {1 2 a b c d}
	    test linsert-1.14-@mode@ {linsert command} {
		@linsert@ [newlist {a b c {d e f}}] 4 1 2
	    } {a b c {d e f} 1 2}
	    test linsert-1.15-@mode@ {linsert command} {
		@linsert@ [newlist {a b c \{\  abc}] 4 q r
	    } {a b c \{\  q r abc}
	    test linsert-1.16-@mode@ {linsert command} {
		@linsert@ [newlist {a b c \{ abc}] 4 q r
	    } {a b c \{ q r abc}
	    test linsert-1.17-@mode@ {linsert command} {
		@linsert@ [newlist {a b c}] end q r
	    } {a b c q r}
	    test linsert-1.18-@mode@ {linsert command} {
		@linsert@ [newlist {a}] end q r
	    } {a q r}
	    test linsert-1.19-@mode@ {linsert command} {
		@linsert@ [newlist {}] end q r
	    } {q r}
	    test linsert-1.20-@mode@ {linsert command, use of end-int index} {
		@linsert@ [newlist {a b c d}] end-2 e f
	    } {a b e f c d}

test linsert-2.1 {linsert errors} {
    list [catch linsert msg] $msg
} {1 {wrong # args: should be "linsert list index ?element ...?"}}
	    test linsert-2.1-@mode@ {linsert errors} {
		list [catch @linsert@ [newlist msg]] $msg
	    } {1 {wrong # args: should be "linsert list index ?element ...?"}}
test linsert-2.2 {linsert errors} {
    list [catch {linsert a b} msg] $msg
} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
test linsert-2.3 {linsert errors} {
    list [catch {linsert a 12x 2} msg] $msg
} {1 {bad index "12x": must be integer?[+-]integer? or end?[+-]integer?}}
test linsert-2.4 {linsert errors} {
    list [catch {linsert \{ 12 2} msg] $msg
} {1 {unmatched open brace in list}}
test linsert-2.5 {syntax (TIP 323)} {
    linsert {a b c} 0
} [list a b c]
test linsert-2.6 {syntax (TIP 323)} {
    linsert "a\nb\nc" 0
} [list a b c]
	    test linsert-2.2-@mode@ {linsert errors} {
		list [catch {@linsert@ [newlist a] b} msg] $msg
	    } {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
	    test linsert-2.3-@mode@ {linsert errors} {
		list [catch {@linsert@ [newlist a] 12x 2} msg] $msg
	    } {1 {bad index "12x": must be integer?[+-]integer? or end?[+-]integer?}}
	    test linsert-2.4-@mode@ {linsert errors} {
		list [catch {@linsert@ [newlist \{] 12 2} msg] $msg
	    } {1 {unmatched open brace in list}}
	    test linsert-2.5-@mode@ {syntax (TIP 323)} {
		@linsert@ [newlist {a b c}] 0
	    } [list a b c]
	    test linsert-2.6-@mode@ {syntax (TIP 323)} {
		@linsert@ [newlist "a\nb\nc"] 0
	    } [list a b c]

test linsert-3.1 {linsert won't modify shared argument objects} {
    proc p {} {
        linsert "a b c" 1 "x y"
        return "a b c"
    }
    p
} "a b c"
test linsert-3.2 {linsert won't modify shared argument objects} {
    catch {unset lis}
    set lis [format "a \"%s\" c" "b"]
    linsert $lis 0 [string length $lis]
} "7 a b c"
	    test linsert-3.1-@mode@ {linsert won't modify shared argument objects} {
		proc p {} {
		    set list "a b c"
		    @linsert@ [newlist $list] 1 "x y"
		    return "a b c"
		}
		p
	    } "a b c"
	    test linsert-3.2-@mode@ {linsert won't modify shared argument objects} {
		catch {unset lis}
		set lis [format "a \"%s\" c" "b"]
		@linsert@ [newlist $lis] 0 [string length $lis]
	    } "7 a b c"

# cleanup
catch {unset lis}
catch {rename p ""}
::tcltest::cleanupTests
return
	    # cleanup
	    catch {unset lis}
	    catch {rename p ""}
	}]
	try $script
    }
}


if {[info exists ::argv0] && [info script] eq $::argv0} {
    try $tests

    ::tcltest::cleanupTests
    return
}
Changes to tests/list.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  list
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  list
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# First, a bunch of individual tests
Changes to tests/listObj.test.













1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
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
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
-
-
-







# Copyright © 1995-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Functionality covered: operation of the procedures in tclListObj.c that
# implement the Tcl type manager for the list object type.
#
# 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 © 1995-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
219
220
221
222
223
224
225



226
227
228
229
230













231
232
233
234
235
236
237
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







+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+







    testlistobj replace 1 1 [expr {$SIZE_MAX -1}] f
    testlistobj get 1
} {a f}

test listobj-11.1 {Bug 3598580: Tcl_ListObjReplace refcount management} testobj {
    testobj bug3598580
} 123

#this test 
test listobj-11.2 {
test listobj-11.2 {Bug e58d7e19e9: Upwards compatibility of TclObjTypeHasProc()} testobj {
    set l [testobj buge58d7e19e9 "a x c"]
    # Since $l is a V1 objType, it's lengthProc will be accessed, but not its indexProc.
    list [llength $l] [lindex $l 2]
} {100 c}
    Bug e58d7e19e9: Upwards compatibility of TclObjTypeHasProc() In the
    unchained branch the lookup table is private, so the original version of
    this test is not applicable.  Instead, this test that TclStringCmp uses
    StringIsEmpty if it is available. 
} testobj {
    set res {}
    set l [testobj buge58d7e19e9 2]
    # Since $l is a V1 objType, it's lengthProc will be accessed, but not its StringIsEmpty proc.
    lappend res [llength $l] [expr {$l eq {}}]
    set m [testobj buge58d7e19e9 3]
    lappend res [llength $m] [after 1000][expr {$m eq {}}]
    return $res
} {100 0 100 1}

# Stolen from dict.test
proc listobjmemcheck script {
    set end [lindex [split [memory info] \n] 3 3]
    for {set i 0} {$i < 5} {incr i} {
        uplevel 1 $script
        set tmp $end
Changes to tests/listRep.test.
1
2
3
4
5
6
7










8
9
10
11
12
13
14



1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
-
-
-




+
+
+
+
+
+
+
+
+
+







# This file contains tests that specifically exercise the internal representation
# of a list.
#
# Copyright © 2022 Ashok P. Nadkarni
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains tests that specifically exercise the internal representation
# of a list.

# Unlike the other files related to list commands which for the most part do
# black box testing focusing on functionality, this file does more of white box
# testing to exercise code paths that implement different list representations
# (with spans, leading free space etc., shared/unshared etc.) In addition to
# functional correctness, the tests also check for the expected internal
# representation as that pertains to performance heuristics. Generally speaking,
Changes to tests/llength.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  llength
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  llength
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

test llength-1.1 {length of list} {
Changes to tests/lmap.test.
1
2
3
4
5
6
7
8
9
10
11
12
13








14
15






16
17
18
19
20
21
22






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
-
-
-
-
-
-






-
+
+
+
+
+
+
+
+


+
+
+
+
+
+







# Commands covered:  lmap, continue, break
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 2011 Trevor Davel
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# RCS: @(#) $Id: $

# Commands covered:  lmap, continue, break
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

unset -nocomplain a b i x

Changes to tests/load.test.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  load
#
# 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 © 1995 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  load
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/lpop.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  lpop
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  lpop
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

unset -nocomplain no; # following tests expecting var "no" does not exists
Changes to tests/lrange.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  lrange
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  lrange
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/lrepeat.test.












1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17





18
19
20
21
22
23
24
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-







# Copyright © 2003 Simon Geard.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  lrepeat
#
# 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 © 2003 Simon Geard.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

## Arg errors
Changes to tests/lreplace.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  lreplace
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  lreplace
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

test lreplace-1.1 {lreplace command} {
Changes to tests/lsearch.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  lsearch
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  lsearch
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

set x {abcd bbcd 123 234 345}
Changes to tests/lseq.test.












1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17





18
19
20
21
22
23
24
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-







# Copyright © 2003 Simon Geard.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  lseq
#
# 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 © 2003 Simon Geard.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

testConstraint arithSeriesDouble 1
380
381
382
383
384
385
386

387
388
389
390
391
392
393
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401







+







    unset r rep-before m rep-after rep-m
} -result {{0 1 2 3 4 5 6 7 8 9 10 11 12 13 14} arithseries arithseries list {0 7 14 21 28 35 42 49 56 63 70 77 84 91 98}}

test lseq-3.14 {array for shimmer} -constraints arithSeriesShimmerOk -body {
    array set testarray {a Test for This great Function}
    set vars [lseq 2]
    set vars-rep [lindex [tcl::unsupported::representation $vars] 3]
    after 1
    array for $vars testarray {
	lappend keys $0
	lappend vals $1
    }
    # Since hash order is not guaranteed, have to validate content ignoring order
    set valk [lmap k $keys {expr {$k in {a for great}}}]
    set valv [lmap v $vals {expr {$v in {Test This Function}}}]
Changes to tests/lset.test.




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
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
+
+
+
+
-
+
+
+
+
+
+
+






-
-
-
-
-









-
-
-
-


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




# Copyright © 2001 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.
# This file is a -*- tcl -*- test script

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered: lset
#
# 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 © 2001 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 {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]

proc failTrace {name1 name2 op} {
    error "trace failed"
}

testConstraint testevalex [llength [info commands testevalex]]

proc newlist list {
    return $list
}


variable tests {
    foreach map {
	{
	    @mode@ compiled
	    @lset@ lset
	}
	{
	    @mode@ uncompiled
	    @lset@ {[lindex lset]}
	}
    } {
	set script [string map $map {

	    proc failTrace {name1 name2 op} {
		error "trace failed"
	    }

set noRead {}
trace add variable noRead read failTrace
set noWrite {a b c}
trace add variable noWrite write failTrace
	    set noRead {}
	    trace add variable noRead read failTrace
	    set noWrite {a b c}
	    trace add variable noWrite write failTrace

test lset-1.1 {lset, not compiled, arg count} testevalex {
    list [catch {testevalex lset} msg] $msg
} "1 {wrong \# args: should be \"lset listVar ?index? ?index ...? value\"}"
test lset-1.2 {lset, not compiled, no such var} testevalex {
    list [catch {testevalex {lset noSuchVar 0 {}}} msg] $msg
} "1 {can't read \"noSuchVar\": no such variable}"
test lset-1.3 {lset, not compiled, var not readable} testevalex {
    list [catch {testevalex {lset noRead 0 {}}} msg] $msg
} "1 {can't read \"noRead\": trace failed}"
	    test lset-1.1-@mode@ {lset, not compiled, arg count} testevalex {
		list [catch {testevalex @lset@} msg] $msg
	    } "1 {wrong \# args: should be \"lset listVar ?index? ?index ...? value\"}"
	    test lset-1.2-@mode@ {lset, not compiled, no such var} testevalex {
		list [catch {testevalex {@lset@ noSuchVar 0 {}}} msg] $msg
	    } "1 {can't read \"noSuchVar\": no such variable}"
	    test lset-1.3-@mode@ {lset, not compiled, var not readable} testevalex {
		list [catch {testevalex {@lset@ noRead 0 {}}} msg] $msg
	    } "1 {can't read \"noRead\": trace failed}"

test lset-2.1 {lset, not compiled, 3 args, second arg a plain index} testevalex {
    set x {0 1 2}
    list [testevalex {lset x 0 3}] $x
} {{3 1 2} {3 1 2}}
test lset-2.2 {lset, not compiled, 3 args, second arg neither index nor list} testevalex {
    set x {0 1 2}
    list [catch {
	testevalex {lset x {{bad}1} 3}
    } msg] $msg
} {1 {bad index "{bad}1": must be integer?[+-]integer? or end?[+-]integer?}}
	    test lset-2.1-@mode@ {lset, not compiled, 3 args, second arg a plain index} testevalex {
		set x {0 1 2}
		list [testevalex {@lset@ x 0 3}] $x
	    } {{3 1 2} {3 1 2}}
	    test lset-2.2-@mode@ {lset, not compiled, 3 args, second arg neither index nor list} testevalex {
		set x {0 1 2}
		list [catch {
		    testevalex {@lset@ x {{bad}1} 3}
		} msg] $msg
	    } {1 {bad index "{bad}1": must be integer?[+-]integer? or end?[+-]integer?}}

test lset-3.1 {lset, not compiled, 3 args, data duplicated} testevalex {
    set x {0 1 2}
    list [testevalex {lset x 0 $x}] $x
} {{{0 1 2} 1 2} {{0 1 2} 1 2}}
test lset-3.2 {lset, not compiled, 3 args, data duplicated} testevalex {
    set x {0 1}
    set y $x
    list [testevalex {lset x 0 2}] $x $y
} {{2 1} {2 1} {0 1}}
test lset-3.3 {lset, not compiled, 3 args, data duplicated} testevalex {
    set x {0 1}
    set y $x
    list [testevalex {lset x 0 $x}] $x $y
} {{{0 1} 1} {{0 1} 1} {0 1}}
test lset-3.4 {lset, not compiled, 3 args, data duplicated} testevalex {
    set x {0 1 2}
    list [testevalex {lset x [list 0] $x}] $x
} {{{0 1 2} 1 2} {{0 1 2} 1 2}}
test lset-3.5 {lset, not compiled, 3 args, data duplicated} testevalex {
    set x {0 1}
    set y $x
    list [testevalex {lset x [list 0] 2}] $x $y
} {{2 1} {2 1} {0 1}}
test lset-3.6 {lset, not compiled, 3 args, data duplicated} testevalex {
    set x {0 1}
    set y $x
    list [testevalex {lset x [list 0] $x}] $x $y
} {{{0 1} 1} {{0 1} 1} {0 1}}
	    test lset-3.1-@mode@ {lset, not compiled, 3 args, data duplicated} testevalex {
		set x {0 1 2}
		list [testevalex {@lset@ x 0 $x}] $x
	    } {{{0 1 2} 1 2} {{0 1 2} 1 2}}
	    test lset-3.2-@mode@ {lset, not compiled, 3 args, data duplicated} testevalex {
		set x {0 1}
		set y $x
		list [testevalex {@lset@ x 0 2}] $x $y
	    } {{2 1} {2 1} {0 1}}
	    test lset-3.3-@mode@ {lset, not compiled, 3 args, data duplicated} testevalex {
		set x {0 1}
		set y $x
		list [testevalex {@lset@ x 0 $x}] $x $y
	    } {{{0 1} 1} {{0 1} 1} {0 1}}
	    test lset-3.4-@mode@ {lset, not compiled, 3 args, data duplicated} testevalex {
		set x {0 1 2}
		list [testevalex {@lset@ x [list 0] $x}] $x
	    } {{{0 1 2} 1 2} {{0 1 2} 1 2}}
	    test lset-3.5-@mode@ {lset, not compiled, 3 args, data duplicated} testevalex {
		set x {0 1}
		set y $x
		list [testevalex {@lset@ x [list 0] 2}] $x $y
	    } {{2 1} {2 1} {0 1}}
	    test lset-3.6-@mode@ {lset, not compiled, 3 args, data duplicated} testevalex {
		set x {0 1}
		set y $x
		list [testevalex {@lset@ x [list 0] $x}] $x $y
	    } {{{0 1} 1} {{0 1} 1} {0 1}}

test lset-4.1 {lset, not compiled, 3 args, not a list} testevalex {
    set a "x \{"
    list [catch {
	testevalex {lset a [list 0] y}
    } msg] $msg
} {1 {unmatched open brace in list}}
test lset-4.2 {lset, not compiled, 3 args, bad index} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a [list 2a2] w}
    } msg] $msg
} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
test lset-4.3 {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a [list -1] w}
    } msg] $msg
} {1 {index "-1" out of range}}
test lset-4.4 {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a [list 4] w}
    } msg] $msg
} {1 {index "4" out of range}}
test lset-4.5a {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a [list end--2] w}
    } msg] $msg
} {1 {index "end--2" out of range}}
test lset-4.5b {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a [list end+2] w}
    } msg] $msg
} {1 {index "end+2" out of range}}
test lset-4.6 {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a [list end-3] w}
    } msg] $msg
} {1 {index "end-3" out of range}}
test lset-4.7 {lset, not compiled, 3 args, not a list} testevalex {
    set a "x \{"
    list [catch {
	testevalex {lset a 0 y}
    } msg] $msg
} {1 {unmatched open brace in list}}
test lset-4.8 {lset, not compiled, 3 args, bad index} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a 2a2 w}
    } msg] $msg
} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
test lset-4.9 {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a -1 w}
    } msg] $msg
} {1 {index "-1" out of range}}
test lset-4.10 {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a 4 w}
    } msg] $msg
	    test lset-4.1-@mode@ {lset, not compiled, 3 args, not a list} testevalex {
		set a "x \{"
		list [catch {
		    testevalex {@lset@ a [list 0] y}
		} msg] $msg
	    } {1 {unmatched open brace in list}}
	    test lset-4.2-@mode@ {lset, not compiled, 3 args, bad index} testevalex {
		set a {x y z}
		list [catch {
		    testevalex {@lset@ a [list 2a2] w}
		} msg] $msg
	    } {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
	    test lset-4.3-@mode@ {lset, not compiled, 3 args, index out of range} testevalex {
		set a {x y z}
		list [catch {
		    testevalex {@lset@ a [list -1] w}
		} msg] $msg
	    } {1 {index "-1" out of range}}
	    test lset-4.4-@mode@ {lset, not compiled, 3 args, index out of range} testevalex {
		set a {x y z}
		list [catch {
		    testevalex {@lset@ a [list 4] w}
		} msg] $msg
	    } {1 {index "4" out of range}}
	    test lset-4.5a-@mode@ {lset, not compiled, 3 args, index out of range} testevalex {
		set a {x y z}
		list [catch {
		    testevalex {@lset@ a [list end--2] w}
		} msg] $msg
	    } {1 {index "end--2" out of range}}
	    test lset-4.5b-@mode@ {lset, not compiled, 3 args, index out of range} testevalex {
		set a {x y z}
		list [catch {
		    testevalex {@lset@ a [list end+2] w}
		} msg] $msg
	    } {1 {index "end+2" out of range}}
	    test lset-4.6-@mode@ {lset, not compiled, 3 args, index out of range} testevalex {
		set a {x y z}
		list [catch {
		    testevalex {@lset@ a [list end-3] w}
		} msg] $msg
	    } {1 {index "end-3" out of range}}
	    test lset-4.7-@mode@ {lset, not compiled, 3 args, not a list} testevalex {
		set a "x \{"
		list [catch {
		    testevalex {@lset@ a 0 y}
		} msg] $msg
	    } {1 {unmatched open brace in list}}
	    test lset-4.8-@mode@ {lset, not compiled, 3 args, bad index} testevalex {
		set a {x y z}
		list [catch {
		    testevalex {@lset@ a 2a2 w}
		} msg] $msg
	    } {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
	    test lset-4.9-@mode@ {lset, not compiled, 3 args, index out of range} testevalex {
		set a {x y z}
		list [catch {
		    testevalex {@lset@ a -1 w}
		} msg] $msg
	    } {1 {index "-1" out of range}}
	    test lset-4.10-@mode@ {lset, not compiled, 3 args, index out of range} testevalex {
		set a {x y z}
		list [catch {
		    testevalex {@lset@ a 4 w}
		} msg] $msg
	    } {1 {index "4" out of range}}
	    test lset-4.11a-@mode@ {lset, not compiled, 3 args, index out of range} testevalex {
		set a {x y z}
		list [catch {
		    testevalex {@lset@ a end--2 w}
		} msg] $msg
} {1 {index "4" out of range}}
test lset-4.11a {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a end--2 w}
    } msg] $msg
} {1 {index "end--2" out of range}}
test lset-4.11 {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a end+2 w}
    } msg] $msg
} {1 {index "end+2" out of range}}
test lset-4.12 {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a end-3 w}
    } msg] $msg
} {1 {index "end-3" out of range}}
	    } {1 {index "end--2" out of range}}
	    test lset-4.11-@mode@ {lset, not compiled, 3 args, index out of range} testevalex {
		set a {x y z}
		list [catch {
		    testevalex {@lset@ a end+2 w}
		} msg] $msg
	    } {1 {index "end+2" out of range}}
	    test lset-4.12-@mode@ {lset, not compiled, 3 args, index out of range} testevalex {
		set a {x y z}
		list [catch {
		    testevalex {@lset@ a end-3 w}
		} msg] $msg
	    } {1 {index "end-3" out of range}}

test lset-5.1 {lset, not compiled, 3 args, can't set variable} testevalex {
    list [catch {
	testevalex {lset noWrite 0 d}
    } msg] $msg $noWrite
} {1 {can't set "noWrite": trace failed} {d b c}}
test lset-5.2 {lset, not compiled, 3 args, can't set variable} testevalex {
    list [catch {
	testevalex {lset noWrite [list 0] d}
    } msg] $msg $noWrite
} {1 {can't set "noWrite": trace failed} {d b c}}
	    test lset-5.1-@mode@ {lset, not compiled, 3 args, can't set variable} testevalex {
		list [catch {
		    testevalex {@lset@ noWrite 0 d}
		} msg] $msg $noWrite
	    } {1 {can't set "noWrite": trace failed} {d b c}}
	    test lset-5.2-@mode@ {lset, not compiled, 3 args, can't set variable} testevalex {
		list [catch {
		    testevalex {@lset@ noWrite [list 0] d}
		} msg] $msg $noWrite
	    } {1 {can't set "noWrite": trace failed} {d b c}}

test lset-6.1 {lset, not compiled, 3 args, 1-d list basics} testevalex {
    set a {x y z}
    list [testevalex {lset a 0 a}] $a
} {{a y z} {a y z}}
test lset-6.2 {lset, not compiled, 3 args, 1-d list basics} testevalex {
    set a {x y z}
    list [testevalex {lset a [list 0] a}] $a
} {{a y z} {a y z}}
test lset-6.3 {lset, not compiled, 1-d list basics} testevalex {
    set a {x y z}
    list [testevalex {lset a 2 a}] $a
} {{x y a} {x y a}}
test lset-6.4 {lset, not compiled, 1-d list basics} testevalex {
    set a {x y z}
    list [testevalex {lset a [list 2] a}] $a
} {{x y a} {x y a}}
test lset-6.5 {lset, not compiled, 1-d list basics} testevalex {
    set a {x y z}
    list [testevalex {lset a end a}] $a
} {{x y a} {x y a}}
test lset-6.6 {lset, not compiled, 1-d list basics} testevalex {
    set a {x y z}
    list [testevalex {lset a [list end] a}] $a
} {{x y a} {x y a}}
test lset-6.7 {lset, not compiled, 1-d list basics} testevalex {
    set a {x y z}
    list [testevalex {lset a end-0 a}] $a
} {{x y a} {x y a}}
test lset-6.8 {lset, not compiled, 1-d list basics} testevalex {
    set a {x y z}
    list [testevalex {lset a [list end-0] a}] $a
} {{x y a} {x y a}}
test lset-6.9 {lset, not compiled, 1-d list basics} testevalex {
    set a {x y z}
    list [testevalex {lset a end-2 a}] $a
} {{a y z} {a y z}}
test lset-6.10 {lset, not compiled, 1-d list basics} testevalex {
    set a {x y z}
    list [testevalex {lset a [list end-2] a}] $a
} {{a y z} {a y z}}
	    test lset-6.1-@mode@ {lset, not compiled, 3 args, 1-d list basics} testevalex {
		set a {x y z}
		list [testevalex {@lset@ a 0 a}] $a
	    } {{a y z} {a y z}}
	    test lset-6.2-@mode@ {lset, not compiled, 3 args, 1-d list basics} testevalex {
		set a {x y z}
		list [testevalex {@lset@ a [list 0] a}] $a
	    } {{a y z} {a y z}}
	    test lset-6.3-@mode@ {lset, not compiled, 1-d list basics} testevalex {
		set a {x y z}
		list [testevalex {@lset@ a 2 a}] $a
	    } {{x y a} {x y a}}
	    test lset-6.4-@mode@ {lset, not compiled, 1-d list basics} testevalex {
		set a {x y z}
		list [testevalex {@lset@ a [list 2] a}] $a
	    } {{x y a} {x y a}}
	    test lset-6.5-@mode@ {lset, not compiled, 1-d list basics} testevalex {
		set a {x y z}
		list [testevalex {@lset@ a end a}] $a
	    } {{x y a} {x y a}}
	    test lset-6.6-@mode@ {lset, not compiled, 1-d list basics} testevalex {
		set a {x y z}
		list [testevalex {@lset@ a [list end] a}] $a
	    } {{x y a} {x y a}}
	    test lset-6.7-@mode@ {lset, not compiled, 1-d list basics} testevalex {
		set a {x y z}
		list [testevalex {@lset@ a end-0 a}] $a
	    } {{x y a} {x y a}}
	    test lset-6.8-@mode@ {lset, not compiled, 1-d list basics} testevalex {
		set a {x y z}
		list [testevalex {@lset@ a [list end-0] a}] $a
	    } {{x y a} {x y a}}
	    test lset-6.9-@mode@ {lset, not compiled, 1-d list basics} testevalex {
		set a {x y z}
		list [testevalex {@lset@ a end-2 a}] $a
	    } {{a y z} {a y z}}
	    test lset-6.10-@mode@ {lset, not compiled, 1-d list basics} testevalex {
		set a {x y z}
		list [testevalex {@lset@ a [list end-2] a}] $a
	    } {{a y z} {a y z}}

test lset-7.1 {lset, not compiled, data sharing} testevalex {
    set a 0
    list [testevalex {lset a $a {gag me}}] $a
} {{{gag me}} {{gag me}}}
test lset-7.2 {lset, not compiled, data sharing} testevalex {
    set a [list 0]
    list [testevalex {lset a $a {gag me}}] $a
} {{{gag me}} {{gag me}}}
test lset-7.3 {lset, not compiled, data sharing} testevalex {
    set a {x y}
    list [testevalex {lset a 0 $a}] $a
} {{{x y} y} {{x y} y}}
test lset-7.4 {lset, not compiled, data sharing} testevalex {
    set a {x y}
    list [testevalex {lset a [list 0] $a}] $a
} {{{x y} y} {{x y} y}}
test lset-7.5 {lset, not compiled, data sharing} testevalex {
    set n 0
    set a {x y}
    list [testevalex {lset a $n $n}] $a $n
} {{0 y} {0 y} 0}
test lset-7.6 {lset, not compiled, data sharing} testevalex {
    set n [list 0]
    set a {x y}
    list [testevalex {lset a $n $n}] $a $n
} {{0 y} {0 y} 0}
test lset-7.7 {lset, not compiled, data sharing} testevalex {
    set n 0
    set a [list $n $n]
    list [testevalex {lset a $n 1}] $a $n
} {{1 0} {1 0} 0}
test lset-7.8 {lset, not compiled, data sharing} testevalex {
    set n [list 0]
    set a [list $n $n]
    list [testevalex {lset a $n 1}] $a $n
} {{1 0} {1 0} 0}
test lset-7.9 {lset, not compiled, data sharing} testevalex {
    set a 0
    list [testevalex {lset a $a $a}] $a
} {0 0}
test lset-7.10 {lset, not compiled, data sharing} testevalex {
    set a [list 0]
    list [testevalex {lset a $a $a}] $a
} {0 0}
	    test lset-7.1-@mode@ {lset, not compiled, data sharing} testevalex {
		set a 0
		list [testevalex {@lset@ a $a {gag me}}] $a
	    } {{{gag me}} {{gag me}}}
	    test lset-7.2-@mode@ {lset, not compiled, data sharing} testevalex {
		set a [list 0]
		list [testevalex {@lset@ a $a {gag me}}] $a
	    } {{{gag me}} {{gag me}}}
	    test lset-7.3-@mode@ {lset, not compiled, data sharing} testevalex {
		set a {x y}
		list [testevalex {@lset@ a 0 $a}] $a
	    } {{{x y} y} {{x y} y}}
	    test lset-7.4-@mode@ {lset, not compiled, data sharing} testevalex {
		set a {x y}
		list [testevalex {@lset@ a [list 0] $a}] $a
	    } {{{x y} y} {{x y} y}}
	    test lset-7.5-@mode@ {lset, not compiled, data sharing} testevalex {
		set n 0
		set a {x y}
		list [testevalex {@lset@ a $n $n}] $a $n
	    } {{0 y} {0 y} 0}
	    test lset-7.6-@mode@ {lset, not compiled, data sharing} testevalex {
		set n [list 0]
		set a {x y}
		list [testevalex {@lset@ a $n $n}] $a $n
	    } {{0 y} {0 y} 0}
	    test lset-7.7-@mode@ {lset, not compiled, data sharing} testevalex {
		set n 0
		set a [list $n $n]
		list [testevalex {@lset@ a $n 1}] $a $n
	    } {{1 0} {1 0} 0}
	    test lset-7.8-@mode@ {lset, not compiled, data sharing} testevalex {
		set n [list 0]
		set a [list $n $n]
		list [testevalex {@lset@ a $n 1}] $a $n
	    } {{1 0} {1 0} 0}
	    test lset-7.9-@mode@ {lset, not compiled, data sharing} testevalex {
		set a 0
		list [testevalex {@lset@ a $a $a}] $a
	    } {0 0}
	    test lset-7.10-@mode@ {lset, not compiled, data sharing} testevalex {
		set a [list 0]
		list [testevalex {@lset@ a $a $a}] $a
	    } {0 0}

test lset-8.1 {lset, not compiled, malformed sublist} testevalex {
    set a [list "a \{" b]
    list [catch {testevalex {lset a 0 1 c}} msg] $msg
} {1 {unmatched open brace in list}}
test lset-8.2 {lset, not compiled, malformed sublist} testevalex {
    set a [list "a \{" b]
    list [catch {testevalex {lset a {0 1} c}} msg] $msg
} {1 {unmatched open brace in list}}
test lset-8.3 {lset, not compiled, bad second index} testevalex {
    set a {{b c} {d e}}
    list [catch {testevalex {lset a 0 2a2 f}} msg] $msg
} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
test lset-8.4 {lset, not compiled, bad second index} testevalex {
    set a {{b c} {d e}}
    list [catch {testevalex {lset a {0 2a2} f}} msg] $msg
} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
test lset-8.5 {lset, not compiled, second index out of range} testevalex {
    set a {{b c} {d e} {f g}}
    list [catch {testevalex {lset a 2 -1 h}} msg] $msg
} {1 {index "-1" out of range}}
test lset-8.6 {lset, not compiled, second index out of range} testevalex {
    set a {{b c} {d e} {f g}}
    list [catch {testevalex {lset a {2 -1} h}} msg] $msg
} {1 {index "-1" out of range}}
test lset-8.7 {lset, not compiled, second index out of range} testevalex {
    set a {{b c} {d e} {f g}}
    list [catch {testevalex {lset a 2 3 h}} msg] $msg
} {1 {index "3" out of range}}
test lset-8.8 {lset, not compiled, second index out of range} testevalex {
    set a {{b c} {d e} {f g}}
    list [catch {testevalex {lset a {2 3} h}} msg] $msg
} {1 {index "3" out of range}}
test lset-8.9a {lset, not compiled, second index out of range} testevalex {
    set a {{b c} {d e} {f g}}
    list [catch {testevalex {lset a 2 end--2 h}} msg] $msg
} {1 {index "end--2" out of range}}
test lset-8.9b {lset, not compiled, second index out of range} testevalex {
    set a {{b c} {d e} {f g}}
    list [catch {testevalex {lset a 2 end+2 h}} msg] $msg
} {1 {index "end+2" out of range}}
test lset-8.10a {lset, not compiled, second index out of range} testevalex {
    set a {{b c} {d e} {f g}}
    list [catch {testevalex {lset a {2 end--2} h}} msg] $msg
} {1 {index "end--2" out of range}}
test lset-8.10b {lset, not compiled, second index out of range} testevalex {
    set a {{b c} {d e} {f g}}
    list [catch {testevalex {lset a {2 end+2} h}} msg] $msg
} {1 {index "end+2" out of range}}
test lset-8.11 {lset, not compiled, second index out of range} testevalex {
    set a {{b c} {d e} {f g}}
    list [catch {testevalex {lset a 2 end-2 h}} msg] $msg
} {1 {index "end-2" out of range}}
test lset-8.12 {lset, not compiled, second index out of range} testevalex {
    set a {{b c} {d e} {f g}}
    list [catch {testevalex {lset a {2 end-2} h}} msg] $msg
} {1 {index "end-2" out of range}}
	    test lset-8.1-@mode@ {lset, not compiled, malformed sublist} testevalex {
		set a [list "a \{" b]
		list [catch {testevalex {@lset@ a 0 1 c}} msg] $msg
	    } {1 {unmatched open brace in list}}
	    test lset-8.2-@mode@ {lset, not compiled, malformed sublist} testevalex {
		set a [list "a \{" b]
		list [catch {testevalex {@lset@ a {0 1} c}} msg] $msg
	    } {1 {unmatched open brace in list}}
	    test lset-8.3-@mode@ {lset, not compiled, bad second index} testevalex {
		set a {{b c} {d e}}
		list [catch {testevalex {@lset@ a 0 2a2 f}} msg] $msg
	    } {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
	    test lset-8.4-@mode@ {lset, not compiled, bad second index} testevalex {
		set a {{b c} {d e}}
		list [catch {testevalex {@lset@ a {0 2a2} f}} msg] $msg
	    } {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
	    test lset-8.5-@mode@ {lset, not compiled, second index out of range} testevalex {
		set a {{b c} {d e} {f g}}
		list [catch {testevalex {@lset@ a 2 -1 h}} msg] $msg
	    } {1 {index "-1" out of range}}
	    test lset-8.6-@mode@ {lset, not compiled, second index out of range} testevalex {
		set a {{b c} {d e} {f g}}
		list [catch {testevalex {@lset@ a {2 -1} h}} msg] $msg
	    } {1 {index "-1" out of range}}
	    test lset-8.7-@mode@ {lset, not compiled, second index out of range} testevalex {
		set a {{b c} {d e} {f g}}
		list [catch {testevalex {@lset@ a 2 3 h}} msg] $msg
	    } {1 {index "3" out of range}}
	    test lset-8.8-@mode@ {lset, not compiled, second index out of range} testevalex {
		set a {{b c} {d e} {f g}}
		list [catch {testevalex {@lset@ a {2 3} h}} msg] $msg
	    } {1 {index "3" out of range}}
	    test lset-8.9a-@mode@ {lset, not compiled, second index out of range} testevalex {
		set a {{b c} {d e} {f g}}
		list [catch {testevalex {@lset@ a 2 end--2 h}} msg] $msg
	    } {1 {index "end--2" out of range}}
	    test lset-8.9b-@mode@ {lset, not compiled, second index out of range} testevalex {
		set a {{b c} {d e} {f g}}
		list [catch {testevalex {@lset@ a 2 end+2 h}} msg] $msg
	    } {1 {index "end+2" out of range}}
	    test lset-8.10a-@mode@ {lset, not compiled, second index out of range} testevalex {
		set a {{b c} {d e} {f g}}
		list [catch {testevalex {@lset@ a {2 end--2} h}} msg] $msg
	    } {1 {index "end--2" out of range}}
	    test lset-8.10b-@mode@ {lset, not compiled, second index out of range} testevalex {
		set a {{b c} {d e} {f g}}
		list [catch {testevalex {@lset@ a {2 end+2} h}} msg] $msg
	    } {1 {index "end+2" out of range}}
	    test lset-8.11-@mode@ {lset, not compiled, second index out of range} testevalex {
		set a {{b c} {d e} {f g}}
		list [catch {testevalex {@lset@ a 2 end-2 h}} msg] $msg
	    } {1 {index "end-2" out of range}}
	    test lset-8.12-@mode@ {lset, not compiled, second index out of range} testevalex {
		set a {{b c} {d e} {f g}}
		list [catch {testevalex {@lset@ a {2 end-2} h}} msg] $msg
	    } {1 {index "end-2" out of range}}

test lset-9.1 {lset, not compiled, entire variable} testevalex {
    set a x
    list [testevalex {lset a y}] $a
} {y y}
test lset-9.2 {lset, not compiled, entire variable} testevalex {
    set a x
    list [testevalex {lset a {} y}] $a
} {y y}
	    test lset-9.1-@mode@ {lset, not compiled, entire variable} testevalex {
		set a x
		list [testevalex {@lset@ a y}] $a
	    } {y y}
	    test lset-9.2-@mode@ {lset, not compiled, entire variable} testevalex {
		set a x
		list [testevalex {@lset@ a {} y}] $a
	    } {y y}

test lset-10.1 {lset, not compiled, shared data} testevalex {
    set row {p q}
    set a [list $row $row]
    list [testevalex {lset a 0 0 x}] $a
} {{{x q} {p q}} {{x q} {p q}}}
test lset-10.2 {lset, not compiled, shared data} testevalex {
    set row {p q}
    set a [list $row $row]
    list [testevalex {lset a {0 0} x}] $a
} {{{x q} {p q}} {{x q} {p q}}}
test lset-10.3 {lset, not compiled, shared data, [Bug 1333036]} testevalex {
    set a [list [list p q] [list r s]]
    set b $a
	    test lset-10.1-@mode@ {lset, not compiled, shared data} testevalex {
		set row {p q}
		set a [list $row $row]
		list [testevalex {@lset@ a 0 0 x}] $a
	    } {{{x q} {p q}} {{x q} {p q}}}
	    test lset-10.2-@mode@ {lset, not compiled, shared data} testevalex {
		set row {p q}
		set a [list $row $row]
		list [testevalex {@lset@ a {0 0} x}] $a
	    } {{{x q} {p q}} {{x q} {p q}}}
	    test lset-10.3-@mode@ {lset, not compiled, shared data, [Bug 1333036]} testevalex {
		set a [list [list p q] [list r s]]
		set b $a
    list [testevalex {lset b {0 0} x}] $a
} {{{x q} {r s}} {{p q} {r s}}}

test lset-11.1 {lset, not compiled, 2-d basics} testevalex {
    set a {{b c} {d e}}
    list [testevalex {lset a 0 0 f}] $a
} {{{f c} {d e}} {{f c} {d e}}}
test lset-11.2 {lset, not compiled, 2-d basics} testevalex {
    set a {{b c} {d e}}
    list [testevalex {lset a {0 0} f}] $a
} {{{f c} {d e}} {{f c} {d e}}}
test lset-11.3 {lset, not compiled, 2-d basics} testevalex {
    set a {{b c} {d e}}
    list [testevalex {lset a 0 1 f}] $a
} {{{b f} {d e}} {{b f} {d e}}}
test lset-11.4 {lset, not compiled, 2-d basics} testevalex {
    set a {{b c} {d e}}
    list [testevalex {lset a {0 1} f}] $a
} {{{b f} {d e}} {{b f} {d e}}}
test lset-11.5 {lset, not compiled, 2-d basics} testevalex {
    set a {{b c} {d e}}
    list [testevalex {lset a 1 0 f}] $a
} {{{b c} {f e}} {{b c} {f e}}}
test lset-11.6 {lset, not compiled, 2-d basics} testevalex {
    set a {{b c} {d e}}
    list [testevalex {lset a {1 0} f}] $a
} {{{b c} {f e}} {{b c} {f e}}}
test lset-11.7 {lset, not compiled, 2-d basics} testevalex {
    set a {{b c} {d e}}
    list [testevalex {lset a 1 1 f}] $a
} {{{b c} {d f}} {{b c} {d f}}}
test lset-11.8 {lset, not compiled, 2-d basics} testevalex {
    set a {{b c} {d e}}
    list [testevalex {lset a {1 1} f}] $a
} {{{b c} {d f}} {{b c} {d f}}}
		list [testevalex {@lset@ b {0 0} x}] $a
	    } {{{x q} {r s}} {{p q} {r s}}}

	    test lset-11.1-@mode@ {lset, not compiled, 2-d basics} testevalex {
		set a {{b c} {d e}}
		list [testevalex {@lset@ a 0 0 f}] $a
	    } {{{f c} {d e}} {{f c} {d e}}}
	    test lset-11.2-@mode@ {lset, not compiled, 2-d basics} testevalex {
		set a {{b c} {d e}}
		list [testevalex {@lset@ a {0 0} f}] $a
	    } {{{f c} {d e}} {{f c} {d e}}}
	    test lset-11.3-@mode@ {lset, not compiled, 2-d basics} testevalex {
		set a {{b c} {d e}}
		list [testevalex {@lset@ a 0 1 f}] $a
	    } {{{b f} {d e}} {{b f} {d e}}}
	    test lset-11.4-@mode@ {lset, not compiled, 2-d basics} testevalex {
		set a {{b c} {d e}}
		list [testevalex {@lset@ a {0 1} f}] $a
	    } {{{b f} {d e}} {{b f} {d e}}}
	    test lset-11.5-@mode@ {lset, not compiled, 2-d basics} testevalex {
		set a {{b c} {d e}}
		list [testevalex {@lset@ a 1 0 f}] $a
	    } {{{b c} {f e}} {{b c} {f e}}}
	    test lset-11.6-@mode@ {lset, not compiled, 2-d basics} testevalex {
		set a {{b c} {d e}}
		list [testevalex {@lset@ a {1 0} f}] $a
	    } {{{b c} {f e}} {{b c} {f e}}}
	    test lset-11.7-@mode@ {lset, not compiled, 2-d basics} testevalex {
		set a {{b c} {d e}}
		list [testevalex {@lset@ a 1 1 f}] $a
	    } {{{b c} {d f}} {{b c} {d f}}}
	    test lset-11.8-@mode@ {lset, not compiled, 2-d basics} testevalex {
		set a {{b c} {d e}}
		list [testevalex {@lset@ a {1 1} f}] $a
	    } {{{b c} {d f}} {{b c} {d f}}}

test lset-12.0 {lset, not compiled, typical sharing pattern} testevalex {
    set zero 0
    set row [list $zero $zero $zero $zero]
    set ident [list $row $row $row $row]
    for { set i 0 } { $i < 4 } { incr i } {
	testevalex {lset ident $i $i 1}
    }
    set ident
} {{1 0 0 0} {0 1 0 0} {0 0 1 0} {0 0 0 1}}
	    test lset-12.0-@mode@ {lset, not compiled, typical sharing pattern} testevalex {
		set zero 0
		set row [list $zero $zero $zero $zero]
		set ident [list $row $row $row $row]
		for { set i 0 } { $i < 4 } { incr i } {
		    testevalex {@lset@ ident $i $i 1}
		}
		set ident
	    } {{1 0 0 0} {0 1 0 0} {0 0 1 0} {0 0 0 1}}

test lset-13.0 {lset, not compiled, shimmering hell} testevalex {
    set a 0
    list [testevalex {lset a $a $a $a $a {gag me}}] $a
} {{{{{{gag me}}}}} {{{{{gag me}}}}}}
test lset-13.1 {lset, not compiled, shimmering hell} testevalex {
    set a [list 0]
    list [testevalex {lset a $a $a $a $a {gag me}}] $a
} {{{{{{gag me}}}}} {{{{{gag me}}}}}}
test lset-13.2 {lset, not compiled, shimmering hell} testevalex {
    set a [list 0 0 0 0]
    list [testevalex {lset a $a {gag me}}] $a
} {{{{{{gag me}}}} 0 0 0} {{{{{gag me}}}} 0 0 0}}
	    test lset-13.0-@mode@ {lset, not compiled, shimmering hell} testevalex {
		set a 0
		list [testevalex {@lset@ a $a $a $a $a {gag me}}] $a
	    } {{{{{{gag me}}}}} {{{{{gag me}}}}}}
	    test lset-13.1-@mode@ {lset, not compiled, shimmering hell} testevalex {
		set a [list 0]
		list [testevalex {@lset@ a $a $a $a $a {gag me}}] $a
	    } {{{{{{gag me}}}}} {{{{{gag me}}}}}}
	    test lset-13.2-@mode@ {lset, not compiled, shimmering hell} testevalex {
		set a [list 0 0 0 0]
		list [testevalex {@lset@ a $a {gag me}}] $a
	    } {{{{{{gag me}}}} 0 0 0} {{{{{gag me}}}} 0 0 0}}

test lset-14.1 {lset, not compiled, list args, is string rep preserved?} testevalex {
    set a { { 1 2 } { 3 4 } }
    catch { testevalex {lset a {1 5} 5} }
    list $a [lindex $a 1]
} "{ { 1 2 } { 3 4 } } { 3 4 }"
test lset-14.2 {lset, not compiled, flat args, is string rep preserved?} testevalex {
    set a { { 1 2 } { 3 4 } }
    catch { testevalex {lset a 1 5 5} }
    list $a [lindex $a 1]
} "{ { 1 2 } { 3 4 } } { 3 4 }"
	    test lset-14.1-@mode@ {lset, not compiled, list args, is string rep preserved?} testevalex {
		set a { { 1 2 } { 3 4 } }
		catch { testevalex {@lset@ a {1 5} 5} }
		list $a [lindex $a 1]
	    } "{ { 1 2 } { 3 4 } } { 3 4 }"
	    test lset-14.2-@mode@ {lset, not compiled, flat args, is string rep preserved?} testevalex {
		set a { { 1 2 } { 3 4 } }
		catch { testevalex {@lset@ a 1 5 5} }
		list $a [lindex $a 1]
	    } "{ { 1 2 } { 3 4 } } { 3 4 }"

testConstraint testobj [llength [info commands testobj]]
test lset-15.1 {lset: shared internalrep [Bug 1677512]} -setup {
    teststringobj set 1 {{1 2} 3}
    testobj convert 1 list
    testobj duplicate 1 2
    variable x [teststringobj get 1]
    variable y [teststringobj get 2]
    testobj freeallvars
    set l [list $y z]
    unset y
} -constraints testobj -body {
    lset l 0 0 0 5
    lindex $x 0 0
} -cleanup {
    unset -nocomplain x l
} -result 1
	    testConstraint testobj [llength [info commands testobj]]
	    test lset-15.1-@mode@ {lset: shared internalrep [Bug 1677512]} -setup {
		teststringobj set 1 {{1 2} 3}
		testobj convert 1 list
		testobj duplicate 1 2
		variable x [teststringobj get 1]
		variable y [teststringobj get 2]
		testobj freeallvars
		set l [list $y z]
		unset y
	    } -constraints testobj -body {
		@lset@ l 0 0 0 5
		lindex $x 0 0
	    } -cleanup {
		unset -nocomplain x l
	    } -result 1

test lset-16.1 {lset - grow a variable} testevalex {
    set x {}
    testevalex {lset x 0 {test 1}}
    testevalex {lset x 1 {test 2}}
    set x
} {{test 1} {test 2}}
test lset-16.2 {lset - multiple created sublists} testevalex {
    set x {}
    testevalex {lset x 0 0 {test 1}}
} {{{test 1}}}
test lset-16.3 {lset - sublists 3 deep} testevalex {
    set x {}
    testevalex {lset x 0 0 0 {test 1}}
} {{{{test 1}}}}
test lset-16.4 {lset - append to inner list} testevalex {
    set x {test 1}
    testevalex {lset x 1 1 2}
    testevalex {lset x 1 2 3}
    testevalex {lset x 1 2 1 4}
} {test {1 2 {3 4}}}
	    test lset-16.1-@mode@ {lset - grow a variable} testevalex {
		set x {}
		testevalex {@lset@ x 0 {test 1}}
		testevalex {lset x 1 {test 2}}
		set x
	    } {{test 1} {test 2}}
	    test lset-16.2-@mode@ {@lset@ - multiple created sublists} testevalex {
		set x {}
		testevalex {lset x 0 0 {test 1}}
	    } {{{test 1}}}
	    test lset-16.3-@mode@ {@lset@ - sublists 3 deep} testevalex {
		set x {}
		testevalex {lset x 0 0 0 {test 1}}
	    } {{{{test 1}}}}
	    test lset-16.4-@mode@ {@lset@ - append to inner list} testevalex {
		set x {test 1}
		testevalex {@lset@ x 1 1 2}
		testevalex {@lset@ x 1 2 3}
		testevalex {@lset@ x 1 2 1 4}
	    } {test {1 2 {3 4}}}

test lset-16.5 {lset - grow a variable} testevalex {
    set x {}
    testevalex {lset x end+1 {test 1}}
    testevalex {lset x end+1 {test 2}}
    set x
} {{test 1} {test 2}}
test lset-16.6 {lset - multiple created sublists} testevalex {
    set x {}
    testevalex {lset x end+1 end+1 {test 1}}
} {{{test 1}}}
test lset-16.7 {lset - sublists 3 deep} testevalex {
    set x {}
    testevalex {lset x end+1 end+1 end+1 {test 1}}
} {{{{test 1}}}}
test lset-16.8 {lset - append to inner list} testevalex {
    set x {test 1}
    testevalex {lset x end end+1 2}
    testevalex {lset x end end+1 3}
    testevalex {lset x end end end+1 4}
} {test {1 2 {3 4}}}
	    test lset-16.5-@mode@ {lset - grow a variable} testevalex {
		set x {}
		testevalex {@lset@ x end+1 {test 1}}
		testevalex {@lset@ x end+1 {test 2}}
		set x
	    } {{test 1} {test 2}}
	    test lset-16.6-@mode@ {lset - multiple created sublists} testevalex {
		set x {}
		testevalex {@lset@ x end+1 end+1 {test 1}}
	    } {{{test 1}}}
	    test lset-16.7-@mode@ {lset - sublists 3 deep} testevalex {
		set x {}
		testevalex {@lset@ x end+1 end+1 end+1 {test 1}}
	    } {{{{test 1}}}}
	    test lset-16.8-@mode@ {lset - append to inner list} testevalex {
		set x {test 1}
		testevalex {@lset@ x end end+1 2}
		testevalex {@lset@ x end end+1 3}
		testevalex {@lset@ x end end end+1 4}
	    } {test {1 2 {3 4}}}

catch {unset noRead}
catch {unset noWrite}
catch {rename failTrace {}}
catch {unset ::x}
catch {unset ::y}
	    catch {unset noRead}
	    catch {unset noWrite}
	    catch {rename failTrace {}}
	    catch {unset ::x}
	    catch {unset ::y}
	}]
	try $script
    }
}

try $tests
if {[info exists ::argv0] && [info script] eq $::argv0} {
    try $tests

    ::tcltest::cleanupTests
    return
}


# cleanup
::tcltest::cleanupTests
return
Changes to tests/lsetComp.test.




1







2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
1
2
3
4

5
6
7
8
9
10
11
12
13
14
15
16
17





18
19
20
21
22
23
24
+
+
+
+
-
+
+
+
+
+
+
+






-
-
-
-
-







# Copyright © 2001 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.
# This file is a -*- tcl -*- test script

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered: lset
#
# 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 © 2001 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 {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# Procedure to evaluate a script within a proc, to test compilation
Changes to tests/macOSXFCmd.test.












1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17





18
19
20
21
22
23
24
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-







# Copyright © 2003 Tcl Core Team.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file tests the tclMacOSXFCmd.c file.
#
# 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 © 2003 Tcl Core Team.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# These tests really need to be run from a writable directory, which
Changes to tests/macOSXLoad.test.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  load unload
#
# 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 © 1995 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  load unload
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
set oldTSF $::tcltest::testSingleFile
set ::tcltest::testSingleFile false
Changes to tests/main.test.







1
2
3
4
5
6
7
1
2
3
4
5
6
7
8
9
10
11
12
13
14
+
+
+
+
+
+
+







# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains a collection of tests for generic/tclMain.c.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

Changes to tests/mathop.test.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered: ::tcl::mathop::...
#
# 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 © 2006 Donal K. Fellows
# Copyright © 2006 Peter Spjuth
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered: ::tcl::mathop::...
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# A namespace to test that operators are exported and that they
Changes to tests/misc.test.
1
2
3
4
5
6
7
8
9
10
11
12
13














14
15
16
17
18
19
20







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
-
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  various
#
# This file contains a collection of miscellaneous Tcl tests that
# don't fit naturally in any of the other test files.  Many of these
# tests are pathological cases that caused bugs in earlier Tcl
# releases.
#
# Copyright © 1992-1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  various
#
# This file contains a collection of miscellaneous Tcl tests that
# don't fit naturally in any of the other test files.  Many of these
# tests are pathological cases that caused bugs in earlier Tcl
# releases.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/msgcat.test.
1
2
3
4
5
6
7
8
9
10
11












12
13
14
15
16
17
18




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
-
-
-
-






-
+
+
+
+
+
+
+
+
+
+
+
+







# This file contains a collection of tests for the msgcat package.
# Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright © 1998 Mark Harrison.
# Copyright © 1998-1999 Scriptics Corporation.
# Contributions from Don Porter, NIST, 2002.  (not subject to US copyright)
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains a collection of tests for the msgcat package.
# Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.

# Note that after running these tests, entries will be left behind in the
# message catalogs for locales foo, foo_BAR, and foo_BAR_baz.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
Changes to tests/namespace-old.test.














1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+








-
-
-
-
-
-
-







# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1997 Lucent Technologies
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Functionality covered: this file contains slightly modified versions of
# the original tests written by Mike McLennan of Lucent Technologies for
# the procedures in tclNamesp.c that implement Tcl's basic support for
# namespaces. Other namespace-related tests appear in namespace.test
# and variable.test.
#
# Sourcing this file into Tcl runs the tests and generates output for
# errors. No output means no errors were found.
#
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1997 Lucent Technologies
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# Clear out any namespaces called test_ns_*
Changes to tests/namespace.test.













1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-
-







# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-2000 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Functionality covered: this file contains a collection of tests for the
# procedures in tclNamesp.c and tclEnsemble.c that implement Tcl's basic
# support for namespaces.  Other namespace-related tests appear in
# variable.test.
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-2000 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
testConstraint memory [llength [info commands memory]]

Changes to tests/notify.test.




1




2



3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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
+
+
+
+
-
+
+
+
+

+
+
+







-
-
-
-
-







# Copyright © 2003 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.
#  -*- tcl -*-

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# notify.test --
#
# This file tests several functions in the file, 'generic/tclNotify.c'.
#
# 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 © 2003 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 {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/nre.test.












1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17





18
19
20
21
22
23
24
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-







# Copyright © 2008 Miguel Sofer.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  proc, apply, [interp alias], [namespace import]
#
# This file contains a collection of tests for the non-recursive executor that
# avoids recursive calls to TEBC. Only the NRE behaviour is tested here, the
# actual command functionality is tested in the specific test file.
#
# Copyright © 2008 Miguel Sofer.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/obj.test.













1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
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
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
-
-
-







# Copyright © 1995-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Functionality covered: this file contains a collection of tests for the
# procedures in tclObj.c that implement Tcl's basic type support and the
# type managers for the types boolean, double, and integer.
#
# Sourcing this file into Tcl runs the tests and generates output for
# errors. No output means no errors were found.
#
# Copyright © 1995-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Added tests/objInterface.test.













































































































































































































































































































































































































































































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Copyright © 2021 Nathan Coulter
#
# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.


if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
testConstraint testindexhex [expr {[namespace which testindexhex] ne {}}]
testConstraint testlistinteger [expr {[namespace which testlistinteger] ne {}}]

apply [list {} {
    variable list
    variable res

    foreach map {
	{
	    @mode@ compiled
	    @lappend@ lappend
	    @lindex@ lindex
	    @linsert@ linsert
	    @llength@ length
	    @lrange@ lrange
	    @lreplace@ lreplace
	}
	{
	    @mode@ uncompiled
	    @lappend@ {[lindex lappend]}
	    @lindex@ {[lindex lindex]}
	    @linsert@ {[lindex linsert]}
	    @llength@ {[lindex llength]}
	    @lrange@ {[lindex lrange]}
	    @lreplace@ {[lindex lreplace]}
	}
    } {
		set script [string map $map {
			proc data1 iterations {
				for {set i 0} {$i < $iterations} {incr i} {
					@lappend@ expected [format %x $i]
				}
				return $expected
			}


			test {indexhex llength @mode@} {INST_LIST_INDEX_IMM} \
			-constraints testindexhex \
			-body {
				set list [testindexhex]
				llength $list
			} -cleanup {
				catch {unset list}
			} -result -1 

			test {indexhex lindex constant @mode@} {INST_LIST_INDEX_IMM} \
			-constraints testindexhex \
			-body {
				set list [testindexhex]
				@lindex@ $list 731
			} -cleanup {
				catch {unset list}
			} -result 2db


			test {indexhex lindex constant end @mode@} {INST_LIST_INDEX_IMM} \
			-constraints testindexhex \
			-body {
				set list [testindexhex]
				@lindex@ $list end
			} -cleanup {
				catch {unset list}
				catch {unset res}
			} -returnCodes 1 -result {list length indeterminate}



			test {indexhex lindex dynamic @mode@} {INST_LIST_INDEX} \
			-constraints testindexhex \
			-body {
				set list [testindexhex]
				set val [expr {731 + 0}]
				@lindex@ $list $val
			} -cleanup {
				catch {unset list}
			} -result 2db


			test {indexhex lindex dynamic end @mode@} {INST_LIST_INDEX} \
			-constraints testindexhex \
			-body {
				set index {}
				set list [testindexhex]
				append index e n d
				@lindex@ $list $index
			} -cleanup {
				catch {unset index}
				catch {unset list}
				catch {unset res}
			} -returnCodes 1 -result {list length indeterminate}


			test {indexhex lindex drill @mode@} {} \
			-constraints testindexhex \
			-body {
				set list [testindexhex]
				@lindex@ $list 731 0 0 0
			} -cleanup {
				catch {unset list}
			} -result 2db


			test {indexhex lrange constant @mode@} {} \
			-constraints testindexhex \
			-body {
				set list [testindexhex]
				@lrange@ $list 10 15
			} -cleanup {
				catch {unset list}
			} -result {a b c d e f}


			test {indexhex lrange dynamic @mode@} {} \
			-constraints testindexhex \
			-body {
				set list [testindexhex]
				set first [expr {10 + 0}]
				set last [expr {15 + 0}]
				@lrange@ $list $first $last
			} -cleanup {
				catch {unset list}
			} -result {a b c d e f}


			test {indexhex lrange end constant @mode@} {} \
			-constraints testindexhex \
			-body {
				set list [testindexhex]
				@lrange@ $list 10 end
			} -cleanup {
				catch {unset list}
			} -returnCodes 1 -result {list length indeterminate}


			test {indexhex lrange end dynamic @mode@} {} \
			-constraints testindexhex \
			-body {
				set list [testindexhex]
				set back [expr {-5 + 0}]
				@lrange@ $list 10 end-$back
			} -cleanup {
				catch {unset list}
			} -returnCodes 1 -result {list length indeterminate}


			test {indexhex lrange end minus constant @mode@} {} \
			-constraints testindexhex \
			-body {
				set list [testindexhex]
				@lrange@ $list 10 end-1
			} -cleanup {
				catch {unset list}
			} -returnCodes 1 -result {list length indeterminate}


			test {indexhex lsearch @mode@} {} \
			-constraints testindexhex \
			-body {
				set list [testindexhex]
				lsearch $list ff
			} -cleanup {
				catch {unset list}
			} -result 255


			test {indexhex lsearch sorted @mode@} {} \
			-constraints testindexhex \
			-body {
				set list [testindexhex]
				lsearch -sorted $list ff
			} -cleanup {
				catch {unset list}
			} -returnCodes 1 -result {sorted list is incoherent}


			test {indexhex lsearch start @mode@} {} \
			-constraints testindexhex \
			-body {
				set list [testindexhex]
				lsearch -start 5171 -glob $list a*
			} -cleanup {
				catch {unset list}
			} -result 40960


			test {indexhex string index @mode@} {} \
			-constraints testindexhex \
			-body {
				set iterations 4097
				set expected [data1 $iterations]
				set list [testindexhex]
				set progres {}
				set iterations [string length $expected]
				for {set i 0} {$i < $iterations} {incr i} {
				set eitem [string index $expected $i]
				set item [string index $list $i]
				if {$item ne $eitem} {
					error [list {failed at index} $i [
					format %x $i] expected $eitem got $item]
				}
				@lappend@ progress $item
				}
				return success
			} -cleanup {
				catch {unset i}
				catch {unset list}
			} -result success


			test {indexhex string index end @mode@} {} \
			-constraints testindexhex \
			-body {
				set list [testindexhex]
				string index $list end
				return success
			} -cleanup {
				catch {unset list}
			} -returnCodes 1 -result {list length indeterminate}


			test {indexhex string length @mode@} {} \
			-constraints testindexhex \
			-body {
				set list [testindexhex]
				string length $list
			} -cleanup {
				catch {unset list}
			} -result -1


			test {indexhex string range @mode@} {} \
			-constraints testindexhex \
			-body {
				set res {}
				set iterations 4097
				set data1 [data1 $iterations]
				set data1Length [string length $data1]
				set list [testindexhex]
				for {set first 0} {$first < $data1Length } {
				set first [expr {($first + 1) * 2}]} {

				for {set last $first} {$last < $data1Length} {
					set last [expr {($last + 1) * 3}]} {

					set expected [string range $data1 $first $last]
					set range [string range $list $first $last]
					if {$range ne $expected} {
					set length [expr {
						max([string length $expected], [string length $range])
					}]
					for {set i 0} {$i < $length} {incr i} {
						set item1 [string index $range $i]
						set item2 [string index $expected $i]
						if {$item1 ne $item2} {
						error [list {failed at} $first $last $i \
							expected $item2 got $item1]
						}
					}
					}
				}
				}
				@lappend@ res success

				# The largest string index currently allowed.
				@lappend@ res [string range $list 2147483640 2147483647]

				# This produces an error until index ranges are expanded in some later
				# version of Tcl.
				set status [catch {string range $list 2147483640 2147483648} cres copts]

				@lappend@ res $status $cres
				return $res
			} -cleanup {
				catch {unset list}
			} -result {success {d73ac8f } 1 {}}


			test {integer lappend @mode@} {} \
			-constraints testlistinteger \
			-body {
				set list [testlistinteger {}]
				@lappend@ list 8 9 10
				@lappend@ list 11 12 13
			} -cleanup {
				catch {unset list}
			} -result {8 9 10 11 12 13}


			test {integer lappend empty @mode@} {} \
			-constraints testlistinteger \
			-body {
				set list [testlistinteger {}]
				@lappend@ list 8 9 10
			} -cleanup {
				catch {unset list}
			} -result {8 9 10}


			test {integer lappend noninteger @mode@} {} \
			-constraints testlistinteger \
			-body {
				set list [testlistinteger {}]
				@lappend@ list {8 9 10 11 12 13}
			} -cleanup {
				catch {unset list}
			} -result {{8 9 10 11 12 13}}


			test {integer lindex before before after @mode@} {
			This test just tries to trigger a segmentation fault
			} \
			-constraints testlistinteger \
			-body {
				set list [testlistinteger {}]
				@lappend@ list 8 9 10 11 12 13
				@lindex@ $list -1 -1 7 
			} -cleanup {
				catch {unset list}
			} -result {}


			test {integer lindex middle @mode@} {} \
			-constraints testlistinteger \
			-body {
				set list [testlistinteger {}]
				@lappend@ list 8 9 10 11 12 13
				@lindex@ $list 3 
			} -cleanup {
				catch {unset list}
			} -result 11 


			test {integer lindex end @mode@} {} \
			-constraints testlistinteger \
			-body {
				set list [testlistinteger {}]
				@lappend@ list 8 9 10 11 12 13
				@lindex@ $list end 
			} -cleanup {
				catch {unset list}
			} -result 13 


			apply [list {} {
				for {set i 0} {$i < 7} {incr i} {
					set items {8 9 10 11 12 13}
					set results {13 12 11 10 9 8}

					set comment [list integer lindex end-$i @mode@]
					set body [string map {@i@ $i @items@ $items} {
						set list [testlistinteger {}]
						@lappend@ list {*}$items
						@lindex@ $list end-$i
					}]
					set result [lindex $results $i]

					test $comment {} \
					-constraints testlistinteger \
					-body $body -cleanup {
						catch {unset list}
					} -result $result 
				}
				unset i
			} [namespace current]]


			test {integer linsert middle one @mode@} {} \
			-constraints testlistinteger \
			-body {
				set list [testlistinteger {}]
				set res {}
				@lappend@ list 8 9 10 12 13
				after 100
				lappend res [@linsert@ $list 3 11]
				set representation [::tcl::unsupported::representation $list]
				regsub {(value is a testListInteger).*} $representation {\1} representation
				lappend res $representation
				return $res
			} -cleanup {
				catch {unset list}
				catch {unset res}
				catch {unset representation}
			} -result  {{8 9 10 11 12 13} {value is a testListInteger}}


			test {integer lrange middle @mode@} {} \
			-constraints testlistinteger \
			-body {
				set list [testlistinteger {}]
				@lappend@ list 8 9 10 11 12 13
				@lrange@ $list 3 4
			} -cleanup {
				catch {unset list}
			} -result {11 12}


			test {integer lreplace prepend @mode@} {} \
			-constraints testlistinteger \
			-body {
				set list [testlistinteger {}]
				@lappend@ list 8 9 10 11 12 13
				after 100
				@lreplace@ $list -1 -1 7 
			} -cleanup {
				catch {unset list}
			} -result {7 8 9 10 11 12 13}
		}]
		#try $script

    }

    set suites {linsert lset}  

    foreach suite {linsert lset} {
	    set namespace [list $suite tests]
	    namespace eval $namespace [list source [
		    file join [file dirname [file dirname [
			    file normalize [file join [info script] ...]]]] $suite.test]]
	    namespace eval $namespace {
		    proc newlist list {
			    if {[string is list $list]} {
				    set integer 1
				    foreach item $list {
					    if {![string is integer $item]} {
						    set integer 0
						    break
					    }
				    }
				    if {$integer} {
					    testlistinteger $list
				    }
			    }
			    return $list
		    }
		    try $tests
	    }
	    namespace delete $namespace
    }


    # cleanup
    ::tcltest::cleanupTests
} [namespace current]]

return
Changes to tests/oo.test.
1
2
3
4
5
6
7
8











9
10
11
12
13
14
15




1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
-
-
-
-




+
+
+
+
+
+
+
+
+
+
+







# This file contains a collection of tests for Tcl's built-in object system.
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright © 2006-2013 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains a collection of tests for Tcl's built-in object system.
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.

package require tcl::oo 1.3.0
if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

Changes to tests/ooNext2.test.
1
2
3
4
5
6
7
8











9
10
11
12
13
14
15




1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
-
-
-
-




+
+
+
+
+
+
+
+
+
+
+







# This file contains a collection of tests for Tcl's built-in object system.
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright © 2006-2011 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains a collection of tests for Tcl's built-in object system.
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.

package require tcl::oo 1.3.0
if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

Changes to tests/ooProp.test.
1
2
3
4
5
6
7
8
9












10
11
12
13
14
15
16





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
-
-
-
-
-




+
+
+
+
+
+
+
+
+
+
+
+







# This file contains a collection of tests for Tcl's built-in object system,
# specifically the parts that support configurable properties on objects.
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright © 2019-2020 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains a collection of tests for Tcl's built-in object system,
# specifically the parts that support configurable properties on objects.
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.

package require tcl::oo 1.0.3
package require tcltest 2
if {"::tcltest" in [namespace children]} {
    namespace import -force ::tcltest::*
}

Changes to tests/ooUtil.test.
1
2
3
4
5
6
7
8
9
10












11
12
13
14
15
16
17





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+







# This file contains a collection of tests for functionality originally
# sourced from the ooutil package in Tcllib. Sourcing this file into Tcl runs
# the tests and generates output for errors. No output means no errors were
# found.
#
# Copyright © 2014-2016 Andreas Kupries
# Copyright © 2018 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains a collection of tests for functionality originally
# sourced from the ooutil package in Tcllib. Sourcing this file into Tcl runs
# the tests and generates output for errors. No output means no errors were
# found.

package require tcl::oo 1.3.0
if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

Changes to tests/opt.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Package covered:  opt1.0/optparse.tcl
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Package covered:  opt1.0/optparse.tcl
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# the package we are going to test
Changes to tests/package.test.
1
2
3
4
5
6
7
8
9
10
11
12
13














14
15
16
17
18
19
20







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
-
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+







# This file contains tests for the package and ::pkg::* commands.
# Note that the tests are limited to Tcl scripts only, there are no shared
# libraries against which to test.
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright © 1995-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
# Copyright © 2011 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains tests for the package and ::pkg::* commands.
# Note that the tests are limited to Tcl scripts only, there are no shared
# libraries against which to test.
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/parse.test.
1
2
3
4
5
6
7
8
9











10
11
12
13
14
15
16




1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+







# This file contains a collection of tests for the procedures in the
# file tclParse.c.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains a collection of tests for the procedures in the
# file tclParse.c.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

namespace eval ::tcl::test::parse {
Changes to tests/parseExpr.test.
1
2
3
4
5
6
7
8
9











10
11
12
13
14
15
16




1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+







# This file contains a collection of tests for the procedures in the
# file tclCompExpr.c.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains a collection of tests for the procedures in the
# file tclCompExpr.c.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/parseOld.test.














1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-
-
-







# Copyright © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  set (plus basic command syntax).  Also tests the
# procedures in the file tclOldParse.c.  This set of tests is an old
# one that predates the new parser in Tcl 8.1.
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/pid.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  pid
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1995 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  pid
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

testConstraint pidDefined [llength [info commands pid]]
Changes to tests/pkgMkIndex.test.










1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16



17
18
19
20
21
22
23
+
+
+
+
+
+
+
+
+
+






-
-
-







# Copyright © 1998-1999 Scriptics Corporation.
# All rights reserved.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains tests for the pkg_mkIndex command.
# Note that the tests are limited to Tcl scripts only, there are no shared
# libraries against which to test.
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright © 1998-1999 Scriptics Corporation.
# All rights reserved.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

set fullPkgPath [makeDirectory pkg]
Changes to tests/platform.test.












1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17





18
19
20
21
22
23
24
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-







# Copyright © 1999 Scriptics Corporation
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# The file tests the tcl_platform variable and platform package.
#
# 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 © 1999 Scriptics Corporation
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcltest 2.5
source [file join [file dirname [info script]] tcltests.tcl]

namespace eval ::tcl::test::platform {
    namespace import ::tcltest::testConstraint
    namespace import ::tcltest::test
Changes to tests/proc-old.test.














1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+








-
-
-
-
-
-
-







# Copyright © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  proc, return, global
#
# This file, proc-old.test, includes the original set of tests for Tcl's
# proc, return, and global commands. There is now a new file proc.test
# that contains tests for the tclProc.c source file.
#
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

catch {rename t1 ""}
Changes to tests/proc.test.













1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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
+
+
+
+
+
+
+
+
+
+
+
+
+








-
-
-
-
-
-







# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains tests for the tclProc.c source file. Tests appear in the
# same order as the C code that they test. The set of tests is currently
# incomplete since it includes only new tests, in particular tests for code
# changed for the addition of Tcl namespaces. Other procedure-related tests
# appear in other test files such as proc-old.test.
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands

Changes to tests/process.test.











1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16




17
18
19
20
21
22
23
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-







# Copyright © 2017 Frederic Bonnet
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# process.test --
#
# This file contains a collection of tests for the tcl::process ensemble.
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright © 2017 Frederic Bonnet
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# Utilities
Changes to tests/pwd.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  pwd
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  pwd
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

test pwd-1.1 {simple pwd} {
Changes to tests/reg.test.









1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17


18
19
20
21
22
23
24
+
+
+
+
+
+
+
+
+








-
-







# Copyright © 1998, 1999 Henry Spencer.  All rights reserved.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# reg.test --
#
# 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.
# (Don't panic if you are seeing this as part of the reg distribution
# and aren't using Tcl -- reg's own regression tester also knows how
# to read this file, ignoring the Tcl-isms.)
#
# Copyright © 1998, 1999 Henry Spencer.  All rights reserved.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/regexp.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  regexp, regsub
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1998 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  regexp, regsub
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

unset -nocomplain foo
Changes to tests/regexpComp.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  regexp, regsub
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1998 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  regexp, regsub
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# Procedure to evaluate a script within a proc, to test compilation
Changes to tests/registry.test.










1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
+
+
+
+
+
+
+
+
+
+








-
-
-







# Copyright © 1997 Sun Microsystems, Inc.  All rights reserved.
# Copyright © 1998-1999 Scriptics Corporation.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# registry.test --
#
# This file contains a collection of tests for the registry command.
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# In order for these tests to run, the registry package must be on the
# auto_path or the registry package must have been loaded already.
#
# Copyright © 1997 Sun Microsystems, Inc.  All rights reserved.
# Copyright © 1998-1999 Scriptics Corporation.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

testConstraint reg 0
Changes to tests/remote.tcl.












1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17





18
19
20
21
22
23
24
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-







# Copyright © 1995-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains Tcl code to implement a remote server that can be
# used during testing of Tcl socket code. This server is used by some
# of the tests in socket.test.
#
# Source this file in the remote server you are using to test Tcl against.
#
# Copyright © 1995-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Initialize message delimiter

# Initialize command array
catch {unset command}
set command(0) ""
set callerSocket ""
Changes to tests/rename.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  rename
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  rename
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/resolver.test.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# This test collection covers some unwanted interactions between command
# literal sharing and the use of command resolvers (per-interp) which cause
# command literals to be re-used with their command references being invalid
# in the reusing context.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright © 2011 Gustaf Neumann <gustaf.neumann@wu.ac.at>
# Copyright © 2011 Stefan Sobernig <stefan.sobernig@wu.ac.at>
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This test collection covers some unwanted interactions between command
# literal sharing and the use of command resolvers (per-interp) which cause
# command literals to be re-used with their command references being invalid
# in the reusing context.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/result.test.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# This file tests the routines in tclResult.c.
#
# 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 © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file tests the routines in tclResult.c.
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/safe-stock.test.













1
2
3
4
5
6
7
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
+
+
+
+
+
+
+
+
+
+
+
+
+







# Copyright © 1995-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# safe-stock.test --
#
# This file contains tests for safe Tcl that were previously in the file
# safe.test, and use files and packages of stock Tcl 8.7 to perform the tests.
# These files may be changed or disappear in future revisions of Tcl, for
# example package opt will eventually be removed.
#
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
30
31
32
33
34
35
36






37
38
39
40
41
42
43







-
-
-
-
-
-







#   tcl::idna to provide alternative tests based on stock Tcl packages.
#   - These are tests 7.1 7.2 7.4 9.11 9.13
#   - Tests 7.[124], 9.1[13] use "package require opt".
#   - Tests 9.1[13] also use "package require tcl::idna".
# - The corresponding tests in safe.test use example packages provided in
#   subdirectory auto0 of the tests directory, which are independent of any
#   changes made to the packages provided with Tcl.
#
# Copyright © 1995-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

foreach i [interp children] {
Changes to tests/safe-zipfs.test.













1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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
+
+
+
+
+
+
+
+
+
+
+
+
+








-
-
-
-
-
-







# Copyright © 1995-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# safe-zipfs.test --
#
# This file contains tests for safe Tcl that test its compatibility with the
# zipfs facilities introduced in Tcl 8.7.  Test numbering is for comparison
# with similar tests in safe.test that do not use the zipfs file system.
#
# Sourcing this file into tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright © 1995-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.


apply [list {} {
    global auto_path
    global tcl_library
    if {"::tcltest" ni [namespace children]} {
        package require tcltest 2.5
Changes to tests/safe.test.













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
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
+
+
+
+
+
+
+
+
+
+
+
+
+















-
-
-
-
-
-







# Copyright © 1995-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# safe.test --
#
# This file contains a collection of tests for safe Tcl, packages loading, and
# using safe interpreters. Sourcing this file into tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
# The defunct package http 1.0 was convenient for testing package loading.
# - Tests that used http are replaced here with tests that use example packages
#   provided in subdirectory auto0 of the tests directory, which are independent
#   of any changes made to the packages provided with Tcl itself.
#   - These are tests 7.1 7.2 7.4 9.11 9.13 17.1 17.2 17.4
#   - Tests 5.* test the example packages themselves before they
#     are used to test Safe Base interpreters.
# - Alternative tests using stock packages of Tcl 8.7 are in file
#   safe-stock.test.
#
# Copyright © 1995-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
Changes to tests/scan.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  scan
#
# 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 © 1991-1994 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  scan
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# procedure that returns the range of integers
Changes to tests/security.test.











1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-







# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
# All rights reserved.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# security.test --
#
# Functionality covered: this file contains a collection of tests for the auto
# loading and namespaces.
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
# All rights reserved.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# If this proc becomes invoked, then there is a bug
Changes to tests/set-old.test.














1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-
-
-







# Copyright © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  set, unset, array
#
# This file includes the original set of tests for Tcl's set command.
# Since the set command is now compiled, a new set of tests covering
# the new implementation is in the file "set.test". Sourcing this file
# into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

proc ignore args {}
Changes to tests/set.test.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  set
#
# 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 © 1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  set
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/socket.test.













1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
-
-







# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-2000 Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands tested in this file: socket.
#
# 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 © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-2000 Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Running socket tests with a remote server:
# ------------------------------------------
#
# Some tests in socket.test depend on the existence of a remote server to
# which they connect. The remote server must be an instance of tcltest and it
# must run the script found in the file "remote.tcl" in this directory. You
2413
2414
2415
2416
2417
2418
2419


2420
2421
2422

2423
2424
2425
2426
2427
2428
2429
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431

2432
2433
2434
2435
2436
2437
2438
2439







+
+


-
+







        close $sock
	removeFile script
    } -result {{} ok}
test socket-14.11.0 {pending [socket -async] and nonblocking [puts], no listener, no flush} \
    -constraints {socket notWinCI} \
    -body {
        set sock [socket -async localhost [randport]]
        fileevent $sock writable {incr x}
        vwait x
        fconfigure $sock -blocking 0
        puts $sock ok
        fileevent $sock writable {set x 1}
        fileevent $sock writable {incr x}
        vwait x
        close $sock
    } -cleanup {
        catch {close $sock}
        unset x
    } -result {transport endpoint is not connected} -returnCodes 1
test socket-14.11.1 {pending [socket -async] and nonblocking [puts], no listener, flush} \
Changes to tests/source.test.
1
2
3
4
5
6
7
8
9
10
11
12
13













14
15
16
17
18
19
20






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
-
-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  source
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-2000 Scriptics Corporation.
# Contributions from Don Porter, NIST, 2003.  (not subject to US copyright)
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  source
#
# 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.

if {[catch {package require tcltest 2.5}]} {
    puts stderr "Skipping tests in [info script]. tcltest 2.5 required."
    return
}

namespace eval ::tcl::test::source {
Changes to tests/split.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  split
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  split
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

test split-1.1 {basic split commands} {
Changes to tests/stack.test.












1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17





18
19
20
21
22
23
24
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-







# Copyright © 1998-2000 Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Tests that the stack size is big enough for the application.
#
# 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 © 1998-2000 Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# Note that a failure in this test may result in a crash of the executable.
Changes to tests/string.test.
1
2
3
4
5
6
7
8
9
10
11
12
13













14
15
16
17
18
19
20






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
-
-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  string
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
# Copyright © 2001 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.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  string
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/stringObj.test.













1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-
-







# Copyright © 1995-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered: none
#
# This file contains tests for the procedures in tclStringObj.c that implement
# the Tcl type manager for the string type.
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright © 1995-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/subst.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  subst
#
# 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 © 1994 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-2000 Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  subst
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
Changes to tests/switch.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  switch
#
# 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 © 1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  switch
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

test switch-1.1 {simple patterns} {
Changes to tests/tailcall.test.












1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17





18
19
20
21
22
23
24
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-







# Copyright © 2008 Miguel Sofer.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  tailcall
#
# This file contains a collection of tests for experimental commands that are
# found in ::tcl::unsupported. The tests will migrate to normal test files
# if/when the commands find their way into the core.
#
# Copyright © 2008 Miguel Sofer.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/tcltest.test.
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




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
-
-
-
-



+
+
+
+
+
+
+
+
+
+
+










-







# 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 © 1998-1999 Scriptics Corporation.
# Copyright © 2000 Ajuba Solutions
# All rights reserved.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# 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.

# Note that there are several places where the value of
# tcltest::currentFailure is stored/reset in the -setup/-cleanup
# of a test that has a body that runs [test] that will fail.
# This is a workaround of using the same tcltest code that we are
# testing to run the test itself.  Ditto on things like [verbose].
#
# It would be better to have the -body of the tests run the tcltest
# commands in a child interp so the [test] being tested would not
# interfere with the [test] doing the testing.
#

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# File permissions broken on wsl without some "exotic" wsl configuration
Changes to tests/tcltests.tcl.
1
2







3
4
5
6
7
8
9
10
11
12
13
14
15
16
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

16
17
18
19
20
21
22


+
+
+
+
+
+
+






-







#! /usr/bin/env tclsh

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Don't overwrite tcltests facilities already present
if {[package provide tcltests] ne {}} return

package require tcltest 2.5
namespace import ::tcltest::*
testConstraint exec [llength [info commands exec]]
testConstraint deprecated [expr {![tcl::build-info no-deprecate]}]
testConstraint debug [tcl::build-info debug]
testConstraint purify [tcl::build-info purify]
testConstraint debugpurify [
    expr {
	![tcl::build-info memdebug]
	&& [testConstraint debug]
	&& [testConstraint purify]
Changes to tests/thread.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  (test)thread
#
# 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 © 1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
# Copyright © 2006-2008 Joe Mistachkin.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  (test)thread
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

#  when thread::release is used, -wait is passed in order allow the thread to
Changes to tests/timer.test.













1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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
+
+
+
+
+
+
+
+
+
+
+
+
+








-
-
-
-
-
-







# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains a collection of tests for the procedures in the
# file tclTimer.c, which includes the "after" Tcl command.  Sourcing
# this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# 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 © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

test timer-1.1 {Tcl_CreateTimerHandler procedure} -setup {
Changes to tests/tm.test.










1
2
3
4
5
6
7
8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14



15
16
17
18
19
20
21
+
+
+
+
+
+
+
+
+
+




-
-
-







# Copyright © 2004 Donal K. Fellows.
# All rights reserved.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains tests for the ::tcl::tm::* commands.
#
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright © 2004 Donal K. Fellows.
# All rights reserved.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

test tm-1.1 {tm: path command exists} {
Changes to tests/trace.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  trace
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  trace
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/unixFCmd.test.












1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17





18
19
20
21
22
23
24
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-







# Copyright © 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file tests the tclUnixFCmd.c file.
#
# 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 © 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/unixFile.test.












1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17





18
19
20
21
22
23
24
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-







# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains tests for the routines in the file tclUnixFile.c
#
# 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 © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/unixForkEvent.test.
1
2
3
4
5
6
7
8
9











10
11
12
13
14
15
16




1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+







# This file contains a collection of tests for the procedures in the file
# tclUnixNotify.c.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright © 1995-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains a collection of tests for the procedures in the file
# tclUnixNotify.c.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

testConstraint testfork [llength [info commands testfork]]
Changes to tests/unixInit.test.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# The file tests the functions in the tclUnixInit.c file.
#
# 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 © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# The file tests the functions in the tclUnixInit.c file.
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
unset -nocomplain path
catch {set oldlang $env(LANG)}
Changes to tests/unixNotfy.test.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# This file contains tests for tclUnixNotfy.c.
#
# 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 © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains tests for tclUnixNotfy.c.
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# When run in a Tk shell, these tests hang.
Changes to tests/unknown.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  unknown
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  unknown
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

unset -nocomplain x
Changes to tests/unload.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  unload
#
# 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 © 1995 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
# Copyright © 2003-2004 Georgios Petasis
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  unload
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/uplevel.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  uplevel
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  uplevel
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

proc a {x y} {
Changes to tests/upvar.test.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  'upvar', 'namespace upvar'
#
# 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 © 1991-1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  'upvar', 'namespace upvar'
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/utf.test.
1
2
3
4
5
6
7
8
9











10
11
12
13
14
15
16




1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+







# This file contains a collection of tests for tclUtf.c
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains a collection of tests for tclUtf.c
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
75
76
77
78
79
80
81
82

83
84
85
86

87
88
89
90
91
92
93
82
83
84
85
86
87
88

89
90
91
92

93
94
95
96
97
98
99
100







-
+



-
+







test utf-1.15 {Tcl_UniCharToUtf: surrogate pairs from concat} {
    set hi \uD83D
    return $hi\uDE02
} \uD83D\uDE02
test utf-1.16 {Tcl_UniCharToUtf: \xC0 + \x80} testbytestring {
    set lo [testbytestring \x80]
    string length [testbytestring \xC0]$lo
} 2
} 1
test utf-1.17 {Tcl_UniCharToUtf: \xC0 + \x80} testbytestring {
    set hi [testbytestring \xC0]
    string length $hi[testbytestring \x80]
} 2
} 1
test utf-1.18 {Tcl_UniCharToUtf: surrogate pairs from concat} {
    string cat \uD83D \uDE02
} \uD83D\uDE02

test utf-2.1 {Tcl_UtfToUniChar: low ascii} {
    string length "abc"
} 3
Changes to tests/utfext.test.













1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
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
+
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-







# Copyright (c) 2023 Ashok P. Nadkarni
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Copyright (c) 2024 Nathan Coulter
# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains a collection of tests for Tcl_UtfToExternal and
# Tcl_UtfToExternal that exercise various combinations of flags,
# buffer lengths and fragmentation that cannot be tested by
# normal script level commands. There tests are NOT intended to check
# correct encodings; those are elsewhere.
#
# Copyright (c) 2023 Ashok P. Nadkarni
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/util.test.
1
2
3
4
5
6
7
8










9
10
11
12
13
14
15



1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
-
-
-





+
+
+
+
+
+
+
+
+
+







# This file is a Tcl script to test the code in the file tclUtil.c.
# This file is organized in the standard fashion for Tcl tests.
#
# Copyright © 1995-1998 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file is a Tcl script to test the code in the file tclUtil.c.
# This file is organized in the standard fashion for Tcl tests.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/var.test.













1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
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
+
+
+
+
+
+
+
+
+
+
+
+
+









-
-
-
-
-
-







# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file contains tests for the tclVar.c source file. Tests appear in the
# same order as the C code that they test. The set of tests is currently
# incomplete since it currently includes only new tests for code changed for
# the addition of Tcl namespaces. Other variable-related tests appear in
# several other test files including namespace.test, set.test, trace.test, and
# upvar.test.
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/while-old.test.














1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-
-
-







# Copyright © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  while
#
# This file contains the original set of tests for Tcl's while command.
# Since the while command is now compiled, a new set of tests covering
# the new implementation is in the file "while.test". Sourcing this file
# into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

test while-old-1.1 {basic while loops} {
Changes to tests/while.test.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# Commands covered:  while
#
# 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 © 1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Commands covered:  while
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# Basic "while" operation.
Changes to tests/winConsole.test.










1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
+
+
+
+
+
+
+
+
+
+








-
-
-







# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file tests the tclWinConsole.c file.
#
# 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.
#
# NOTE THIS CANNOT BE RUN VIA nmake/make test since stdin is connected to
# nmake in that case.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

catch {package require twapi} ;# Only to bring window to foreground. Not critical
Changes to tests/winDde.test.












1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17





18
19
20
21
22
23
24
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-







# Copyright © 1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file tests the tclWinDde.c file.
#
# 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 © 1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
source [file join [file dirname [info script]] tcltests.tcl]

Changes to tests/winFCmd.test.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# This file tests the tclWinFCmd.c file.
#
# 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 © 1996-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file tests the tclWinFCmd.c file.
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/winFile.test.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# This file tests the tclWinFile.c file.
#
# 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 © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file tests the tclWinFile.c file.
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/winNotify.test.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# This file tests the tclWinNotify.c file.
#
# 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 © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file tests the tclWinNotify.c file.
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/winPipe.test.


1










2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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
+
+

+
+
+
+
+
+
+
+
+
+






-
-
-
-
-
-







# Copyright © 1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# winPipe.test --
#
# This file contains a collection of tests for tclWinPipe.c
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output (except for one message) means no errors were found.
#
# Copyright © 1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
unset -nocomplain path

Changes to tests/winTime.test.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# This file tests the tclWinTime.c file.
#
# 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 © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file tests the tclWinTime.c file.
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
Changes to tests/zipfs.test.
1
2
3
4
5
6
7
8
9
10
11
12
13













14
15
16
17
18
19
20






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
-
-
-
-
-
-






-
+
+
+
+
+
+
+
+
+
+
+
+
+







# The file tests the tclZlib.c file.
#
# 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 © 1996-1998 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
# Copyright © 2023 Ashok P. Nadkarni
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# The file tests the tclZlib.c file.
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
source [file join [file dirname [info script]] tcltests.tcl]

Changes to tests/zlib.test.
1
2
3
4
5
6
7
8
9
10
11













12
13
14
15
16
17
18






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
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+







# The file tests the tclZlib.c file.
#
# 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 © 1996-1998 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# The file tests the tclZlib.c file.
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

source [file join [file dirname [info script]] tcltests.tcl]
Changes to tools/checkLibraryDoc.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
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
+
+
+
+
+
+
+
+
+
+

















-
+
-
-







# Copyright © 1998-1999 Scriptics Corporation.
# All rights reserved.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# checkLibraryDoc.tcl --
#
# This script attempts to determine what APIs exist in the source base that
# have not been documented.  By grepping through all of the doc/*.3 man
# pages, looking for "Pkg_*" (e.g., Tcl_ or Tk_), and comparing this list
# against the list of Pkg_ APIs found in the source (e.g., tcl9.0/*/*.[ch])
# we create six lists:
#      1) APIs in Source not in Docs.
#      2) APIs in Docs not in Source.
#      3) Internal APIs and structs.
#      4) Misc APIs and structs that we are not documenting.
#      5) Command APIs (e.g., Tcl_ArrayObjCmd.)
#      6) Proc pointers (e.g., Tcl_CloseProc.)
#
# Note: Each list is "a best guess" approximation.  If developers write
# non-standard code, this script will produce erroneous results.  Each
# list should be carefully checked for accuracy.
#

# Copyright © 1998-1999 Scriptics Corporation.
# All rights reserved.


lappend auto_path "c:/program\ files/tclpro1.2/win32-ix86/bin"
#lappend auto_path "/home/surles/cvs/tclx8.0/tcl/unix"
if {[catch {package require Tclx}]} {
    puts "error: could not load TclX.  Please set TCL_LIBRARY."
    exit 1
Changes to tools/encoding/Makefile.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17










1
2
3
4
5
6
7
-
-
-
-
-
-
-
-
-
-







#
# This file is a Makefile to compile all the encoding files.
#
# Run "make" to compile all the encoding files (*.txt,*.esc) into the
# format that Tcl can use (*.enc).  It is your responsibility to move the
# encoding files to the appropriate place ($TCL_ROOT/library/encoding
#
# The .txt files in this directory come from the Unicode CD and are covered
# by the following copyright notice:
#
#---------------------------------------------------------------------------
#
# Copyright (c) 1996 Unicode, Inc.  All Rights reserved.
#
# This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
# No claims are made as to fitness for any particular purpose.  No
# warranties of any kind are expressed or implied.  The recipient
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
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







-
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+












-
+
-
-
-
-
-
-
-







# specifically excludes the right to re-distribute this file directly
# to third parties or other organizations whether for profit or not.
#
# In other words:  Don't put this file on the Internet.  People who want to
# get it over the Internet should do so directly from ftp://unicode.org.  They
# can therefore be assured of getting the most recent and accurate version.
#
#----------------------------------------------------------------------------

# Copyright (c) 1998 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) Makefile 1.1 98/01/28 11:41:36

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file is a Makefile to compile all the encoding files.
#
# Run "make" to compile all the encoding files (*.txt,*.esc) into the
# format that Tcl can use (*.enc).  It is your responsibility to move the
# encoding files to the appropriate place ($TCL_ROOT/library/encoding
#
# The .txt files in this directory come from the Unicode CD and are covered
# by the following copyright notice:

# The txt2enc program built by this makefile is used to compile individual
# .txt files into .enc files, the format that Tcl understands for encoding
# files.  This compilation to a different format is allowed by the above
# restriction.
#
# The files shiftjis.txt and jis0208.txt were modified from the original
# ones provided on the Unicode CD.  The double-width backslash character
# 0x815F in these two Japanese encodings was being mapped to Unicode 005C
# (REVERSE SOLIDUS), the normal backslash character.  They have been
# changed to map 0x815F to Unicode FF3C (FULLWIDTH REVERSE SOLIDUS) and let
# the regular backslash character map to itself.  This follows how cp932
# behaves.
#

# Copyright (c) 1998 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) Makefile 1.1 98/01/28 11:41:36
#

EUC_ENCODINGS = euc-cn.txt euc-kr.txt euc-jp.txt

encodings: clean txt2enc $(EUC_ENCODINGS)
	@echo Compiling encoding files.
	@for p in *.esc; do \
	    base=`echo $$p | sed 's/\..*$$//'`; \
Changes to tools/encoding/txt2enc.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

















16
17
18
19
20
21
22
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

-
-
-
-
-
-








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * txt2enc.c --
 *
 *	Simple program to compile up the encodings tables from the CD that
 *	came with "The Unicode Standard, Version 2.0" into a form that can
 *	be quickly loaded into Tcl.
 *
 * Copyright (c) 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.
 *
 * SCCS: @(#) txt2enc.c 1.1 98/01/28 11:42:09
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * txt2enc.c --
 *
 *	Simple program to compile up the encodings tables from the CD that
 *	came with "The Unicode Standard, Version 2.0" into a form that can
 *	be quickly loaded into Tcl.
 */

#include <stdio.h>
#include <stdlib.h>
#include <ctype.h>
#include <string.h>
#include <unistd.h>

typedef unsigned short Rune;
Changes to tools/findBadExternals.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
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
+
+
+
+
+
+
+
+
+
+
+
+











-
-
-
-
-
-







# Copyright © 2005 George Peter Staplin and Kevin Kenny
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# findBadExternals.tcl --
#
#	This script scans the Tcl load library for exported symbols
#	that do not begin with 'Tcl' or 'tcl'.  It reports them on the
#	standard output.  It is used to make sure that the library does
#	not inadvertently export externals that may be in conflict with
#	other code.
#
# Usage:
#
#	tclsh findBadExternals.tcl /path/to/tclXX.so-or-.dll
#
# Copyright © 2005 George Peter Staplin and Kevin Kenny
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#----------------------------------------------------------------------

proc main {argc argv} {

    if {$argc != 1} {
	puts stderr "syntax is: [info script] libtcl"
	return 1
    }
Changes to tools/genStubs.tcl.
1
2
3
4
5
6
7
8
9
10
11












12
13
14
15
16
17
18






1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
-
-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+







# genStubs.tcl --
#
#	This script generates a set of stub files for a given
#	interface.
#
#
# Copyright © 1998-1999 Scriptics Corporation.
# Copyright © 2007 Daniel A. Steffen <das@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# genStubs.tcl --
#
#	This script generates a set of stub files for a given
#	interface.

namespace eval genStubs {
    # libraryName --
    #
    #	The name of the entire library.  This value is used to compute
    #	the USE_*_STUBS macro and the name of the init file.

Changes to tools/index.tcl.












1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17





18
19
20
21
22
23
24
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-







# Copyright © 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# index.tcl --
#
# This file defines procedures that are used during the first pass of
# the man page conversion.  It is used to extract information used to
# generate a table of contents and a keyword list.
#
# Copyright © 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Global variables used by these scripts:
#
# state -	state variable that controls action of text proc.
#
# topics -	array indexed by (package,section,topic) with value
#		of topic ID.
Changes to tools/installData.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



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
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+









-
-
-
-
-







#!/bin/sh
#\
exec tclsh "$0" ${1+"$@"}
#! /usr/bin/env tclsh

# Copyright © 2004 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.
#----------------------------------------------------------------------

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#----------------------------------------------------------------------
#
# installData.tcl --
#
#	This file installs a hierarchy of data found in the directory
#	specified by its first argument into the directory specified
#	by its second.
#
#----------------------------------------------------------------------
#
# Copyright © 2004 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.
#----------------------------------------------------------------------

proc copyDir {d1 d2} {

    puts [format {%*sCreating %s} [expr {4 * [info level]}] {} \
	      [file tail $d2]]

Changes to tools/installVfs.tcl.
1
2
3












4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22



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
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-







#!/bin/sh
#\
exec tclsh "$0" ${1+"$@"}
#! /usr/bin/env tclsh

# Copyright © 2018 Sean Woods.  All rights reserved.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#----------------------------------------------------------------------
#
# installVfs.tcl --
#
#        This file wraps the /library file system around a binary
#
#----------------------------------------------------------------------
#
# Copyright © 2018 Sean Woods.  All rights reserved.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#----------------------------------------------------------------------

proc mapDir {resultvar prefix filepath} {
    upvar 1 $resultvar result
    if {![info exists result]} {
      set result {}
    }
Changes to tools/loadICU.tcl.













1

2
3
4
5
6
7
8
1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
21
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+







#! /usr/bin/env tclsh

# Copyright © 2004 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.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#----------------------------------------------------------------------
#---------------------------------------------------------------------
#
# loadICU,tcl --
#
#	Extracts locale strings from a distribution of ICU
#	(http://oss.software.ibm.com/developerworks/opensource/icu/project/)
#	and makes Tcl message catalogs for the 'clock' command.
#
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
29
30
31
32
33
34
35





36
37
38
39
40
41
42







-
-
-
-
-







#
# Results:
#	None.
#
# Side effects:
#	Creates the message catalogs.
#
#----------------------------------------------------------------------
#
# Copyright © 2004 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.
#----------------------------------------------------------------------

puts stdout "TODO: output in UTF-8 in stead of using \\uhhhh sequences"
exit; # Remove those two lines after modifying this tool.

# Calculate the Chinese numerals from zero to ninety-nine.

349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
357
358
359
360
361
362
363

364
365
366
367
368
369
370







-







    # Write the Tcl message catalog

    set f [open $msgFileName w]

    # Write a header

    puts $f "\# created by $::argv0 -- do not edit"
    puts $f "namespace eval ::tcl::clock \{"

    # Do ordinary sets of strings (weekday and month names)

    foreach key {
	DayAbbreviations DayNames MonthAbbreviations MonthNames
    } tkey {
	DAYS_OF_WEEK_ABBREV DAYS_OF_WEEK_FULL
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
537
538
539
540
541
542
543

544
545
546
547
548
549
550







-







		[backslashify $format($localeName,$key)] "\""
	    puts $f $cmd
	}
    }

    # Footer

    puts $f "\}"
    close $f
}

#----------------------------------------------------------------------
#
# percentify --
#
Changes to tools/makeHeader.tcl.












1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17




18
19
20
21
22
23
24
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-







# Copyright © 2018 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# makeHeader.tcl --
#
#	This script generates embeddable C source (in a .h file) from a .tcl
#	script.
#
# Copyright © 2018 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl 8.6-

namespace eval makeHeader {

    ####################################################################
    #
Changes to tools/makeTestCases.tcl.








1
2
3
4
5
6
7
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
+
+
+
+
+
+
+
+







#! /usr/bin/env tclsh

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# TODO - When integrating this with the Core, path names will need to be
# swizzled here.

package require msgcat
set d [file dirname [file dirname [info script]]]
puts "getting transition data from [file join $d library tzdata America Detroit]"
source -encoding utf-8 [file join $d library/tzdata/America/Detroit]
Changes to tools/mkVfs.tcl.







1
2
3
4
5
6
7
1
2
3
4
5
6
7
8
9
10
11
12
13
14
+
+
+
+
+
+
+







# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

proc cat fname {
    set fname [open $fname r]
    set data [read $fname]
    close $fname
    return $data
}

Changes to tools/mkdepend.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
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

-
-
-


















+






+
+
+
+
+
+
+
+
+







#==============================================================================
#
# mkdepend : generate dependency information from C/C++ files
#
# Copyright © 1998, Nat Pryce
#
# Permission is hereby granted, without written agreement and without
# license or royalty fees, to use, copy, modify, and distribute this
# software and its documentation for any purpose, provided that the
# above copyright notice and the following two paragraphs appear in
# all copies of this software.
#
# IN NO EVENT SHALL THE AUTHOR BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT,
# SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF
# THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE AUTHOR HAS BEEN ADVISED
# OF THE POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHOR SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
# PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS"
# BASIS, AND THE AUTHOR HAS NO OBLIGATION TO PROVIDE  MAINTENANCE, SUPPORT,
# UPDATES, ENHANCEMENTS, OR MODIFICATIONS.

#==============================================================================
#
# Modified heavily by David Gravereaux <davygrvy@pobox.com> about 9/17/2006.
# Original can be found @
#	http://web.archive.org/web/20070616205924/http://www.doc.ic.ac.uk/~np2/software/mkdepend.html
#==============================================================================

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# mkdepend : generate dependency information from C/C++ files

array set mode_data {}
set mode_data(vc32) {cl -nologo -E}

set source_extensions [list .c .cpp .cxx .cc]

set excludes [list]
Changes to tools/regexpTestLib.tcl.









1
2
3
4
5
6
7
8
9
10
11
12
13
14
1
2
3
4
5
6
7
8
9
10
11
12
13
14


15
16
17
18
19
20
21
+
+
+
+
+
+
+
+
+





-
-







# Copyright © 1996 Sun Microsystems, Inc.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# regexpTestLib.tcl --
#
# This file contains tcl procedures used by spencer2testregexp.tcl and
# spencer2regexp.tcl, which are programs written to convert Henry
# Spencer's test suite to tcl test files.
#
# Copyright © 1996 Sun Microsystems, Inc.

proc readInputFile {} {
    global inFileName
    global lineArray

    set fileId [open $inFileName r]

Changes to tools/tclOOScript.tcl.
1
2
3
4
5
6
7
8
9
10
11
12













13
14
15
16
17
18
19






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
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







# tclOOScript.h --
#
#	This file contains support scripts for TclOO. They are defined here so
#	that the code can be definitely run even in safe interpreters; TclOO's
#	core setup is safe.
#
# Copyright © 2012-2019 Donal K. Fellows
# Copyright © 2013 Andreas Kupries
# Copyright © 2017 Gerald Lester
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# tclOOScript.h --
#
#   This file contains support scripts for TclOO. They are defined here so
#   that the code can be definitely run even in safe interpreters; TclOO's
#   core setup is safe.

::namespace eval ::oo {
    ::namespace path {}

    #
    # Commands that are made available to objects by default.
    #
Changes to tools/tclZIC.tcl.











1
2
3
4
5
6
7
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
+
+
+
+
+
+
+
+
+
+
+







# Copyright © 2004 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.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#----------------------------------------------------------------------
#
# tclZIC.tcl --
#
#	Take the time zone data source files from Arthur Olson's
#	repository at https://www.iana.org/time-zones, and prepare time zone
#	information files for Tcl.
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
30
31
32
33
34
35
36





37
38
39
40
41
42
43







-
-
-
-
-







#	May produce error messages on the standard error.  An exit
#	code of zero denotes success; any other exit code is failure.
#
# This program parses the timezone data in a means analogous to the
# 'zic' command, and produces Tcl time zone information files suitable
# for loading into the 'clock' namespace.
#
#----------------------------------------------------------------------
#
# Copyright © 2004 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.
#----------------------------------------------------------------------

# Define the names of the Olson files that we need to load.
# We avoid the solar time files and the leap seconds.

set olsonFiles {
    africa antarctica asia australasia
Changes to tools/tcltk-man2html-utils.tcl.


1
2
3
4











5
6
7
8
9
10
11
12
13
14
1
2




3
4
5
6
7
8
9
10
11
12
13



14
15
16
17
18
19
20
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-







# Copyright © 1995-1997 Roger E. Critchlow Jr
# Copyright © 2004-2011 Donal K. Fellows
##
## Utility functions for Man->HTML converter. Note that these
## functions are specifically intended to work with the format as used
## by Tcl and Tk; they do not cope with arbitrary nroff markup.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Utility functions for Man->HTML converter. Note that these
# functions are specifically intended to work with the format as used
# by Tcl and Tk; they do not cope with arbitrary nroff markup.
##
## Copyright © 1995-1997 Roger E. Critchlow Jr
## Copyright © 2004-2011 Donal K. Fellows

set ::manual(report-level) 1

proc manerror {msg} {
    global manual
    set name {}
    set subj {}
Changes to tools/tcltk-man2html.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
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


+
+
+
+
+
+
+
+
+
+


















-
-
-







#!/usr/bin/env tclsh

# Copyright © 1995-1997 Roger E. Critchlow Jr
# Copyright © 2004-2010 Donal K. Fellows

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[catch {package require Tcl 8.6-} msg]} {
    puts stderr "ERROR: $msg"
    puts stderr "If running this script from 'make html', set the\
	NATIVE_TCLSH environment\nvariable to point to an installed\
	tclsh8.6 (or the equivalent tclsh86.exe\non Windows)."
    exit 1
}

# Convert Ousterhout format man pages into highly crosslinked hypertext.
#
# Along the way detect many unmatched font changes and other odd things.
#
# Note well, this program is a hack rather than a piece of software
# engineering.  In that sense it's probably a good example of things
# that a scripting language, like Tcl, can do well.  It is offered as
# an example of how someone might convert a specific set of man pages
# into hypertext, not as a general solution to the problem.  If you
# try to use this, you'll be very much on your own.
#
# Copyright © 1995-1997 Roger E. Critchlow Jr
# Copyright © 2004-2010 Donal K. Fellows

set ::Version "50/9.0"
set ::CSSFILE "docs.css"

##
## Source the utility functions that provide most of the
## implementation of the transformation from nroff to html.
Changes to tools/tsdPerf.c.









1
2
3
4
5
6
7
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
+
+
+
+
+
+
+
+
+







/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include <tcl.h>

extern DLLEXPORT Tcl_LibraryInitProc Tsdperf_Init;

static Tcl_ThreadDataKey key;

typedef struct {
Changes to tools/tsdPerf.tcl.








1
2
3
4
5
6
7
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
+
+
+
+
+
+
+
+







#! /usr/bin/env tclsh

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Thread

set ::tids [list]
for {set i 0} {$i < 4} {incr i} {
    lappend ::tids [thread::create [string map [list IVALUE $i] {
	set curdir [file dirname [info script]]
Changes to tools/uniClass.tcl.
1
2
3
4
5









6
7
8
9
10
11
12
13
14
15
16
17
18
19
20





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

17
18
19
20
21
22
23
-
-
-
-
-
+
+
+
+
+
+
+
+
+







-







#!/bin/sh
# The next line is executed by /bin/sh, but not tcl \
exec tclsh "$0" ${1+"$@"}

#
#! /usr/bin/env tclsh

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# uniClass.tcl --
#
#	Generates the character ranges and singletons that are used in
#	generic/regc_locale.c for translation of character classes.
#	This file must be generated using a tclsh that contains the
#	correct corresponding tclUniData.c file (generated by uniParse.tcl)
#	in order for the class ranges to match.
#

proc emitRange {first last} {
    global ranges numranges chars numchars extchars extranges

    if {$first < ($last-1)} {
	if {!$extranges && ($first) > 0xFFFF} {
	    set extranges 1
Changes to tools/uniParse.tcl.












1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
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
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-







#! /usr/bin/env tclsh

# Copyright © 1998-1999 Scriptics Corporation.
# All rights reserved.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# uniParse.tcl --
#
#	This program parses the UnicodeData file and generates the
#	corresponding tclUniData.c file with compressed character
#	data tables.  The input to this program should be the latest
#	UnicodeData file from:
#	    ftp://ftp.unicode.org/Public/UNIDATA/UnicodeData.txt
#
# Copyright © 1998-1999 Scriptics Corporation.
# All rights reserved.


namespace eval uni {
    set shift 5;		# number of bits of data within a page
				# This value can be adjusted to find the
				# best split to minimize table size

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
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







-












-
















-














-







    set last [expr {[llength $pMap] - 1}]
    for {set i 0} {$i <= $last} {incr i} {
	if {$i == [expr {0x10000 >> $shift}]} {
	    set line [string trimright $line " \t,"]
	    puts $f $line
	    set lastpage [expr {[lindex $line end] >> $shift}]
	    puts stdout "lastpage: $lastpage"
	    puts $f "#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6"
	    set line "    ,"
	}
	append line [lindex $pMap $i]
	if {$i != $last} {
	    append line ", "
	}
	if {[string length $line] > 70} {
	    puts $f [string trimright $line]
	    set line "    "
	}
    }
    puts $f $line
    puts $f "#endif /* TCL_UTF_MAX > 3 */"
    puts $f "};

/*
 * The groupMap is indexed by combining the alternate page number with
 * the page offset and returns a group number that identifies a unique
 * set of character attributes.
 */

static const unsigned char groupMap\[\] = {"
    set line "    "
    set lasti [expr {[llength $pages] - 1}]
    for {set i 0} {$i <= $lasti} {incr i} {
	set page [lindex $pages $i]
	set lastj [expr {[llength $page] - 1}]
	if {$i == ($lastpage + 1)} {
	    puts $f [string trimright $line " \t,"]
	    puts $f "#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6"
	    set line "    ,"
	}
	for {set j 0} {$j <= $lastj} {incr j} {
	    append line [lindex $page $j]
	    if {$j != $lastj || $i != $lasti} {
		append line ", "
	    }
	    if {[string length $line] > 70} {
		puts $f [string trimright $line]
		set line "    "
	    }
	}
    }
    puts $f $line
    puts $f "#endif /* TCL_UTF_MAX > 3 */"
    puts $f "};

/*
 * Each group represents a unique set of character attributes.  The attributes
 * are encoded into a 32-bit value as follows:
 *
 * Bits 0-4	Character category: see the constants listed below.
338
339
340
341
342
343
344
345
346

347
348
349
350
351
352
353
354
355
356
343
344
345
346
347
348
349


350



351
352
353
354
355
356
357







-
-
+
-
-
-







	    puts $f [string trimright $line]
	    set line "    "
	}
    }
    puts $f $line
    puts -nonewline $f "};

#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
#   define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= [format 0x%X $next])
#define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= [format 0x%X $next])
#else
#   define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1F0000) != 0)
#endif

/*
 * The following constants are used to determine the category of a
 * Unicode character.
 */

enum {
397
398
399
400
401
402
403
404
405

406
407
408
409
410
411
412
413
414
415
416
398
399
400
401
402
403
404


405



406
407
408
409
410
411
412
413







-
-
+
-
-
-








#define GetDelta(info) ((info) >> 8)

/*
 * This macro extracts the information about a character from the
 * Unicode character tables.
 */

#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
#   define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0x1FFFFF) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\])
#define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0x1FFFFF) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\])
#else
#   define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0xFFFF) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\])
#endif
"

    close $f
}

uni::main

return
Changes to tools/valgrind_check_success.
1
2








3
4
5
6
7
8
9
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17


+
+
+
+
+
+
+
+







#! /usr/bin/env tclsh

# Copyright © 2021 Nathan Coulter

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

proc main {sourcetype source} {
	switch $sourcetype {
		file {
			set chan [open $source]
			try {
				set data [read $chan]
Changes to unix/Makefile.in.



1



2
3
4
5
6
7
8
1
2
3
4
5
6
7
8
9
10
11
12
13
14
+
+
+

+
+
+







# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file is a Makefile for Tcl. If it has the name "Makefile.in" then it is
# a template for a Makefile; to generate the actual Makefile, run
# "./configure", which is a configuration script generated by the "autoconf"
# program (constructs like "@foo@" will get replaced in the actual Makefile.

VERSION			= @TCL_VERSION@
MAJOR_VERSION		= @TCL_MAJOR_VERSION@
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
138
139
140
141
142
143
144





145
146
147
148
149
150
151







-
-
-
-
-








# Generic stub lib name used in rules that apply to tcl and tk
STUB_LIB_FILE		= ${TCL_STUB_LIB_FILE}

TCL_STUB_LIB_FLAG	= @TCL_STUB_LIB_FLAG@
#TCL_STUB_LIB_FLAG	= -ltclstub

# To compile without backward compatibility and deprecated code uncomment the
# following
NO_DEPRECATED_FLAGS	=
#NO_DEPRECATED_FLAGS	= -DTCL_NO_DEPRECATED

# Some versions of make, like SGI's, use the following variable to determine
# which shell to use for executing commands:
SHELL			= @MAKEFILE_SHELL@

# Tcl used to let the configure script choose which program to use for
# installing, but there are just too many different versions of "install"
# around; better to use the install-sh script that comes with the
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
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







-
+
+

-
-
-
+
+
+
+



+
-
+

-
-
+
+






-
-
+
+

-
+








DEPEND_SWITCHES	= ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \
	${AC_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@

TCLSH_OBJS = tclAppInit.o

TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
	tclThreadTest.o tclUnixTest.o tclTestABSList.o
	tclThreadTest.o tclUnixTest.o tclTestObjInterface.o \
	tclTestObjInterfaceInteger.o tclTestABSList.o

XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
	tclThreadTest.o tclUnixTest.o tclXtNotify.o tclXtTest.o \
	tclTestABSList.o
XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestObjInterface.o \
	tclTestObjInterfaceInteger.o tclTestABSList.o\
	tclTestProcBodyObj.o tclThreadTest.o tclUnixTest.o tclXtNotify.o \
	tclXtTest.o

GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
	tclArithSeries.o tclAssembly.o tclAsync.o tclBasic.o tclBinary.o \
	tclCkalloc.o tclClock.o tclClockClassic.o tclClockFmt.o tclCmdAH.o \
	tclCkalloc.o tclClock.o tclClockFmt.o tclCmdAH.o tclCmdIL.o tclCmdMZ.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 \
	tclCompile.o tclConfig.o tclDate.o tclDateClassic.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 \
	tclIcu.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 \
	tclObj.o tclObjInterface.o tclOptimize.o tclPanic.o tclParse.o \
	tclPathObj.o tclPipe.o tclPkg.o tclPkgConfig.o tclPosixStr.o \
	tclPreserve.o tclProc.o tclProcess.o tclRegexp.o \
	tclResolve.o tclResult.o tclScan.o tclStringObj.o tclStrIdxTree.o \
	tclResolve.o tclResult.o tclScan.o tclStrIdxTree.o tclStringObj.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 tclZipfs.o

OO_OBJS = tclOO.o tclOOBasic.o tclOOCall.o tclOODefineCmds.o tclOOInfo.o \
	tclOOMethod.o tclOOProp.o tclOOStubInit.o
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
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







+











+







	$(GENERIC_DIR)/tclArithSeries.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)/tclClockClassic.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 \
	$(GENERIC_DIR)/tclCompile.c \
	$(GENERIC_DIR)/tclConfig.c \
	$(GENERIC_DIR)/tclDate.c \
	$(GENERIC_DIR)/tclDateClassic.c \
	$(GENERIC_DIR)/tclDictObj.c \
	$(GENERIC_DIR)/tclDisassemble.c \
	$(GENERIC_DIR)/tclEncoding.c \
	$(GENERIC_DIR)/tclEnsemble.c \
	$(GENERIC_DIR)/tclEnv.c \
	$(GENERIC_DIR)/tclEvent.c \
	$(GENERIC_DIR)/tclExecute.c \
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
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







+















-
-
+
+




+
+







	$(GENERIC_DIR)/tclListObj.c \
	$(GENERIC_DIR)/tclLiteral.c \
	$(GENERIC_DIR)/tclLoad.c \
	$(GENERIC_DIR)/tclMain.c \
	$(GENERIC_DIR)/tclNamesp.c \
	$(GENERIC_DIR)/tclNotify.c \
	$(GENERIC_DIR)/tclObj.c \
	$(GENERIC_DIR)/tclObjInterface.c \
	$(GENERIC_DIR)/tclOptimize.c \
	$(GENERIC_DIR)/tclParse.c \
	$(GENERIC_DIR)/tclPathObj.c \
	$(GENERIC_DIR)/tclPipe.c \
	$(GENERIC_DIR)/tclPkg.c \
	$(GENERIC_DIR)/tclPkgConfig.c \
	$(GENERIC_DIR)/tclPosixStr.c \
	$(GENERIC_DIR)/tclPreserve.c \
	$(GENERIC_DIR)/tclProc.c \
	$(GENERIC_DIR)/tclProcess.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)/tclStrIdxTree.c \
	$(GENERIC_DIR)/tclStringObj.c \
	$(GENERIC_DIR)/tclStrToD.c \
	$(GENERIC_DIR)/tclTest.c \
	$(GENERIC_DIR)/tclTestABSList.c \
	$(GENERIC_DIR)/tclTestObj.c \
	$(GENERIC_DIR)/tclTestObjInterface.c \
	$(GENERIC_DIR)/tclTestObjInterfaceInteger \
	$(GENERIC_DIR)/tclTestProcBodyObj.c \
	$(GENERIC_DIR)/tclThread.c \
	$(GENERIC_DIR)/tclThreadAlloc.c \
	$(GENERIC_DIR)/tclThreadJoin.c \
	$(GENERIC_DIR)/tclThreadStorage.c \
	$(GENERIC_DIR)/tclTimer.c \
	$(GENERIC_DIR)/tclTrace.c \
956
957
958
959
960
961
962



963
964
965
966
967
968
969
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981







+
+
+







shell: ${TCL_EXE}
	$(SHELL_ENV) ./${TCL_EXE} $(SCRIPT)

# This target can be used to run tclsh inside either gdb or insight
gdb: ${TCL_EXE}
	$(SHELL_ENV) $(GDB) ./${TCL_EXE}

gdb-script: ${TCLTEST_EXE}
	$(SHELL_ENV) $(GDB) --args $(SCRIPT)

lldb: ${TCL_EXE}
	$(SHELL_ENV) $(LLDB) ./${TCL_EXE}

valgrind: ${TCL_EXE} ${TCLTEST_EXE}
	$(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCLTEST_EXE} \
		$(TOP_DIR)/tests/all.tcl -singleproc 1 -constraints valgrind \
		$(TESTFLAGS)
1264
1265
1266
1267
1268
1269
1270

1271
1272
1273
1274
1275
1276
1277
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290







+







MATHHDRS	= $(GENERIC_DIR)/tclTomMath.h $(GENERIC_DIR)/tclTomMathDecls.h
PARSEHDR	= $(GENERIC_DIR)/tclParse.h
NREHDR		= $(GENERIC_DIR)/tclInt.h
TRIMHDR		= $(GENERIC_DIR)/tclStringTrim.h

TCL_LOCATIONS	= -DTCL_LIBRARY="\"${TCL_LIBRARY}\"" \
	-DTCL_PACKAGE_PATH="\"${TCL_PACKAGE_PATH}\""

TCLDATEHDR=$(GENERIC_DIR)/tclDate.h $(GENERIC_DIR)/tclStrIdxTree.h

regcomp.o: $(REGHDRS) $(GENERIC_DIR)/regcomp.c $(GENERIC_DIR)/regc_lex.c \
		$(GENERIC_DIR)/regc_color.c $(GENERIC_DIR)/regc_locale.c \
		$(GENERIC_DIR)/regc_nfa.c $(GENERIC_DIR)/regc_cvec.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regcomp.c

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
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







+
+
+















+
+
+








tclCkalloc.o: $(GENERIC_DIR)/tclCkalloc.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCkalloc.c

tclClock.o: $(GENERIC_DIR)/tclClock.c $(TCLDATEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclClock.c

tclClockClassic.o: $(GENERIC_DIR)/tclClockClassic.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclClockClassic.c

tclClockFmt.o: $(GENERIC_DIR)/tclClockFmt.c $(TCLDATEHDR)
	$(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)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdMZ.c

tclDate.o: $(GENERIC_DIR)/tclDate.c $(TCLDATEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclDate.c

tclDateClassic.o: $(GENERIC_DIR)/tclDateClassic.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclDateClassic.c

tclCompCmds.o: $(GENERIC_DIR)/tclCompCmds.c $(COMPILEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompCmds.c

tclCompCmdsGR.o: $(GENERIC_DIR)/tclCompCmdsGR.c $(COMPILEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompCmdsGR.c

tclCompCmdsSZ.o: $(GENERIC_DIR)/tclCompCmdsSZ.c $(COMPILEHDR) $(TRIMHDR)
1417
1418
1419
1420
1421
1422
1423



1424
1425
1426
1427
1428
1429
1430
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452







+
+
+







	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclListObj.c

tclLiteral.o: $(GENERIC_DIR)/tclLiteral.c $(COMPILEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLiteral.c

tclObj.o: $(GENERIC_DIR)/tclObj.c $(COMPILEHDR) $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclObj.c

tclObjInterface.o: $(GENERIC_DIR)/tclObjInterface.c $(COMPILEHDR) $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclObjInterface.c

tclOptimize.o: $(GENERIC_DIR)/tclOptimize.c $(COMPILEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOptimize.c

tclLoad.o: $(GENERIC_DIR)/tclLoad.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLoad.c

1542
1543
1544
1545
1546
1547
1548



1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577



1578
1579
1580
1581
1582
1583
1584







+
+
+




-
-
-







	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclResolve.c

tclResult.o: $(GENERIC_DIR)/tclResult.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclResult.c

tclScan.o: $(GENERIC_DIR)/tclScan.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclScan.c

tclStrIdxTree.o: $(GENERIC_DIR)/tclStrIdxTree.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStrIdxTree.c

tclStringObj.o: $(GENERIC_DIR)/tclStringObj.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStringObj.c

tclStrIdxTree.o: $(GENERIC_DIR)/tclStrIdxTree.c $(GENERIC_DIR)/tclStrIdxTree.h $(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

tclTrace.o: $(GENERIC_DIR)/tclTrace.c
1586
1587
1588
1589
1590
1591
1592







1593
1594
1595
1596
1597
1598
1599
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628







+
+
+
+
+
+
+








tclTestABSList.o: $(GENERIC_DIR)/tclTestABSList.c $(MATHHDRS)
	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestABSList.c

tclTestObj.o: $(GENERIC_DIR)/tclTestObj.c $(MATHHDRS)
	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestObj.c

tclTestObjInterface.o: $(GENERIC_DIR)/tclTestObjInterface.c $(MATHHDRS)
	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestObjInterface.c

tclTestObjInterfaceInteger.o: $(GENERIC_DIR)/tclTestObjInterfaceInteger.c \
	$(MATHHDRS)
	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestObjInterfaceInteger.c

tclTestProcBodyObj.o: $(GENERIC_DIR)/tclTestProcBodyObj.c
	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestProcBodyObj.c

tclTimer.o: $(GENERIC_DIR)/tclTimer.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTimer.c

tclThread.o: $(GENERIC_DIR)/tclThread.c
2181
2182
2183
2184
2185
2186
2187


















2188
2189
2190
2191
2192
2193
2194
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







#	    -e '/TclDatenewstate:/d' -e '/#pragma/d' \
#	    -e '/#include <inttypes.h>/d' \
#           -e '/#define YYNEW/s/malloc/TclDateAlloc/g' \
#	    -e '/#define YYENLARGE/,/realloc/s/realloc/TclDateRealloc/g' \
#	    <y.tab.c >$(GENERIC_DIR)/tclDate.c
#	rm y.tab.c

# Remark: see [54a305cb88]. tclDateClassic.c is manually edited, removing the unused "yynerrs" variable
gendateclassic:
	bison --output-file=$(GENERIC_DIR)/tclDateClassic.c \
		--no-lines \
		--name-prefix=TclDateClassic \
		$(GENERIC_DIR)/tclGetDateClassic.y

#	yacc -l $(GENERIC_DIR)/tclGetDateClassic.y
#	sed -e 's/yy/TclDate/g' -e '/^#include <values.h>/d' \
#	    -e 's?SCCSID?RCS: @(#) ?' \
#	    -e '/#ifdef __STDC__/,/#endif/d' -e '/TclDateerrlab:/d' \
#	    -e '/TclDatenewstate:/d' -e '/#pragma/d' \
#	    -e '/#include <inttypes.h>/d' \
#           -e '/#define YYNEW/s/malloc/TclDateClassicAlloc/g' \
#	    -e '/#define YYENLARGE/,/realloc/s/realloc/TclDateClassicRealloc/g' \
#	    <y.tab.c >$(GENERIC_DIR)/tclDateClassic.c
#	rm y.tab.c

#
# Target to regenerate header files and stub files from the *.decls tables.
#

$(GENERIC_DIR)/tclStubInit.c: $(GENERIC_DIR)/tcl.decls \
		$(GENERIC_DIR)/tclInt.decls $(GENERIC_DIR)/tclTomMath.decls
	@echo "Warning: tclStubInit.c may be out of date."
2344
2345
2346
2347
2348
2349
2350

2351
2352
2353
2354
2355
2356
2357
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405







+







		$(UNIX_DIR)/tcl.pc.in $(DISTDIR)/unix
	$(DIST_INSTALL_SCRIPT) $(UNIX_DIR)/configure $(UNIX_DIR)/ldAix $(DISTDIR)/unix
	$(INSTALL_DATA_DIR) $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.decls $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/README $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/tclGetDateClassic.y $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(TOP_DIR)/changes.md $(TOP_DIR)/README.md \
		$(TOP_DIR)/license.terms $(DISTDIR)
	$(INSTALL_DATA_DIR) $(DISTDIR)/library
	$(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
		$(TOP_DIR)/library/manifest.txt \
		$(TOP_DIR)/library/tclIndex $(DISTDIR)/library
	@for i in $(BUILTIN_PACKAGE_LIST); do \
Deleted unix/configure.

more than 10,000 changes

Changes to unix/configure.ac.
1








2
3
4
5
6
7
8
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

+
+
+
+
+
+
+
+







#! /bin/bash -norc

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

dnl	This file is an input file used by the GNU "autoconf" program to
dnl	generate the file "configure", which is run during Tcl installation
dnl	to configure the system for the local environment.

AC_INIT([tcl],[9.0])
AC_PREREQ([2.69])

Changes to unix/dltest/Makefile.in.
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
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







-
+









-
+





-
+




















-
-
-
-
-
-
-
-
-
-
-
-







DLTEST_SUFFIX =		@DLTEST_SUFFIX@
SRC_DIR =		@TCL_SRC_DIR@/unix/dltest
BUILD_DIR =		@builddir@
TCL_VERSION=		@TCL_VERSION@

CFLAGS_DEBUG		= @CFLAGS_DEBUG@
CFLAGS_OPTIMIZE		= @CFLAGS_OPTIMIZE@
CFLAGS			= @CFLAGS_DEFAULT@ @CFLAGS@ -DTCL_NO_DEPRECATED=1 -Wall -Wextra -Wc++-compat -Wconversion -Werror
CFLAGS			= @CFLAGS_DEFAULT@ @CFLAGS@ -Wall -Wextra -Wc++-compat -Wconversion -Werror
LDFLAGS_DEBUG		= @LDFLAGS_DEBUG@
LDFLAGS_OPTIMIZE	= @LDFLAGS_OPTIMIZE@
LDFLAGS			= @LDFLAGS_DEFAULT@ @LDFLAGS@

CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic \
	${SHLIB_CFLAGS} -DUSE_TCL_STUBS ${AC_FLAGS}

all: embtest tcl9pkga${SHLIB_SUFFIX} tcl9pkgb${SHLIB_SUFFIX} tcl9pkgc${SHLIB_SUFFIX} \
	tcl9pkgd${SHLIB_SUFFIX} tcl9pkge${SHLIB_SUFFIX} tcl9pkgt${SHLIB_SUFFIX} tcl9pkgua${SHLIB_SUFFIX} \
	tcl9pkgooa${SHLIB_SUFFIX} pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX}  pkgt${SHLIB_SUFFIX}
	tcl9pkgooa${SHLIB_SUFFIX}
	@if test -n "$(DLTEST_SUFFIX)"; then $(MAKE) dltest_suffix; fi
	@touch ../dltest.marker

dltest_suffix: tcl9pkga${DLTEST_SUFFIX} tcl9pkgb${DLTEST_SUFFIX} tcl9pkgc${DLTEST_SUFFIX} \
	tcl9pkgd${DLTEST_SUFFIX} tcl9pkge${DLTEST_SUFFIX} tcl9pkgt${DLTEST_SUFFIX} tcl9pkgua${DLTEST_SUFFIX} \
	tcl9pkgooa${DLTEST_SUFFIX} pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX} pkgt${DLTEST_SUFFIX}
	tcl9pkgooa${DLTEST_SUFFIX}
	@touch ../dltest.marker

embtest.o: $(SRC_DIR)/embtest.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/embtest.c

pkgπ.o: $(SRC_DIR)/pkgπ.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgπ.c

pkga.o: $(SRC_DIR)/pkga.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkga.c

pkgb.o: $(SRC_DIR)/pkgb.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgb.c

pkgc.o: $(SRC_DIR)/pkgc.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgc.c

pkgt.o: $(SRC_DIR)/pkgt.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgt.c

tcl8pkga.o: $(SRC_DIR)/pkga.c
	$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkga.c

tcl8pkgb.o: $(SRC_DIR)/pkgb.c
	$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkgb.c

tcl8pkgc.o: $(SRC_DIR)/pkgc.c
	$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkgc.c

tcl8pkgt.o: $(SRC_DIR)/pkgt.c
	$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkgt.c

pkgd.o: $(SRC_DIR)/pkgd.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgd.c

pkge.o: $(SRC_DIR)/pkge.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkge.c

pkgua.o: $(SRC_DIR)/pkgua.c
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
80
81
82
83
84
85
86












87
88
89
90
91
92
93







-
-
-
-
-
-
-
-
-
-
-
-








tcl9pkgc${SHLIB_SUFFIX}: pkgc.o
	${SHLIB_LD} -o $@ pkgc.o ${SHLIB_LD_LIBS}

tcl9pkgt${SHLIB_SUFFIX}: pkgt.o
	${SHLIB_LD} -o $@ pkgt.o ${SHLIB_LD_LIBS}

pkga${SHLIB_SUFFIX}: tcl8pkga.o
	${SHLIB_LD} -o $@ tcl8pkga.o ${SHLIB_LD_LIBS}

pkgb${SHLIB_SUFFIX}: tcl8pkgb.o
	${SHLIB_LD} -o $@ tcl8pkgb.o ${SHLIB_LD_LIBS}

pkgc${SHLIB_SUFFIX}: tcl8pkgc.o
	${SHLIB_LD} -o $@ tcl8pkgc.o ${SHLIB_LD_LIBS}

pkgt${SHLIB_SUFFIX}: tcl8pkgt.o
	${SHLIB_LD} -o $@ tcl8pkgt.o ${SHLIB_LD_LIBS}

tcl9pkgd${SHLIB_SUFFIX}: pkgd.o
	${SHLIB_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS}

tcl9pkge${SHLIB_SUFFIX}: pkge.o
	${SHLIB_LD} -o $@ pkge.o ${SHLIB_LD_LIBS}

tcl9pkgua${SHLIB_SUFFIX}: pkgua.o
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
107
108
109
110
111
112
113












114
115
116
117
118
119
120







-
-
-
-
-
-
-
-
-
-
-
-








tcl9pkgc${DLTEST_SUFFIX}: pkgc.o
	${DLTEST_LD} -o $@ pkgc.o ${SHLIB_LD_LIBS}

tcl9pkgt${DLTEST_SUFFIX}: pkgt.o
	${DLTEST_LD} -o $@ pkgt.o ${SHLIB_LD_LIBS}

pkga${DLTEST_SUFFIX}: tcl8pkga.o
	${DLTEST_LD} -o $@ tcl8pkga.o ${SHLIB_LD_LIBS}

pkgb${DLTEST_SUFFIX}: tcl8pkgb.o
	${DLTEST_LD} -o $@ tcl8pkgb.o ${SHLIB_LD_LIBS}

pkgc${DLTEST_SUFFIX}: tcl8pkgc.o
	${DLTEST_LD} -o $@ tcl8pkgc.o ${SHLIB_LD_LIBS}

pkgt${DLTEST_SUFFIX}: tcl8pkgt.o
	${DLTEST_LD} -o $@ tcl8pkgt.o ${SHLIB_LD_LIBS}

tcl9pkgd${DLTEST_SUFFIX}: pkgd.o
	${DLTEST_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS}

tcl9pkge${DLTEST_SUFFIX}: pkge.o
	${DLTEST_LD} -o $@ pkge.o ${SHLIB_LD_LIBS}

tcl9pkgua${DLTEST_SUFFIX}: pkgua.o
Changes to unix/installManPage.
1







2
3
4
5
6
7
8
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

+
+
+
+
+
+
+







#!/bin/sh

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

########################################################################
### Parse Options
###

Gzip=:
Sym=""
Changes to unix/ldAix.
1
2








3
4
5
6
7
8
9
1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

-
+
+
+
+
+
+
+
+







#!/bin/sh
#

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# ldAix ldCmd ldArg ldArg ...
#
# This shell script provides a wrapper for ld under AIX in order to
# create the .exp file required for linking.  Its arguments consist
# of the name and arguments that would normally be provided to the
# ld command.  This script extracts the names of the object files
# from the argument list, creates a .exp file describing all of the
Changes to unix/tcl.m4.







1
2
3
4
5
6
7
1
2
3
4
5
6
7
8
9
10
11
12
13
14
+
+
+
+
+
+
+







# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#------------------------------------------------------------------------
# SC_PATH_TCLCONFIG --
#
#	Locate the tclConfig.sh file and perform a sanity check on
#	the Tcl compile flags
#
# Arguments:
Changes to unix/tcl.spec.
1
2
3
4
5
6


7
8
9

10
11

12
13
14
15
16

17
18
19
20
21
22
23
1
2
3
4


5
6
7
8

9
10

11
12
13
14
15

16
17
18
19
20
21
22
23




-
-
+
+


-
+

-
+




-
+







# This file is the basis for a binary Tcl RPM for Linux.

%{!?directory:%define directory /usr/local}

Name:          tcl
Summary:       Tcl scripting language development environment
Name:          tclunchained
Summary:       TclUnchained scripting language development environment
Version:       9.0b4
Release:       2
License:       BSD
License:       GNU Affero General Public License
Group:         Development/Languages
Source:        http://prdownloads.sourceforge.net/tcl/tcl%{version}-src.tar.gz
Source:        http://prdownloads.sourceforge.net/tcl/tclunchained%{version}-src.tar.gz
URL:           https://www.tcl-lang.org/
Buildroot:     /var/tmp/%{name}%{version}

%description
The Tcl (Tool Command Language) provides a powerful platform for
Tcl (Tool Command Language) Unchained provides a powerful platform for
creating integration applications that tie together diverse
applications, protocols, devices, and frameworks.  When paired with
the Tk toolkit, Tcl provides the fastest and most powerful way to
create GUI applications that run on PCs, Unix, and Mac OS X.  Tcl
can also be used for a variety of web-related tasks and for creating
powerful command languages for applications.

Changes to unix/tclAppInit.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
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

-
-
-
-
-








-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+







-
+







/*
 * tclAppInit.c --
 *
 *	Provides a default version of the main program and Tcl_AppInit
 *	procedure for tclsh and other Tcl-based applications (without Tk).
 *
 * Copyright (c) 1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tcl.h"
#if TCL_MAJOR_VERSION < 9
#  if defined(USE_TCL_STUBS)
#	error "Don't build with USE_TCL_STUBS!"
#  endif
#  if TCL_MINOR_VERSION < 7
#   define Tcl_LibraryInitProc Tcl_PackageInitProc
#   define Tcl_StaticLibrary Tcl_StaticPackage
/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclAppInit.c --
 *
 *	Provides a default version of the main program and Tcl_AppInit
 *	procedure for tclsh and other Tcl-based applications (without Tk).
 */

#  endif
#endif
#include "tcl.h"

#ifdef TCL_TEST
extern Tcl_LibraryInitProc Tcltest_Init;
extern Tcl_LibraryInitProc Tcltest_SafeInit;
#endif /* TCL_TEST */

#ifdef TCL_XT_TEST
extern void                XtToolkitInitialize(void);
extern void		XtToolkitInitialize(void);
extern Tcl_LibraryInitProc Tclxttest_Init;
#endif /* TCL_XT_TEST */

/*
 * The following #if block allows you to change the AppInit function by using
 * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The
 * #if checks for that #define and uses Tcl_AppInit if it does not exist.
82
83
84
85
86
87
88
89

90
91
92
93
94
95
96
84
85
86
87
88
89
90

91
92
93
94
95
96
97
98







-
+







{
#ifdef TCL_XT_TEST
    XtToolkitInitialize();
#endif

#ifdef TCL_LOCAL_MAIN_HOOK
    TCL_LOCAL_MAIN_HOOK(&argc, &argv);
#elif (TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6) && (!defined(_WIN32) || defined(UNICODE))
#elif !defined(_WIN32) || defined(UNICODE)
    /* New in Tcl 8.7. This doesn't work on Windows without UNICODE */
    TclZipfs_AppHook(&argc, &argv);
#endif

    Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
    return 0;			/* Needed only to prevent compiler warning. */
}
Changes to unix/tclEpollNotfy.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14

















15
16
17
18
19
20
21
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

-
-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclEpollNotfy.c --
 *
 *	This file contains the implementation of the epoll()-based
 *	Linux-specific notifier, which is the lowest-level part of the Tcl
 *	event loop. This file works together with generic/tclNotify.c.
 *
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 * Copyright © 2016 Lucio Andrés Illanes Albornoz <l.illanes@gmx.de>
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclEpollNotfy.c --
 *
 *	This file contains the implementation of the epoll()-based
 *	Linux-specific notifier, which is the lowest-level part of the Tcl
 *	event loop. This file works together with generic/tclNotify.c.
 */

#include "tclInt.h"
#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */
#if defined(NOTIFIER_EPOLL) && TCL_THREADS
#ifndef _GNU_SOURCE
#   define _GNU_SOURCE		/* For pipe2(2) */
#endif
38
39
40
41
42
43
44
45

46
47
48
49
50
51
52
49
50
51
52
53
54
55

56
57
58
59
60
61
62
63







-
+







    int mask;			/* Mask of desired events: TCL_READABLE,
				 * etc. */
    int readyMask;		/* Mask of events that have been seen since
				 * the last time file handlers were invoked
				 * for this file. */
    Tcl_FileProc *proc;		/* Function to call, in the style of
				 * Tcl_CreateFileHandler. */
    void *clientData;	/* Argument to pass to proc. */
    void *clientData;		/* Argument to pass to proc. */
    struct FileHandler *nextPtr;/* Next in list of all files we care about. */
    LIST_ENTRY(FileHandler) readyNode;
				/* Next/previous in list of FileHandlers asso-
				 * ciated with regular files (S_IFREG) that are
				 * ready for I/O. */
    struct PlatformEventData *pedPtr;
				/* Pointer to PlatformEventData associating this
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+







     */

    if (TclOSfstat(filePtr->fd, &fdStat) == -1) {
	Tcl_Panic("fstat: %s", strerror(errno));
    }

   if (epoll_ctl(tsdPtr->eventsFd, op, filePtr->fd, &newEvent) == -1) {
       switch (errno) {
	    case EPERM:
		switch (op) {
		case EPOLL_CTL_ADD:
		    if (isNew) {
			LIST_INSERT_HEAD(&tsdPtr->firstReadyFileHandlerPtr, filePtr,
				readyNode);
		    }
		    break;
		case EPOLL_CTL_DEL:
		    LIST_REMOVE(filePtr, readyNode);
		    break;

	switch (errno) {
	case EPERM:
	    switch (op) {
	    case EPOLL_CTL_ADD:
		if (isNew) {
		    LIST_INSERT_HEAD(&tsdPtr->firstReadyFileHandlerPtr,
			    filePtr, readyNode);
		}
		break;
	    case EPOLL_CTL_DEL:
		LIST_REMOVE(filePtr, readyNode);
		break;
	    }
		}
		break;
	    default:
		Tcl_Panic("epoll_ctl: %s", strerror(errno));
	    break;
	default:
	    Tcl_Panic("epoll_ctl: %s", strerror(errno));
	}
    }
    return;
}

/*
 *----------------------------------------------------------------------
509
510
511
512
513
514
515
516

517
518
519
520
521
522
523
519
520
521
522
523
524
525

526
527
528
529
530
531
532
533







-
+







    int fd,			/* Handle of stream to watch. */
    int mask,			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION: indicates
				 * conditions under which proc should be
				 * called. */
    Tcl_FileProc *proc,		/* Function to call for each selected
				 * event. */
    void *clientData)	/* Arbitrary data to pass to proc. */
    void *clientData)		/* Arbitrary data to pass to proc. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL);
    int isNew = (filePtr == NULL);

    if (isNew) {
	filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler));
787
788
789
790
791
792
793
794

795
796
797
798
799
800
801
797
798
799
800
801
802
803

804
805
806
807
808
809
810
811







-
+







 *----------------------------------------------------------------------
 */

int
TclAsyncNotifier(
    int sigNumber,		/* Signal number. */
    Tcl_ThreadId threadId,	/* Target thread. */
    void *clientData,	/* Notifier data. */
    void *clientData,		/* Notifier data. */
    int *flagPtr,		/* Flag to mark. */
    int value)			/* Value of mark. */
{
#if TCL_THREADS
    /*
     * WARNING:
     * This code most likely runs in a signal handler. Thus,
Changes to unix/tclKqueueNotfy.c.

















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-
-







/*
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 * Copyright © 2016 Lucio Andrés Illanes Albornoz <l.illanes@gmx.de>
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclKqueueNotfy.c --
 *
 *	This file contains the implementation of the kqueue()-based
 *	DragonFly/Free/Net/OpenBSD-specific notifier, which is the lowest-
 *	level part of the Tcl event loop. This file works together with
 *	generic/tclNotify.c.
 *
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 * Copyright © 2016 Lucio Andrés Illanes Albornoz <l.illanes@gmx.de>
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */
#if defined(NOTIFIER_KQUEUE) && TCL_THREADS

36
37
38
39
40
41
42
43

44
45
46
47
48
49
50
47
48
49
50
51
52
53

54
55
56
57
58
59
60
61







-
+







    int mask;			/* Mask of desired events: TCL_READABLE,
				 * etc. */
    int readyMask;		/* Mask of events that have been seen since
				 * the last time file handlers were invoked
				 * for this file. */
    Tcl_FileProc *proc;		/* Function to call, in the style of
				 * Tcl_CreateFileHandler. */
    void *clientData;	/* Argument to pass to proc. */
    void *clientData;		/* Argument to pass to proc. */
    struct FileHandler *nextPtr;/* Next in list of all files we care about. */
    LIST_ENTRY(FileHandler) readyNode;
				/* Next/previous in list of FileHandlers asso-
				 * ciated with regular files (S_IFREG) that are
				 * ready for I/O. */
    struct PlatformEventData *pedPtr;
				/* Pointer to PlatformEventData associating this
513
514
515
516
517
518
519
520

521
522
523
524
525
526
527
524
525
526
527
528
529
530

531
532
533
534
535
536
537
538







-
+







    int fd,			/* Handle of stream to watch. */
    int mask,			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION: indicates
				 * conditions under which proc should be
				 * called. */
    Tcl_FileProc *proc,		/* Function to call for each selected
				 * event. */
    void *clientData)	/* Arbitrary data to pass to proc. */
    void *clientData)		/* Arbitrary data to pass to proc. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL);
    int isNew = (filePtr == NULL);

    if (isNew) {
	filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler));
782
783
784
785
786
787
788
789

790
791
792
793
794
795
796
793
794
795
796
797
798
799

800
801
802
803
804
805
806
807







-
+







 *----------------------------------------------------------------------
 */

int
TclAsyncNotifier(
    int sigNumber,		/* Signal number. */
    Tcl_ThreadId threadId,	/* Target thread. */
    void *clientData,	/* Notifier data. */
    void *clientData,		/* Notifier data. */
    int *flagPtr,		/* Flag to mark. */
    int value)			/* Value of mark. */
{
#if TCL_THREADS
    /*
     * WARNING:
     * This code most likely runs in a signal handler. Thus,
Changes to unix/tclLoadAix.c.















1
2
3
4
5
6
7
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * @(#)dlfcn.c	1.7 revision of 95/08/14  19:08:38
 * This is an unpublished work copyright © 1992 HELIOS Software GmbH
 * 30159 Hannover, Germany
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclLoadAix.c --
 *
 *	This file implements the dlopen and dlsym APIs under the AIX operating
 *	system, to enable the Tcl "load" command to work. This code was
 *	provided by Jens-Uwe Mager.
 *
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
32
33
34
35
36
37
38






39
40
41
42
43
44
45







-
-
-
-
-
-







 *	for any results of using the software, alterations are clearly marked
 *	as such, and this notice is not modified.
 *
 * Note: this file has been altered from the original in a few ways in order
 * to work properly with Tcl.
 */

/*
 * @(#)dlfcn.c	1.7 revision of 95/08/14  19:08:38
 * This is an unpublished work copyright © 1992 HELIOS Software GmbH
 * 30159 Hannover, Germany
 */

#include <stdio.h>
#include <errno.h>
#include <string.h>
#include <stdlib.h>
#include <sys/types.h>
#include <sys/ldr.h>
#include <a.out.h>
Changes to unix/tclLoadDl.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclLoadDl.c --
 *
 *	This procedure provides a version of the TclLoadFile that works with
 *	the "dlopen" and "dlsym" library procedures for dynamic loading.
 *
 * Copyright © 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclLoadDl.c --
 *
 *	This procedure provides a version of the TclLoadFile that works with
 *	the "dlopen" and "dlsym" library procedures for dynamic loading.
 */

#include "tclInt.h"
#ifdef NO_DLFCN_H
#   include "../compat/dlfcn.h"
#else
#   include <dlfcn.h>
#endif

Changes to unix/tclLoadDyld.c.

















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-
-







/*
 * Copyright © 1995 Apple Computer, Inc.
 * Copyright © 2001-2007 Daniel A. Steffen <das@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclLoadDyld.c --
 *
 *	This procedure provides a version of the TclLoadFile that works with
 *	Apple's dyld dynamic loading.
 *	Original version of his file (superseded long ago) provided by
 *	Wilfredo Sanchez (wsanchez@apple.com).
 *
 * Copyright © 1995 Apple Computer, Inc.
 * Copyright © 2001-2007 Daniel A. Steffen <das@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#ifndef MODULE_SCOPE
#   define MODULE_SCOPE extern
#endif
144
145
146
147
148
149
150
151

152
153
154
155
156
157
158
155
156
157
158
159
160
161

162
163
164
165
166
167
168
169







-
+







 */

MODULE_SCOPE int
TclpDlopen(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
				 * code (UTF-8). */
    Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
    Tcl_LoadHandle *loadHandle,	/* Filled with token for dynamically loaded
				 * file which will be passed back to
				 * (*unloadProcPtr)() to unload the file. */
    Tcl_FSUnloadFileProc **unloadProcPtr,
				/* Filled with address of Tcl_FSUnloadFileProc
				 * function which should be used for this
				 * file. */
    int flags)
544
545
546
547
548
549
550
551

552
553
554
555
556
557
558
555
556
557
558
559
560
561

562
563
564
565
566
567
568
569







-
+







    Tcl_Interp *interp,		/* Used for error reporting. */
    void *buffer,		/* Buffer containing the desired code
				 * (allocated with TclpLoadMemoryGetBuffer). */
    int size,			/* Allocation size of buffer. */
    int codeSize,		/* Size of code data read into buffer or -1 if
				 * an error occurred and the buffer should
				 * just be freed. */
    Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
    Tcl_LoadHandle *loadHandle,	/* Filled with token for dynamically loaded
				 * file which will be passed back to
				 * (*unloadProcPtr)() to unload the file. */
    Tcl_FSUnloadFileProc **unloadProcPtr,
				/* Filled with address of Tcl_FSUnloadFileProc
				 * function which should be used for this
				 * file. */
    int flags)
Changes to unix/tclLoadNext.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclLoadNext.c --
 *
 *	This procedure provides a version of the TclLoadFile that works with
 *	NeXTs rld_* dynamic loading. This file provided by Pedja Bogdanovich.
 *
 * Copyright © 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclLoadNext.c --
 *
 *	This procedure provides a version of the TclLoadFile that works with
 *	NeXTs rld_* dynamic loading. This file provided by Pedja Bogdanovich.
 */

#include "tclInt.h"
#include <mach-o/rld.h>
#include <streams/streams.h>

/*
 * Static procedures defined within this file.
 */
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
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







-
+










-
+

















-
+







    Tcl_LoadHandle newHandle;
    struct mach_header *header;
    char *fileName;
    char *files[2];
    const char *native;
    int result = 1;

    NXStream *errorStream = NXOpenMemory(0,0,NX_READWRITE);
    NXStream *errorStream = NXOpenMemory(0, 0, NX_READWRITE);

    fileName = TclGetString(pathPtr);

    /*
     * First try the full path the user gave us. This is particularly
     * important if the cwd is inside a vfs, and we are trying to load using a
     * relative path.
     */

    native = Tcl_FSGetNativePath(pathPtr);
    files = {native,NULL};
    files = {native, NULL};

    result = rld_load(errorStream, &header, files, NULL);

    if (!result) {
	/*
	 * Let the OS loader examine the binary search path for whatever
	 * string the user gave us which hopefully refers to a file on the
	 * binary path.
	 */

	Tcl_DString ds;

	if (Tcl_UtfToExternalDStringEx(interp, NULL, fileName, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	    Tcl_DStringFree(&ds);
	    return TCL_ERROR;
	}
	native = Tcl_DStringValue(&ds);
	files = {native,NULL};
	files = {native, NULL};
	result = rld_load(errorStream, &header, files, NULL);
	Tcl_DStringFree(&ds);
    }

    if (!result) {
	char *data;
	int len, maxlen;
Changes to unix/tclLoadOSF.c.
















1
2
3
4
5
6
7
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * Copyright © 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclLoadOSF.c --
 *
 *	This function provides a version of the TclLoadFile that works under
 *	OSF/1 1.0/1.1/1.2 and related systems, utilizing the old OSF/1
 *	/sbin/loader and /usr/include/loader.h. OSF/1 versions from 1.3 and on
 *	use ELF, rtld, and dlopen()[/usr/include/ldfcn.h].
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
37
38
39
40
41
42
43





44
45
46
47
48
49
50







-
-
-
-
-







 *		OSF/1 1.3 or later (from OSF) using ELF
 *			includes: MK6, MK7, AD2, AD3 (from OSF RI)
 *
 *	This approach to things was utter @&^#; thankfully, OSF/1 eventually
 *	supported dlopen().
 *
 *	John Robert LoVerso <loverso@freebsd.osf.org>
 *
 * Copyright © 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"
#include <sys/types.h>
#include <loader.h>

/*
Changes to unix/tclLoadShl.c.
















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
-
-







/*
 * Copyright © 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclLoadShl.c --
 *
 *	This procedure provides a version of the TclLoadFile that works with
 *	the "shl_load" and "shl_findsym" library procedures for dynamic
 *	loading (e.g. for HP machines).
 *
 * Copyright © 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 <dl.h>
#include "tclInt.h"

/*
 * Static functions defined within this file.
Changes to unix/tclSelectNotfy.c.
















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
-
-







/*
 * Copyright © 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclSelectNotfy.c --
 *
 *	This file contains the implementation of the select()-based generic
 *	Unix notifier, which is the lowest-level part of the Tcl event loop.
 *	This file works together with generic/tclNotify.c.
 *
 * Copyright © 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"
#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */
#if (!defined(NOTIFIER_EPOLL) && !defined(NOTIFIER_KQUEUE)) || !TCL_THREADS

28
29
30
31
32
33
34
35

36
37
38
39
40
41
42
39
40
41
42
43
44
45

46
47
48
49
50
51
52
53







-
+







    int mask;			/* Mask of desired events: TCL_READABLE,
				 * etc. */
    int readyMask;		/* Mask of events that have been seen since
				 * the last time file handlers were invoked
				 * for this file. */
    Tcl_FileProc *proc;		/* Function to call, in the style of
				 * Tcl_CreateFileHandler. */
    void *clientData;	/* Argument to pass to proc. */
    void *clientData;		/* Argument to pass to proc. */
    struct FileHandler *nextPtr;/* Next in list of all files we care about. */
} FileHandler;

/*
 * The following structure contains a set of select() masks to track readable,
 * writable, and exception conditions.
 */
476
477
478
479
480
481
482
483

484
485
486
487
488
489
490
487
488
489
490
491
492
493

494
495
496
497
498
499
500
501







-
+







    int fd,			/* Handle of stream to watch. */
    int mask,			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION: indicates
				 * conditions under which proc should be
				 * called. */
    Tcl_FileProc *proc,		/* Function to call for each selected
				 * event. */
    void *clientData)	/* Arbitrary data to pass to proc. */
    void *clientData)		/* Arbitrary data to pass to proc. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL);

    if (filePtr == NULL) {
	filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler));
	filePtr->fd = fd;
917
918
919
920
921
922
923
924

925
926
927
928
929
930
931
928
929
930
931
932
933
934

935
936
937
938
939
940
941
942







-
+







 *----------------------------------------------------------------------
 */

int
TclAsyncNotifier(
    int sigNumber,		/* Signal number. */
    TCL_UNUSED(Tcl_ThreadId),	/* Target thread. */
    TCL_UNUSED(void *),	/* Notifier data. */
    TCL_UNUSED(void *),		/* Notifier data. */
    int *flagPtr,		/* Flag to mark. */
    int value)			/* Value of mark. */
{
#if TCL_THREADS
    /*
     * WARNING:
     * This code most likely runs in a signal handler. Thus,
Changes to unix/tclUnixChan.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
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

-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



















-
+







/*
 * tclUnixChan.c
 *
 *	Common channel driver for Unix channels based on files, command pipes
 *	and TCP sockets.
 *
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 * Copyright © 1998-1999 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclUnixChan.c
 *
 *	Common channel driver for Unix channels based on files, command pipes
 *	and TCP sockets.
 */

#include "tclInt.h"	/* Internal definitions for Tcl. */
#include "tclIO.h"	/* To get Channel type declaration. */

#undef SUPPORTS_TTY
#if defined(HAVE_TERMIOS_H)
#   define SUPPORTS_TTY 1
#   include <termios.h>
#   ifdef HAVE_SYS_IOCTL_H
#	include <sys/ioctl.h>
#   endif /* HAVE_SYS_IOCTL_H */
#   ifdef HAVE_SYS_MODEM_H
#	include <sys/modem.h>
#   endif /* HAVE_SYS_MODEM_H */

#   ifdef FIONREAD
#	define GETREADQUEUE(fd, int)	ioctl((fd), FIONREAD, &(int))
#   elif defined(FIORDCHK)
#	define GETREADQUEUE(fd, int)	int = ioctl((fd), FIORDCHK, NULL)
#   else
#       define GETREADQUEUE(fd, int)    int = 0
#	define GETREADQUEUE(fd, int)    int = 0
#   endif

#   ifdef TIOCOUTQ
#	define GETWRITEQUEUE(fd, int)	ioctl((fd), TIOCOUTQ, &(int))
#   else
#	define GETWRITEQUEUE(fd, int)	int = 0
#   endif
687
688
689
690
691
692
693
694

695
696
697
698
699
700
701
698
699
700
701
702
703
704

705
706
707
708
709
710
711
712







-
+








	/*
	 * Transfer dictionary to the DString. Note that we don't do this as
	 * an element as this is an option that can't be retrieved with a
	 * general probe.
	 */

	dictContents = TclGetStringFromObj(dictObj, &dictLength);
	dictContents = Tcl_GetStringFromObj(dictObj, &dictLength);
	Tcl_DStringAppend(dsPtr, dictContents, dictLength);
	Tcl_DecrRefCount(dictObj);
	return TCL_OK;
    }

    if (valid) {
	return TCL_OK;
Changes to unix/tclUnixCompat.c.
1
2
3
4
5
6
7
8
9













10
11
12
13
14
15
16
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

-
-






+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclUnixCompat.c
 *
 * Written by: Zoran Vasiljevic (vasiljevic@users.sourceforge.net).
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclUnixCompat.c
 */

#include "tclInt.h"
#include <errno.h>
#include <string.h>

/*
 * See also: SC_BLOCKING_STYLE in unix/tcl.m4
 */
160
161
162
163
164
165
166
167
168


169
170
171

172
173
174

175
176
177
178
179
180
181
171
172
173
174
175
176
177


178
179
180
181

182
183
184

185
186
187
188
189
190
191
192







-
-
+
+


-
+


-
+







}

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetPwNam --
 *
 *      Thread-safe wrappers for getpwnam(). See "man getpwnam" for more
 *      details.
 *	Thread-safe wrappers for getpwnam(). See "man getpwnam" for more
 *	details.
 *
 * Results:
 *      Pointer to struct passwd on success or NULL on error.
 *	Pointer to struct passwd on success or NULL on error.
 *
 * Side effects:
 *      None.
 *	None.
 *
 *---------------------------------------------------------------------------
 */

struct passwd *
TclpGetPwNam(
    const char *name)
240
241
242
243
244
245
246
247
248


249
250
251

252
253
254

255
256
257
258
259
260
261
251
252
253
254
255
256
257


258
259
260
261

262
263
264

265
266
267
268
269
270
271
272







-
-
+
+


-
+


-
+







}

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetPwUid --
 *
 *      Thread-safe wrappers for getpwuid(). See "man getpwuid" for more
 *      details.
 *	Thread-safe wrappers for getpwuid(). See "man getpwuid" for more
 *	details.
 *
 * Results:
 *      Pointer to struct passwd on success or NULL on error.
 *	Pointer to struct passwd on success or NULL on error.
 *
 * Side effects:
 *      None.
 *	None.
 *
 *---------------------------------------------------------------------------
 */

struct passwd *
TclpGetPwUid(
    uid_t uid)
343
344
345
346
347
348
349
350
351


352
353
354

355
356
357

358
359
360
361
362
363
364
354
355
356
357
358
359
360


361
362
363
364

365
366
367

368
369
370
371
372
373
374
375







-
-
+
+


-
+


-
+







#endif /* NEED_PW_CLEANER */

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetGrNam --
 *
 *      Thread-safe wrappers for getgrnam(). See "man getgrnam" for more
 *      details.
 *	Thread-safe wrappers for getgrnam(). See "man getgrnam" for more
 *	details.
 *
 * Results:
 *      Pointer to struct group on success or NULL on error.
 *	Pointer to struct group on success or NULL on error.
 *
 * Side effects:
 *      None.
 *	None.
 *
 *---------------------------------------------------------------------------
 */

struct group *
TclpGetGrNam(
    const char *name)
423
424
425
426
427
428
429
430
431


432
433
434

435
436
437

438
439
440
441
442
443
444
434
435
436
437
438
439
440


441
442
443
444

445
446
447

448
449
450
451
452
453
454
455







-
-
+
+


-
+


-
+







}

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetGrGid --
 *
 *      Thread-safe wrappers for getgrgid(). See "man getgrgid" for more
 *      details.
 *	Thread-safe wrappers for getgrgid(). See "man getgrgid" for more
 *	details.
 *
 * Results:
 *      Pointer to struct group on success or NULL on error.
 *	Pointer to struct group on success or NULL on error.
 *
 * Side effects:
 *      None.
 *	None.
 *
 *---------------------------------------------------------------------------
 */

struct group *
TclpGetGrGid(
    gid_t gid)
526
527
528
529
530
531
532
533
534


535
536
537

538
539
540

541
542
543
544
545
546
547
537
538
539
540
541
542
543


544
545
546
547

548
549
550

551
552
553
554
555
556
557
558







-
-
+
+


-
+


-
+







#endif /* NEED_GR_CLEANER */

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetHostByName --
 *
 *      Thread-safe wrappers for gethostbyname(). See "man gethostbyname" for
 *      more details.
 *	Thread-safe wrappers for gethostbyname(). See "man gethostbyname" for
 *	more details.
 *
 * Results:
 *      Pointer to struct hostent on success or NULL on error.
 *	Pointer to struct hostent on success or NULL on error.
 *
 * Side effects:
 *      None.
 *	None.
 *
 *---------------------------------------------------------------------------
 */

struct hostent *
TclpGetHostByName(
    const char *name)
594
595
596
597
598
599
600
601
602


603
604
605

606
607
608

609
610
611
612
613
614
615
605
606
607
608
609
610
611


612
613
614
615

616
617
618

619
620
621
622
623
624
625
626







-
-
+
+


-
+


-
+







}

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetHostByAddr --
 *
 *      Thread-safe wrappers for gethostbyaddr(). See "man gethostbyaddr" for
 *      more details.
 *	Thread-safe wrappers for gethostbyaddr(). See "man gethostbyaddr" for
 *	more details.
 *
 * Results:
 *      Pointer to struct hostent on success or NULL on error.
 *	Pointer to struct hostent on success or NULL on error.
 *
 * Side effects:
 *      None.
 *	None.
 *
 *---------------------------------------------------------------------------
 */

struct hostent *
TclpGetHostByAddr(
    const char *addr,
657
658
659
660
661
662
663
664
665


666
667
668

669
670
671

672
673
674
675
676
677
678
668
669
670
671
672
673
674


675
676
677
678

679
680
681

682
683
684
685
686
687
688
689







-
-
+
+


-
+


-
+







}

/*
 *---------------------------------------------------------------------------
 *
 * CopyGrp --
 *
 *      Copies string fields of the group structure to the private buffer,
 *      honouring the size of the buffer.
 *	Copies string fields of the group structure to the private buffer,
 *	honouring the size of the buffer.
 *
 * Results:
 *      0 on success or -1 on error (errno = ERANGE).
 *	0 on success or -1 on error (errno = ERANGE).
 *
 * Side effects:
 *      None.
 *	None.
 *
 *---------------------------------------------------------------------------
 */

#ifdef NEED_COPYGRP
#define NEED_COPYARRAY 1
#define NEED_COPYSTRING 1
730
731
732
733
734
735
736
737
738


739
740
741

742
743
744

745
746
747
748
749
750
751
741
742
743
744
745
746
747


748
749
750
751

752
753
754

755
756
757
758
759
760
761
762







-
-
+
+


-
+


-
+







#endif /* NEED_COPYGRP */

/*
 *---------------------------------------------------------------------------
 *
 * CopyHostent --
 *
 *      Copies string fields of the hostent structure to the private buffer,
 *      honouring the size of the buffer.
 *	Copies string fields of the hostent structure to the private buffer,
 *	honouring the size of the buffer.
 *
 * Results:
 *      Number of bytes copied on success or -1 on error (errno = ERANGE)
 *	Number of bytes copied on success or -1 on error (errno = ERANGE)
 *
 * Side effects:
 *      None
 *	None
 *
 *---------------------------------------------------------------------------
 */

#ifdef NEED_COPYHOSTENT
#define NEED_COPYSTRING 1
#define NEED_COPYARRAY 1
792
793
794
795
796
797
798
799
800


801
802
803

804
805
806
807


808
809
810
811
812
813
814
803
804
805
806
807
808
809


810
811
812
813

814
815
816


817
818
819
820
821
822
823
824
825







-
-
+
+


-
+


-
-
+
+







#endif /* NEED_COPYHOSTENT */

/*
 *---------------------------------------------------------------------------
 *
 * CopyPwd --
 *
 *      Copies string fields of the passwd structure to the private buffer,
 *      honouring the size of the buffer.
 *	Copies string fields of the passwd structure to the private buffer,
 *	honouring the size of the buffer.
 *
 * Results:
 *      0 on success or -1 on error (errno = ERANGE).
 *	0 on success or -1 on error (errno = ERANGE).
 *
 * Side effects:
 *      We are not copying the gecos field as it may not be supported on all
 *      platforms.
 *	We are not copying the gecos field as it may not be supported on all
 *	platforms.
 *
 *---------------------------------------------------------------------------
 */

#ifdef NEED_COPYPWD
#define NEED_COPYSTRING 1

858
859
860
861
862
863
864
865
866


867
868
869

870
871
872

873
874
875
876
877
878
879
869
870
871
872
873
874
875


876
877
878
879

880
881
882

883
884
885
886
887
888
889
890







-
-
+
+


-
+


-
+







#endif /* NEED_COPYPWD */

/*
 *---------------------------------------------------------------------------
 *
 * CopyArray --
 *
 *      Copies array of NULL-terminated or fixed-length strings to the private
 *      buffer, honouring the size of the buffer.
 *	Copies array of NULL-terminated or fixed-length strings to the private
 *	buffer, honouring the size of the buffer.
 *
 * Results:
 *      Number of bytes copied on success or -1 on error (errno = ERANGE)
 *	Number of bytes copied on success or -1 on error (errno = ERANGE)
 *
 * Side effects:
 *      None.
 *	None.
 *
 *---------------------------------------------------------------------------
 */

#ifdef NEED_COPYARRAY
static int
CopyArray(
922
923
924
925
926
927
928
929
930


931
932
933

934
935
936

937
938
939
940
941
942
943
933
934
935
936
937
938
939


940
941
942
943

944
945
946

947
948
949
950
951
952
953
954







-
-
+
+


-
+


-
+







#endif /* NEED_COPYARRAY */

/*
 *---------------------------------------------------------------------------
 *
 * CopyString --
 *
 *      Copies a NULL-terminated string to the private buffer, honouring the
 *      size of the buffer
 *	Copies a NULL-terminated string to the private buffer, honouring the
 *	size of the buffer
 *
 * Results:
 *      0 success or -1 on error (errno = ERANGE)
 *	0 success or -1 on error (errno = ERANGE)
 *
 * Side effects:
 *      None
 *	None
 *
 *---------------------------------------------------------------------------
 */

#ifdef NEED_COPYSTRING
static int
CopyString(
982
983
984
985
986
987
988
989
990


991
992
993
994
995
996
997
993
994
995
996
997
998
999


1000
1001
1002
1003
1004
1005
1006
1007
1008







-
-
+
+







 *	instruction in the four integers designated by 'regsPtr'
 *
 *----------------------------------------------------------------------
 */

int
TclWinCPUID(
    int index,		/* Which CPUID value to retrieve. */
    int *regsPtr)	/* Registers after the CPUID. */
    int index,			/* Which CPUID value to retrieve. */
    int *regsPtr)		/* Registers after the CPUID. */
{
    int status = TCL_ERROR;

    /* See: <http://en.wikipedia.org/wiki/CPUID> */
#if defined(__x86_64__) || defined(_M_AMD64) || defined (_M_X64)
    __asm__ __volatile__("movq %%rbx, %%rsi     \n\t" /* save %rbx */
	    "cpuid            \n\t"
Changes to unix/tclUnixEvent.c.
1
2
3
4
5
6
7
8
9
10
11















12
13
14
15
16
17
18
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

-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclUnixEvent.c --
 *
 *	This file implements Unix specific event related routines.
 *
 * Copyright © 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclUnixEvent.c --
 *
 *	This file implements Unix specific event related routines.
 */

#include "tclInt.h"
#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */

/*
 *----------------------------------------------------------------------
 *
Changes to unix/tclUnixFCmd.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
1














2

3
4
5
6
7
8
9
10

-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+







/*
 * tclUnixFCmd.c
 *
 *	This file implements the Unix specific portion of file manipulation
 *	subcommands of the "file" command. All filename arguments should
 *	already be translated to native format.
 *
 * Copyright © 1996-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * Portions of this code were derived from NetBSD source code which has the
 * following copyright notice:
 *
 * Copyright © 1988, 1993, 1994
 *      The Regents of the University of California. All rights reserved.
 *	The Regents of the University of California. All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are met:
 * 1. Redistributions of source code must retain the above copyright notice,
 *    this list of conditions and the following disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in the
36
37
38
39
40
41
42



























43
44
45
46
47
48
49
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
 * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
 * DAMAGE.
 */

/*
 * Copyright © 1996-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * Portions of this code were derived from NetBSD source code which has the
 * following copyright notice:
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclUnixFCmd.c
 *
 *	This file implements the Unix specific portion of file manipulation
 *	subcommands of the "file" command. All filename arguments should
 *	already be translated to native format.
 */

#include "tclInt.h"
#ifndef HAVE_STRUCT_STAT_ST_BLKSIZE
#ifndef NO_FSTATFS
#include <sys/statfs.h>
#endif
#endif /* !HAVE_STRUCT_STAT_ST_BLKSIZE */
#ifdef HAVE_FTS
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
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







-
+









-
+







    Tcl_Obj **errorPtr)
{
    Tcl_DString ds;
    Tcl_DString srcString, dstString;
    int ret;
    Tcl_Obj *transPtr;

    transPtr = Tcl_FSGetTranslatedPath(NULL,srcPathPtr);
    transPtr = Tcl_FSGetTranslatedPath(NULL, srcPathPtr);
    ret = Tcl_UtfToExternalDStringEx(NULL, NULL,
	    (transPtr != NULL ? TclGetString(transPtr) : NULL),
	    -1, 0, &srcString, NULL);
    if (transPtr != NULL) {
	Tcl_DecrRefCount(transPtr);
    }
    if (ret != TCL_OK) {
	*errorPtr = srcPathPtr;
    } else {
	transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr);
	transPtr = Tcl_FSGetTranslatedPath(NULL, destPathPtr);
	ret = Tcl_UtfToExternalDStringEx(NULL, NULL,
	    (transPtr != NULL ? TclGetString(transPtr) : NULL),
	    -1, TCL_ENCODING_PROFILE_TCL8, &dstString, NULL);
	if (transPtr != NULL) {
	    Tcl_DecrRefCount(transPtr);
	}
	if (ret != TCL_OK) {
1288
1289
1290
1291
1292
1293
1294
1295

1296
1297
1298
1299
1300
1301
1302
1301
1302
1303
1304
1305
1306
1307

1308
1309
1310
1311
1312
1313
1314
1315







-
+







 *
 *---------------------------------------------------------------------------
 */

static int
CopyFileAtts(
#ifdef MAC_OSX_TCL
    const char *src,	/* Path name of source file (native). */
    const char *src,		/* Path name of source file (native). */
#else
    TCL_UNUSED(const char *) /*src*/,
#endif
    const char *dst,		/* Path name of target file (native). */
    const Tcl_StatBuf *statBufPtr)
				/* Stat info for source file */
{
1511
1512
1513
1514
1515
1516
1517
1518

1519
1520
1521
1522
1523
1524
1525
1524
1525
1526
1527
1528
1529
1530

1531
1532
1533
1534
1535
1536
1537
1538







-
+








    if (TclGetWideIntFromObj(NULL, attributePtr, &gid) != TCL_OK) {
	Tcl_DString ds;
	struct group *groupPtr = NULL;
	const char *string;
	Tcl_Size length;

	string = TclGetStringFromObj(attributePtr, &length);
	string = Tcl_GetStringFromObj(attributePtr, &length);

	if (Tcl_UtfToExternalDStringEx(interp, NULL, string, length, 0, &ds, NULL) != TCL_OK) {
	    Tcl_DStringFree(&ds);
	    return TCL_ERROR;
	}
	native = Tcl_DStringValue(&ds);
	groupPtr = TclpGetGrNam(native); /* INTL: Native. */
1582
1583
1584
1585
1586
1587
1588
1589

1590
1591
1592
1593
1594
1595
1596
1595
1596
1597
1598
1599
1600
1601

1602
1603
1604
1605
1606
1607
1608
1609







-
+








    if (TclGetWideIntFromObj(NULL, attributePtr, &uid) != TCL_OK) {
	Tcl_DString ds;
	struct passwd *pwPtr = NULL;
	const char *string;
	Tcl_Size length;

	string = TclGetStringFromObj(attributePtr, &length);
	string = Tcl_GetStringFromObj(attributePtr, &length);

	if (Tcl_UtfToExternalDStringEx(interp, NULL, string, length, 0, &ds, NULL) != TCL_OK) {
	    Tcl_DStringFree(&ds);
	    return TCL_ERROR;
	}
	native = Tcl_DStringValue(&ds);
	pwPtr = TclpGetPwNam(native);			/* INTL: Native. */
1762
1763
1764
1765
1766
1767
1768
1769

1770
1771
1772
1773
1774
1775
1776

1777
1778
1779
1780
1781
1782
1783
1775
1776
1777
1778
1779
1780
1781

1782
1783
1784
1785
1786
1787
1788

1789
1790
1791
1792
1793
1794
1795
1796







-
+






-
+







 *
 *----------------------------------------------------------------------
 */

static int
GetModeFromPermString(
    TCL_UNUSED(Tcl_Interp *),
    const char *modeStringPtr, /* Permissions string */
    const char *modeStringPtr,	/* Permissions string */
    mode_t *modePtr)		/* pointer to the mode value */
{
    mode_t newMode;
    mode_t oldMode;		/* Storage for the value of the old mode (that
				 * is passed in), to allow for the chmod style
				 * manipulation. */
    int i,n, who, op, what, op_found, who_found;
    int i, n, who, op, what, op_found, who_found;

    /*
     * We start off checking for an "rwxrwxrwx" style permissions string
     */

    if (strlen(modeStringPtr) != 9) {
	goto chmodStyleCheck;
1961
1962
1963
1964
1965
1966
1967
1968

1969
1970
1971
1972
1973
1974
1975
1974
1975
1976
1977
1978
1979
1980

1981
1982
1983
1984
1985
1986
1987
1988







-
+







				 * normalized.  I.e. this is not the index of
				 * the byte just after the separator.  */

{
    const char *currentPathEndPosition;
    char cur;
    Tcl_Size pathLen;
    const char *path = TclGetStringFromObj(pathPtr, &pathLen);
    const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
    Tcl_DString ds;
    const char *nativePath;
#ifndef NO_REALPATH
    char normPath[MAXPATHLEN];
#endif

    currentPathEndPosition = path + nextCheckpoint;
2071
2072
2073
2074
2075
2076
2077
2078

2079
2080
2081
2082
2083
2084
2085
2084
2085
2086
2087
2088
2089
2090

2091
2092
2093
2094
2095
2096
2097
2098







-
+







	     * 'Realpath' transforms an empty string into the normalized pwd,
	     * which is the wrong answer.
	     */

	    return 0;
	}

	if (Tcl_UtfToExternalDStringEx(interp, NULL, path,nextCheckpoint, 0, &ds, NULL)) {
	if (Tcl_UtfToExternalDStringEx(interp, NULL, path, nextCheckpoint, 0, &ds, NULL)) {
	    Tcl_DStringFree(&ds);
	    return -1;
	}
	nativePath = Tcl_DStringValue(&ds);
	if (Realpath(nativePath, normPath) != NULL) {
	    Tcl_Size newNormLen;

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
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







-
+











-
+














-
+







    Tcl_Size length;

    /*
     * We should also check against making more than TMP_MAX of these.
     */

    if (dirObj) {
	string = TclGetStringFromObj(dirObj, &length);
	string = Tcl_GetStringFromObj(dirObj, &length);
	if (Tcl_UtfToExternalDStringEx(NULL, NULL, string, length, 0, &templ, NULL) != TCL_OK) {
	    return -1;
	}
    } else {
	Tcl_DStringInit(&templ);
	Tcl_DStringAppend(&templ, DefaultTempDir(), TCL_INDEX_NONE); /* INTL: native */
    }

    TclDStringAppendLiteral(&templ, "/");

    if (basenameObj) {
	string = TclGetStringFromObj(basenameObj, &length);
	string = Tcl_GetStringFromObj(basenameObj, &length);
	if (Tcl_UtfToExternalDStringEx(NULL, NULL, string, length, 0, &tmp, NULL) != TCL_OK) {
	    Tcl_DStringFree(&tmp);
	    return -1;
	}
	TclDStringAppendDString(&templ, &tmp);
	Tcl_DStringFree(&tmp);
    } else {
	TclDStringAppendLiteral(&templ, "tcl");
    }

    TclDStringAppendLiteral(&templ, "_XXXXXX");

#ifdef HAVE_MKSTEMPS
    if (extensionObj) {
	string = TclGetStringFromObj(extensionObj, &length);
	string = Tcl_GetStringFromObj(extensionObj, &length);
	if (Tcl_UtfToExternalDStringEx(NULL, NULL, string, length, 0, &tmp, NULL) != TCL_OK) {
	    Tcl_DStringFree(&templ);
	    return -1;
	}
	TclDStringAppendDString(&templ, &tmp);
	fd = mkstemps(Tcl_DStringValue(&templ), Tcl_DStringLength(&tmp));
	Tcl_DStringFree(&tmp);
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494




2495
2496
2497
2498
2499
2500
2501
2497
2498
2499
2500
2501
2502
2503




2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514







-
-
-
-
+
+
+
+







 *	The readonly attribute of the file is changed.
 *
 *---------------------------------------------------------------------------
 */

static int
SetUnixFileAttributes(
    Tcl_Interp *interp,	    /* The interp we are using for errors. */
    int objIndex,           /* The index of the attribute. */
    Tcl_Obj *fileName,      /* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)  /* The attribute to set. */
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* The attribute to set. */
{
    int yesNo, fileAttributes, old;
    WCHAR *winPath;

    if (Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo) != TCL_OK) {
	return TCL_ERROR;
    }
Changes to unix/tclUnixFile.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclUnixFile.c --
 *
 *	This file contains wrappers around UNIX file handling functions.
 *	These wrappers mask differences between Windows and UNIX.
 *
 * Copyright © 1995-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclUnixFile.c --
 *
 *	This file contains wrappers around UNIX file handling functions.
 *	These wrappers mask differences between Windows and UNIX.
 */

#include "tclInt.h"
#include "tclFileSystem.h"

static int		NativeMatchType(Tcl_Interp *interp,
			    const char* nativeEntry, const char* nativeName,
			    Tcl_GlobTypeData *types);

60
61
62
63
64
65
66

67
68
69
70
71
72
73
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85







+







    const char *argv0)		/* The value of the application's argv[0]
				 * (native). */
{
    const char *name, *p;
    Tcl_StatBuf statBuf;
    Tcl_DString buffer, nameString, cwd, utfName;
    Tcl_Obj *obj;
    int status;

    if (argv0 == NULL) {
	return;
    }
    Tcl_DStringInit(&buffer);

    name = argv0;
150
151
152
153
154
155
156
157





158
159
160
161
162
163
164
162
163
164
165
166
167
168

169
170
171
172
173
174
175
176
177
178
179
180







-
+
+
+
+
+







  gotName:
#ifdef DJGPP
    if (name[1] == ':')
#else
    if (name[0] == '/')
#endif
    {
	Tcl_ExternalToUtfDStringEx(NULL, NULL, name, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &utfName, NULL);
	status = Tcl_ExternalToUtfDStringEx(NULL, NULL, name, TCL_INDEX_NONE
		,TCL_ENCODING_PROFILE_STRICT ,&utfName ,NULL);
	if (status != TCL_OK) {
	    Tcl_Panic("%s {unable to encode value of path}" ,"TclpFindExecutable");
	}
	TclSetObjNameOfExecutable(Tcl_DStringToObj(&utfName), NULL);
	goto done;
    }

    if (TclpGetCwd(NULL, &cwd) == NULL) {
	TclNewObj(obj);
	TclSetObjNameOfExecutable(obj, NULL);
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
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







-
-
+
+
+
+
+







-
-
+
+
+
+
+
+







	name += 2;
    }

    Tcl_DStringInit(&nameString);
    Tcl_DStringAppend(&nameString, name, TCL_INDEX_NONE);

    Tcl_DStringFree(&buffer);
    Tcl_UtfToExternalDStringEx(NULL, NULL, Tcl_DStringValue(&cwd),
	    Tcl_DStringLength(&cwd), TCL_ENCODING_PROFILE_TCL8, &buffer, NULL);
    status = Tcl_UtfToExternalDStringEx(NULL, NULL, Tcl_DStringValue(&cwd),
	    Tcl_DStringLength(&cwd), TCL_ENCODING_PROFILE_STRICT, &buffer, NULL);
    if (status != TCL_OK) {
	Tcl_Panic("%s {unable to encode value of cwd}" ,"TclpFindExecutable");
    }
    if (Tcl_DStringValue(&cwd)[Tcl_DStringLength(&cwd) -1] != '/') {
	TclDStringAppendLiteral(&buffer, "/");
    }
    Tcl_DStringFree(&cwd);
    TclDStringAppendDString(&buffer, &nameString);
    Tcl_DStringFree(&nameString);

    Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(&buffer), TCL_INDEX_NONE,
	    TCL_ENCODING_PROFILE_TCL8, &utfName, NULL);
    status = Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(&buffer)
	, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_STRICT, &utfName, NULL);
    if (status != TCL_OK) {
	Tcl_Panic("%s {unable to encode value of executable name}"
	    ,"TclpFindExecutable");
    }
    TclSetObjNameOfExecutable(Tcl_DStringToObj(&utfName), NULL);

  done:
    Tcl_DStringFree(&buffer);
}
#endif

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
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







-
+
+















-
+







	    }
	}

	/*
	 * Now open the directory for reading and iterate over the contents.
	 */

	if (Tcl_UtfToExternalDStringEx(interp, NULL, dirName, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	if (Tcl_UtfToExternalDStringEx(interp, NULL, dirName, TCL_INDEX_NONE,
		0, &ds, NULL) != TCL_OK) {
	    Tcl_DStringFree(&dsOrig);
	    Tcl_DStringFree(&ds);
	    Tcl_DecrRefCount(fileNamePtr);
	    return TCL_ERROR;
	}
	native = Tcl_DStringValue(&ds);

	if ((TclOSstat(native, &statBuf) != 0)		/* INTL: Native. */
		|| !S_ISDIR(statBuf.st_mode)) {
	    Tcl_DStringFree(&dsOrig);
	    Tcl_DStringFree(&ds);
	    Tcl_DecrRefCount(fileNamePtr);
	    return TCL_OK;
	}

	d = TclOSopendir(native);				/* INTL: Native. */
	d = TclOSopendir(native);			/* INTL: Native. */
	if (d == NULL) {
	    Tcl_DStringFree(&ds);
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't read directory \"%s\": %s",
			Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp)));
	    }
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
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







-
-
+
+









-
+
+







	    }

	    /*
	     * Now check to see if the file matches, according to both type
	     * and pattern. If so, add the file to the result.
	     */

	    if (Tcl_ExternalToUtfDStringEx(interp, NULL, entryPtr->d_name, TCL_INDEX_NONE,
		    0, &utfDs, NULL) != TCL_OK) {
	    if (Tcl_ExternalToUtfDStringEx(interp, NULL, entryPtr->d_name,
		    TCL_INDEX_NONE, 0, &utfDs, NULL) != TCL_OK) {
		matchResult = -1;
		break;
	    }
	    utfname = Tcl_DStringValue(&utfDs);
	    if (Tcl_StringCaseMatch(utfname, pattern, 0)) {
		int typeOk = 1;

		if (types != NULL) {
		    Tcl_DStringSetLength(&ds, nativeDirLen);
		    native = Tcl_DStringAppend(&ds, entryPtr->d_name, TCL_INDEX_NONE);
		    native = Tcl_DStringAppend(&ds, entryPtr->d_name,
			    TCL_INDEX_NONE);
		    matchResult = NativeMatchType(interp, native,
			    entryPtr->d_name, types);
		    typeOk = (matchResult == 1);
		}
		if (typeOk) {
		    Tcl_ListObjAppendElement(interp, resultPtr,
			    TclNewFSPathObj(pathPtr, utfname,
427
428
429
430
431
432
433
434
435
436
437




438
439
440
441
442
443
444
452
453
454
455
456
457
458




459
460
461
462
463
464
465
466
467
468
469







-
-
-
-
+
+
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
NativeMatchType(
    Tcl_Interp *interp,       /* Interpreter to receive errors. */
    const char *nativeEntry,  /* Native path to check. */
    const char *nativeName,   /* Native filename to check. */
    Tcl_GlobTypeData *types)  /* Type description to match against. */
    Tcl_Interp *interp,		/* Interpreter to receive errors. */
    const char *nativeEntry,	/* Native path to check. */
    const char *nativeName,	/* Native filename to check. */
    Tcl_GlobTypeData *types)	/* Type description to match against. */
{
    Tcl_StatBuf buf;

    if (types == NULL) {
	/*
	 * Simply check for the file's existence, but do it with lstat, in
	 * case it is a link to a file which doesn't exist (since that case
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
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







-
+
+











-
+
+







    Tcl_DString *bufferPtr)	/* Uninitialized or free DString filled with
				 * name of user's home directory. */
{
    struct passwd *pwPtr;
    Tcl_DString ds;
    const char *native;

    if (Tcl_UtfToExternalDStringEx(NULL, NULL, name, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
    if (Tcl_UtfToExternalDStringEx(NULL, NULL, name, TCL_INDEX_NONE, 0, &ds,
	    NULL) != TCL_OK) {
	Tcl_DStringFree(&ds);
	return NULL;
    }
    native = Tcl_DStringValue(&ds);

    pwPtr = TclpGetPwNam(native);			/* INTL: Native. */
    Tcl_DStringFree(&ds);

    if (pwPtr == NULL) {
	return NULL;
    }
    if (Tcl_ExternalToUtfDStringEx(NULL, NULL, pwPtr->pw_dir, TCL_INDEX_NONE, 0, bufferPtr, NULL) != TCL_OK) {
    if (Tcl_ExternalToUtfDStringEx(NULL, NULL, pwPtr->pw_dir, TCL_INDEX_NONE,
	    0, bufferPtr, NULL) != TCL_OK) {
	return NULL;
    } else {
	return Tcl_DStringValue(bufferPtr);
    }
}

/*
794
795
796
797
798
799
800
801


802
803
804
805
806
807
808
821
822
823
824
825
826
827

828
829
830
831
832
833
834
835
836







-
+
+







	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error getting working directory name: %s",
		    Tcl_PosixError(interp)));
	}
	return NULL;
    }
    if (Tcl_ExternalToUtfDStringEx(interp, NULL, buffer, TCL_INDEX_NONE, 0, bufferPtr, NULL) != TCL_OK) {
    if (Tcl_ExternalToUtfDStringEx(interp, NULL, buffer, TCL_INDEX_NONE, 0,
	    bufferPtr, NULL) != TCL_OK) {
	return NULL;
    }
    return Tcl_DStringValue(bufferPtr);
}

/*
 *---------------------------------------------------------------------------
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
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







-
+
+











-
+
+







{
#ifndef DJGPP
    char link[MAXPATHLEN];
    Tcl_Size length;
    const char *native;
    Tcl_DString ds;

    if (Tcl_UtfToExternalDStringEx(NULL, NULL, path, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
    if (Tcl_UtfToExternalDStringEx(NULL, NULL, path, TCL_INDEX_NONE, 0, &ds,
	    NULL) != TCL_OK) {
	Tcl_DStringFree(&ds);
	return NULL;
    }
    native = Tcl_DStringValue(&ds);
    length = readlink(native, link, sizeof(link));	/* INTL: Native. */
    Tcl_DStringFree(&ds);

    if (length < 0) {
	return NULL;
    }

    if (Tcl_ExternalToUtfDStringEx(NULL, NULL, link, length, 0, linkPtr, NULL) == TCL_OK) {
    if (Tcl_ExternalToUtfDStringEx(NULL, NULL, link, length, 0, linkPtr,
	    NULL) == TCL_OK) {
	return Tcl_DStringValue(linkPtr);
    }
#endif /* !DJGPP */

    return NULL;
}

978
979
980
981
982
983
984
985
986



987
988
989
990
991
992
993
1008
1009
1010
1011
1012
1013
1014


1015
1016
1017
1018
1019
1020
1021
1022
1023
1024







-
-
+
+
+







	     * -- these must be expanded first).
	     */

	    transPtr = Tcl_FSGetTranslatedPath(NULL, toPtr);
	    if (transPtr == NULL) {
		return NULL;
	    }
	    target = TclGetStringFromObj(transPtr, &length);
	    if (Tcl_UtfToExternalDStringEx(NULL, NULL, target, length, 0, &ds, NULL) != TCL_OK) {
	    target = Tcl_GetStringFromObj(transPtr, &length);
	    if (Tcl_UtfToExternalDStringEx(NULL, NULL, target, length, 0, &ds,
		    NULL) != TCL_OK) {
		Tcl_DStringFree(&ds);
		return NULL;
	    }
	    target = Tcl_DStringValue(&ds);
	    Tcl_DecrRefCount(transPtr);

	    if (symlink(target, src) != 0) {
1013
1014
1015
1016
1017
1018
1019
1020


1021
1022
1023
1024
1025


1026
1027
1028
1029
1030
1031
1032
1044
1045
1046
1047
1048
1049
1050

1051
1052
1053
1054
1055
1056

1057
1058
1059
1060
1061
1062
1063
1064
1065







-
+
+




-
+
+








	transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
	if (transPtr == NULL) {
	    return NULL;
	}
	Tcl_DecrRefCount(transPtr);

	length = readlink((const char *)Tcl_FSGetNativePath(pathPtr), link, sizeof(link));
	length = readlink((const char *)Tcl_FSGetNativePath(pathPtr), link,
		sizeof(link));
	if (length < 0) {
	    return NULL;
	}

	if (Tcl_ExternalToUtfDStringEx(NULL, NULL, link, (size_t)length, 0, &ds, NULL) != TCL_OK) {
	if (Tcl_ExternalToUtfDStringEx(NULL, NULL, link, (size_t)length, 0,
		&ds, NULL) != TCL_OK) {
	    return NULL;
	}
	linkPtr = Tcl_DStringToObj(&ds);
	Tcl_IncrRefCount(linkPtr);
	return linkPtr;
    }
}
1084
1085
1086
1087
1088
1089
1090

1091
1092






1093
1094
1095
1096
1097
1098
1099
1117
1118
1119
1120
1121
1122
1123
1124
1125

1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138







+

-
+
+
+
+
+
+







 */

Tcl_Obj *
TclpNativeToNormalized(
    void *clientData)
{
    Tcl_DString ds;
    int status;

    Tcl_ExternalToUtfDStringEx(NULL, NULL, (const char *) clientData, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &ds, NULL);
    status = Tcl_ExternalToUtfDStringEx(NULL, NULL, (const char *) clientData,
	    TCL_INDEX_NONE, TCL_ENCODING_PROFILE_STRICT, &ds, NULL);
    if (status != TCL_OK) {
	Tcl_Panic("%s {unable to encode value}" ,"TclpNativeToNormalized");
    }

    return Tcl_DStringToObj(&ds);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclNativeCreateNativeRep --
1138
1139
1140
1141
1142
1143
1144
1145

1146
1147
1148
1149
1150
1151
1152
1177
1178
1179
1180
1181
1182
1183

1184
1185
1186
1187
1188
1189
1190
1191







-
+







	validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
	if (validPathPtr == NULL) {
	    return NULL;
	}
	Tcl_IncrRefCount(validPathPtr);
    }

    str = TclGetStringFromObj(validPathPtr, &len);
    str = Tcl_GetStringFromObj(validPathPtr, &len);
    if (Tcl_UtfToExternalDStringEx(NULL, NULL, str, len, 0, &ds, NULL) != TCL_OK) {
	Tcl_DecrRefCount(validPathPtr);
	Tcl_DStringFree(&ds);
	return NULL;
    }
    len = Tcl_DStringLength(&ds) + sizeof(char);
    if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) {
Changes to unix/tclUnixInit.c.
1
2
3
4
5
6
7
8
9
10















11
12
13
14
15
16
17
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

-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclUnixInit.c --
 *
 *	Contains the Unix-specific interpreter initialization functions.
 *
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 * Copyright © 1999 Scriptics Corporation.
 * All rights reserved.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclUnixInit.c --
 *
 *	Contains the Unix-specific interpreter initialization functions.
 */

#include "tclInt.h"
#ifdef HAVE_LANGINFO
#   include <langinfo.h>
#   ifdef __APPLE__
#	if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1030
	    /* Support for weakly importing nl_langinfo on Darwin. */
#	    define WEAK_IMPORT_NL_LANGINFO
56
57
58
59
60
61
62
63

64
65
66
67
68
69
70
71





72
73
74
75
76
77
78
67
68
69
70
71
72
73

74
75
76
77





78
79
80
81
82
83
84
85
86
87
88
89







-
+



-
-
-
-
-
+
+
+
+
+







    union {
	unsigned int  dwOemId;
	struct {
	    int wProcessorArchitecture;
	    int wReserved;
	};
    };
    unsigned int     dwPageSize;
    unsigned int dwPageSize;
    void *lpMinimumApplicationAddress;
    void *lpMaximumApplicationAddress;
    void *dwActiveProcessorMask;
    unsigned int     dwNumberOfProcessors;
    unsigned int     dwProcessorType;
    unsigned int     dwAllocationGranularity;
    int      wProcessorLevel;
    int      wProcessorRevision;
    unsigned int dwNumberOfProcessors;
    unsigned int dwProcessorType;
    unsigned int dwAllocationGranularity;
    int wProcessorLevel;
    int wProcessorRevision;
} SYSTEM_INFO;

typedef struct {
    unsigned int dwOSVersionInfoSize;
    unsigned int dwMajorVersion;
    unsigned int dwMinorVersion;
    unsigned int dwBuildNumber;
546
547
548
549
550
551
552
553

554
555
556
557
558
559
560
557
558
559
560
561
562
563

564
565
566
567
568
569
570
571







-
+








    /*
     * Note lengthPtr is (size_t *) which is unsigned so cannot
     * pass directly to Tcl_GetStringFromObj.
     * TODO - why is the type size_t anyways?
     */
    Tcl_Size length;
    str = TclGetStringFromObj(pathPtr, &length);
    str = Tcl_GetStringFromObj(pathPtr, &length);
    *lengthPtr = length;
    *valuePtr = (char *)Tcl_Alloc(length + 1);
    memcpy(*valuePtr, str, length + 1);
    Tcl_DecrRefCount(pathPtr);
}

/*
852
853
854
855
856
857
858
859
860


861
862
863
864
865
866
867
863
864
865
866
867
868
869


870
871
872
873
874
875
876
877
878







-
-
+
+







		CFRelease(frameworksURL);
	    }
	}
    }
#endif /* HAVE_COREFOUNDATION */
    p = pkgPath;
    while ((q = strchr(p, ':')) != NULL) {
	Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(p, q-p));
	p = q+1;
	Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(p, q - p));
	p = q + 1;
    }
    if (*p) {
	Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(p, -1));
    }
    Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_pkgPath", -1), NULL, pkgListObj, TCL_GLOBAL_ONLY);
    {
	/* Some platforms build configure scripts expect ~ expansion so do that */
897
898
899
900
901
902
903
904


905
906
907
908
909
910
911
908
909
910
911
912
913
914

915
916
917
918
919
920
921
922
923







-
+
+








    GetSystemInfo(&sysInfo);

    if (osInfo.dwMajorVersion == 10 && osInfo.dwBuildNumber >= 22000) {
	osInfo.dwMajorVersion = 11;
    }
    Tcl_SetVar2(interp, "tcl_platform", "os", "Windows NT", TCL_GLOBAL_ONLY);
    snprintf(buffer, sizeof(buffer), "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
    snprintf(buffer, sizeof(buffer), "%d.%d",
	    osInfo.dwMajorVersion, osInfo.dwMinorVersion);
    Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
    if (sysInfo.wProcessorArchitecture < NUMPROCESSORS) {
	Tcl_SetVar2(interp, "tcl_platform", "machine",
		processors[sysInfo.wProcessorArchitecture],
		TCL_GLOBAL_ONLY);
    }

987
988
989
990
991
992
993
994

995
996
997
998
999
1000
1001
999
1000
1001
1002
1003
1004
1005

1006
1007
1008
1009
1010
1011
1012
1013







-
+







	Tcl_DStringFree(&ds);
    }

    /*
     * Define what the platform PATH separator is. [TIP #315]
     */

    Tcl_SetVar2(interp, "tcl_platform","pathSeparator", ":", TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "tcl_platform", "pathSeparator", ":", TCL_GLOBAL_ONLY);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFindVariable --
 *
Changes to unix/tclUnixNotfy.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

















16
17
18
19
20
21
22
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

-
-
-
-
-
-








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclUnixNotfy.c --
 *
 *	This file contains subroutines shared by all notifier backend
 *	implementations on *nix platforms. It is *included* by the epoll,
 *	kqueue and select notifier implementation files.
 *
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 * Copyright © 2016 Lucio Andrés Illanes Albornoz <l.illanes@gmx.de>
 * Copyright © 2021 Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclUnixNotfy.c --
 *
 *	This file contains subroutines shared by all notifier backend
 *	implementations on *nix platforms. It is *included* by the epoll,
 *	kqueue and select notifier implementation files.
 */

#include <poll.h>
#include "tclInt.h"

/*
 * Static routines defined in this file.
 */

Changes to unix/tclUnixPipe.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
















14
15
16
17
18
19
20
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

-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclUnixPipe.c --
 *
 *	This file implements the UNIX-specific exec pipeline functions, the
 *	"pipe" channel driver, and the "pid" Tcl command.
 *
 * Copyright © 1991-1994 The Regents of the University of California.
 * Copyright © 1994-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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclUnixPipe.c --
 *
 *	This file implements the UNIX-specific exec pipeline functions, the
 *	"pipe" channel driver, and the "pid" Tcl command.
 */

#include "tclInt.h"

#ifdef HAVE_POSIX_SPAWNP
#   if defined(HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDDUP2) \
	    && defined(HAVE_POSIX_SPAWNATTR_SETFLAGS) \
	    && !defined(HAVE_VFORK)
#	include <unistd.h>
352
353
354
355
356
357
358
359

360
361
362
363
364
365
366
363
364
365
366
367
368
369

370
371
372
373
374
375
376
377







-
+







 *	The file is closed.
 *
 *----------------------------------------------------------------------
 */

int
TclpCloseFile(
    TclFile file)	/* The file to close. */
    TclFile file)		/* The file to close. */
{
    int fd = GetFd(file);

    /*
     * Refuse to close the fds for stdin, stdout and stderr.
     */

397
398
399
400
401
402
403
404

405
406
407
408
409
410
411
408
409
410
411
412
413
414

415
416
417
418
419
420
421
422







-
+








int
TclpCreateProcess(
    Tcl_Interp *interp,		/* Interpreter in which to leave errors that
				 * occurred when creating the child process.
				 * Error messages from the child process
				 * itself are sent to errorFile. */
    size_t argc,			/* Number of arguments in following array. */
    size_t argc,		/* Number of arguments in following array. */
    const char **argv,		/* Array of argument strings in UTF-8.
				 * argv[0] contains the name of the executable
				 * translated using Tcl_TranslateFileName
				 * call). Additional arguments have not been
				 * converted. */
    TclFile inputFile,		/* If non-NULL, gives the file to use as input
				 * for the child process. If inputFile file is
568
569
570
571
572
573
574
575

576
577
578
579
580
581
582
579
580
581
582
583
584
585

586
587
588
589
590
591
592
593







-
+







	 * Set up stdio file handles for the child process.
	 */

	if (!SetupStdFile(inputFile, TCL_STDIN)
		|| !SetupStdFile(outputFile, TCL_STDOUT)
		|| (!joinThisError && !SetupStdFile(errorFile, TCL_STDERR))
		|| (joinThisError &&
			((dup2(1,2) == -1) || (fcntl(2, F_SETFD, 0) != 0)))) {
			((dup2(1, 2) == -1) || (fcntl(2, F_SETFD, 0) != 0)))) {
	    snprintf(errSpace, sizeof(errSpace),
		    "%dforked process couldn't set up input/output", errno);
	    len = strlen(errSpace);
	    if (len != (size_t) write(fd, errSpace, len)) {
		    Tcl_Panic("TclpCreateProcess: unable to write to errPipeOut");
	    }
	    _exit(1);
999
1000
1001
1002
1003
1004
1005
1006

1007
1008
1009
1010
1011
1012
1013
1010
1011
1012
1013
1014
1015
1016

1017
1018
1019
1020
1021
1022
1023
1024







-
+







 *	Sets the device into blocking or non-blocking mode.
 *
 *----------------------------------------------------------------------
 */

static int
PipeBlockModeProc(
    void *instanceData,	/* Pipe state. */
    void *instanceData,		/* Pipe state. */
    int mode)			/* The mode to set. Can be one of
				 * TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    PipeState *psPtr = (PipeState *)instanceData;

    if (psPtr->inFile
1039
1040
1041
1042
1043
1044
1045
1046

1047
1048
1049
1050
1051
1052
1053
1050
1051
1052
1053
1054
1055
1056

1057
1058
1059
1060
1061
1062
1063
1064







-
+







 *	Closes the command pipeline channel.
 *
 *----------------------------------------------------------------------
 */

static int
PipeClose2Proc(
    void *instanceData,	/* The pipe to close. */
    void *instanceData,		/* The pipe to close. */
    Tcl_Interp *interp,		/* For error reporting. */
    int flags)			/* Flags that indicate which side to close. */
{
    PipeState *pipePtr = (PipeState *)instanceData;
    Tcl_Channel errChan;
    int errorCode, result;

1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1108
1109
1110
1111
1112
1113
1114


1115
1116
1117
1118
1119
1120
1121







-
-







	 * routine.
	 */

	if (pipePtr->errorFile) {
	    errChan = Tcl_MakeFileChannel(
		    INT2PTR(GetFd(pipePtr->errorFile)),
		    TCL_READABLE);
	    /* Error channels should not raise encoding errors */
	    Tcl_SetChannelOption(NULL, errChan, "-profile", "replace");
	} else {
	    errChan = NULL;
	}
	result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
		errChan);
    }

1136
1137
1138
1139
1140
1141
1142
1143

1144
1145
1146
1147
1148
1149
1150
1145
1146
1147
1148
1149
1150
1151

1152
1153
1154
1155
1156
1157
1158
1159







-
+







 *	Reads input from the input device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
PipeInputProc(
    void *instanceData,	/* Pipe state. */
    void *instanceData,		/* Pipe state. */
    char *buf,			/* Where to store data read. */
    int toRead,			/* How much space is available in the
				 * buffer? */
    int *errorCodePtr)		/* Where to store error code. */
{
    PipeState *psPtr = (PipeState *)instanceData;
    int bytesRead;		/* How many bytes were actually read from the
1187
1188
1189
1190
1191
1192
1193
1194

1195
1196
1197
1198
1199
1200
1201
1196
1197
1198
1199
1200
1201
1202

1203
1204
1205
1206
1207
1208
1209
1210







-
+







 *	Writes output on the output device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
PipeOutputProc(
    void *instanceData,	/* Pipe state. */
    void *instanceData,		/* Pipe state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCodePtr)		/* Where to store error code. */
{
    PipeState *psPtr = (PipeState *)instanceData;
    int written;

1248
1249
1250
1251
1252
1253
1254
1255

1256
1257
1258
1259
1260
1261
1262
1257
1258
1259
1260
1261
1262
1263

1264
1265
1266
1267
1268
1269
1270
1271







-
+







    Tcl_Channel channel = (Tcl_Channel)clientData;

    Tcl_NotifyChannel(channel, mask);
}

static void
PipeWatchProc(
    void *instanceData,	/* The pipe state. */
    void *instanceData,		/* The pipe state. */
    int mask)			/* Events of interest; an OR-ed combination of
				 * TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    PipeState *psPtr = (PipeState *)instanceData;
    int newmask;

1296
1297
1298
1299
1300
1301
1302
1303

1304
1305

1306
1307
1308
1309
1310
1311
1312
1305
1306
1307
1308
1309
1310
1311

1312
1313

1314
1315
1316
1317
1318
1319
1320
1321







-
+

-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PipeGetHandleProc(
    void *instanceData,	/* The pipe state. */
    void *instanceData,		/* The pipe state. */
    int direction,		/* TCL_READABLE or TCL_WRITABLE */
    void **handlePtr)	/* Where to store the handle. */
    void **handlePtr)		/* Where to store the handle. */
{
    PipeState *psPtr = (PipeState *)instanceData;

    if (direction == TCL_READABLE && psPtr->inFile) {
	*handlePtr = INT2PTR(GetFd(psPtr->inFile));
	return TCL_OK;
    }
Changes to unix/tclUnixPort.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
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+













-
-
-
-
-
-







/*
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclUnixPort.h --
 *
 *	This header file handles porting issues that occur because of
 *	differences between systems. It reads in UNIX-related header files and
 *	sets up UNIX-related macros for Tcl's UNIX core. It should be the only
 *	file that contains #ifdefs to handle different flavors of UNIX. This
 *	file sets up the union of all UNIX-related things needed by any of the
 *	Tcl core files. This file depends on configuration #defines such as
 *	HAVE_SYS_PARAM_H that are set up by the "configure" script.
 *
 *	Much of the material in this file was originally contributed by Karl
 *	Lehenbauer, Mark Diekhans and Peter da Silva.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-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.
 */

#ifndef _TCLUNIXPORT
#define _TCLUNIXPORT

/*
 *---------------------------------------------------------------------------
232
233
234
235
236
237
238
239

240
241
242
243
244
245
246
243
244
245
246
247
248
249

250
251
252
253
254
255
256
257







-
+








#ifndef WEXITSTATUS
#   define WEXITSTATUS(stat)	(((*((int *) &(stat))) >> 8) & 0xFF)
#endif

#ifndef WIFSIGNALED
#   define WIFSIGNALED(stat) \
	(((*((int *) &(stat)))) && ((*((int *) &(stat))) \
	(((*((int *) &(stat)))) && ((*((int *) &(stat)))		\
		== ((*((int *) &(stat))) & 0x00FF)))
#endif

#ifndef WTERMSIG
#   define WTERMSIG(stat)	((*((int *) &(stat))) & 0x7F)
#endif

Changes to unix/tclUnixSock.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
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

-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+














-
-
+
+







/*
 * tclUnixSock.c --
 *
 *	This file contains Unix-specific socket related code.
 *
 * Copyright © 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclUnixSock.c --
 *
 *	This file contains Unix-specific socket related code.
 */

#include "tclInt.h"
#include <netinet/tcp.h>

/*
 * Helper macros to make parts of this file clearer. The macros do exactly
 * what they say on the tin. :-) They also only ever refer to their arguments
 * once, and so can be used without regard to side effects.
 */

#define SET_BITS(var, bits)	((var) |= (bits))
#define CLEAR_BITS(var, bits)	((var) &= ~(bits))
#define GOT_BITS(var, bits)     (((var) & (bits)) != 0)

/* "sock" + a pointer in hex + \0 */
#define SOCK_CHAN_LENGTH        (4 + sizeof(void *) * 2 + 1)
#define SOCK_TEMPLATE           "sock%" TCL_Z_MODIFIER "x"
#define SOCK_CHAN_LENGTH	(4 + sizeof(void *) * 2 + 1)
#define SOCK_TEMPLATE		"sock%" TCL_Z_MODIFIER "x"

#undef SOCKET   /* Possible conflict with win32 SOCKET */

/*
 * This is needed to comply with the strict aliasing rules of GCC, but it also
 * simplifies casting between the different sockaddr types.
 */
70
71
72
73
74
75
76
77
78
79
80




81
82
83
84
85
86
87
81
82
83
84
85
86
87




88
89
90
91
92
93
94
95
96
97
98







-
-
-
-
+
+
+
+







     * Only needed for client sockets
     */

    struct addrinfo *addrlist;	/* Addresses to connect to. */
    struct addrinfo *addr;	/* Iterator over addrlist. */
    struct addrinfo *myaddrlist;/* Local address. */
    struct addrinfo *myaddr;	/* Iterator over myaddrlist. */
    int filehandlers;           /* Caches FileHandlers that get set up while
                                 * an async socket is not yet connected. */
    int connectError;           /* Cache SO_ERROR of async socket. */
    int cachedBlocking;         /* Cache blocking mode of async socket. */
    int filehandlers;		/* Caches FileHandlers that get set up while
				 * an async socket is not yet connected. */
    int connectError;		/* Cache SO_ERROR of async socket. */
    int cachedBlocking;		/* Cache blocking mode of async socket. */
};

/*
 * These bits may be OR'ed together into the "flags" field of a TcpState
 * structure.
 */

190
191
192
193
194
195
196
197

198
199
200
201
202
203
204
201
202
203
204
205
206
207

208
209
210
211
212
213
214
215







-
+







    char host[NI_MAXHOST], port[NI_MAXSERV];
    struct addrinfo *ai;

    for (ai = addrlist; ai != NULL; ai = ai->ai_next) {
	getnameinfo(ai->ai_addr, ai->ai_addrlen,
		host, sizeof(host), port, sizeof(port),
		NI_NUMERICHOST|NI_NUMERICSERV);
	fprintf(stderr,"%s: %s:%s\n", prefix, host, port);
	fprintf(stderr, "%s: %s:%s\n", prefix, host, port);
    }
}
#endif
/*
 * ----------------------------------------------------------------------
 *
 * InitializeHostName --
352
353
354
355
356
357
358
359

360
361
362
363
364
365
366
363
364
365
366
367
368
369

370
371
372
373
374
375
376
377







-
+







 *	Sets the device into blocking or nonblocking mode.
 *
 * ----------------------------------------------------------------------
 */

static int
TcpBlockModeProc(
    void *instanceData,	/* Socket state. */
    void *instanceData,		/* Socket state. */
    int mode)			/* The mode to set. Can be one of
				 * TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    TcpState *statePtr = (TcpState *)instanceData;

    if (mode == TCL_MODE_BLOCKING) {
497
498
499
500
501
502
503
504

505
506
507
508
509
510
511
508
509
510
511
512
513
514

515
516
517
518
519
520
521
522







-
+







 *	Reads input from the input device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
TcpInputProc(
    void *instanceData,	/* Socket state. */
    void *instanceData,		/* Socket state. */
    char *buf,			/* Where to store data read. */
    int bufSize,		/* How much space is available in the
				 * buffer? */
    int *errorCodePtr)		/* Where to store error code. */
{
    TcpState *statePtr = (TcpState *)instanceData;
    int bytesRead;
548
549
550
551
552
553
554
555

556
557
558
559
560
561
562
559
560
561
562
563
564
565

566
567
568
569
570
571
572
573







-
+







 *	Writes output on the output device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
TcpOutputProc(
    void *instanceData,	/* Socket state. */
    void *instanceData,		/* Socket state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCodePtr)		/* Where to store error code. */
{
    TcpState *statePtr = (TcpState *)instanceData;
    int written;

589
590
591
592
593
594
595
596

597
598
599
600
601
602
603
600
601
602
603
604
605
606

607
608
609
610
611
612
613
614







-
+







 *	Closes the socket of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
TcpCloseProc(
    void *instanceData,	/* The socket to close. */
    void *instanceData,		/* The socket to close. */
    TCL_UNUSED(Tcl_Interp *))
{
    TcpState *statePtr = (TcpState *)instanceData;
    int errorCode = 0;
    TcpFdList *fds;

    /*
650
651
652
653
654
655
656
657

658
659
660
661
662
663
664
661
662
663
664
665
666
667

668
669
670
671
672
673
674
675







-
+







 *	Shuts down one side of the socket.
 *
 *----------------------------------------------------------------------
 */

static int
TcpClose2Proc(
    void *instanceData,	/* The socket to close. */
    void *instanceData,		/* The socket to close. */
    TCL_UNUSED(Tcl_Interp *),
    int flags)			/* Flags that indicate which side to close. */
{
    TcpState *statePtr = (TcpState *)instanceData;
    int readError = 0;
    int writeError = 0;

1164
1165
1166
1167
1168
1169
1170
1171

1172
1173
1174
1175
1176
1177
1178
1175
1176
1177
1178
1179
1180
1181

1182
1183
1184
1185
1186
1187
1188
1189







-
+







	newmask = TCL_WRITABLE;
    }
    Tcl_NotifyChannel(statePtr->channel, newmask);
}

static void
TcpWatchProc(
    void *instanceData,	/* The socket state. */
    void *instanceData,		/* The socket state. */
    int mask)			/* Events of interest; an OR-ed combination of
				 * TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    TcpState *statePtr = (TcpState *)instanceData;

    if (statePtr->acceptProc != NULL) {
1237
1238
1239
1240
1241
1242
1243
1244

1245
1246

1247
1248
1249
1250
1251
1252
1253
1248
1249
1250
1251
1252
1253
1254

1255
1256

1257
1258
1259
1260
1261
1262
1263
1264







-
+

-
+







 *	None.
 *
 * ----------------------------------------------------------------------
 */

static int
TcpGetHandleProc(
    void *instanceData,	/* The socket state. */
    void *instanceData,		/* The socket state. */
    TCL_UNUSED(int) /*direction*/,
    void **handlePtr)	/* Where to store the handle. */
    void **handlePtr)		/* Where to store the handle. */
{
    TcpState *statePtr = (TcpState *)instanceData;

    *handlePtr = INT2PTR(statePtr->fds.fd);
    return TCL_OK;
}

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
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







-
+













-
-
-
+
+
+







 *	attempt has succeeded or failed.
 *
 * ----------------------------------------------------------------------
 */

static void
TcpAsyncCallback(
    void *clientData,	/* The socket state. */
    void *clientData,		/* The socket state. */
    TCL_UNUSED(int) /*mask*/)
{
    TcpConnect(NULL, (TcpState *)clientData);
}

/*
 * ----------------------------------------------------------------------
 *
 * TcpConnect --
 *
 *	This function opens a new socket in client mode.
 *
 * Results:
 *      TCL_OK, if the socket was successfully connected or an asynchronous
 *      connection is in progress. If an error occurs, TCL_ERROR is returned
 *      and an error message is left in interp.
 *	TCL_OK, if the socket was successfully connected or an asynchronous
 *	connection is in progress. If an error occurs, TCL_ERROR is returned
 *	and an error message is left in interp.
 *
 * Side effects:
 *	Opens a socket.
 *
 * Remarks:
 *	A single host name may resolve to more than one IP address, e.g. for
 *	an IPv4/IPv6 dual stack host. For handling asynchronously connecting
1569
1570
1571
1572
1573
1574
1575
1576

1577
1578
1579
1580
1581
1582
1583
1580
1581
1582
1583
1584
1585
1586

1587
1588
1589
1590
1591
1592
1593
1594







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_MakeTcpClientChannel(
    void *sock)		/* The socket to wrap up into a channel. */
    void *sock)			/* The socket to wrap up into a channel. */
{
    return (Tcl_Channel) TclpMakeTcpClientChannelMode(sock,
	    TCL_READABLE | TCL_WRITABLE);
}

/*
 *----------------------------------------------------------------------
1594
1595
1596
1597
1598
1599
1600
1601

1602
1603
1604
1605
1606
1607
1608
1605
1606
1607
1608
1609
1610
1611

1612
1613
1614
1615
1616
1617
1618
1619







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
TclpMakeTcpClientChannelMode(
    void *sock,		/* The socket to wrap up into a channel. */
    void *sock,			/* The socket to wrap up into a channel. */
    int mode)			/* OR'ed combination of TCL_READABLE and
				 * TCL_WRITABLE to indicate file mode. */
{
    TcpState *statePtr;
    char channelName[SOCK_CHAN_LENGTH];

    statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState));
1641
1642
1643
1644
1645
1646
1647
1648

1649
1650
1651
1652
1653
1654
1655
1652
1653
1654
1655
1656
1657
1658

1659
1660
1661
1662
1663
1664
1665
1666







-
+








Tcl_Channel
Tcl_OpenTcpServerEx(
    Tcl_Interp *interp,		/* For error reporting - may be NULL. */
    const char *service,	/* Port number to open. */
    const char *myHost,		/* Name of local host. */
    unsigned int flags,		/* Flags. */
    int backlog,                /* Length of OS listen backlog queue. */
    int backlog,		/* Length of OS listen backlog queue. */
    Tcl_TcpAcceptProc *acceptProc,
				/* Callback for accepting connections from new
				 * clients. */
    void *acceptProcData)	/* Data for the callback. */
{
    int status = 0, sock = -1, optvalue, port, chosenport;
    struct addrinfo *addrlist = NULL, *addrPtr;	/* socket address */
1895
1896
1897
1898
1899
1900
1901
1902

1903
1904
1905
1906
1907
1908
1909
1906
1907
1908
1909
1910
1911
1912

1913
1914
1915
1916
1917
1918
1919
1920







-
+







 *	connection acceptance mechanism.
 *
 *----------------------------------------------------------------------
 */

static void
TcpAccept(
    void *data,		/* Callback token. */
    void *data,			/* Callback token. */
    TCL_UNUSED(int) /*mask*/)
{
    TcpFdList *fds = (TcpFdList *)data;	/* Client data of server socket. */
    int newsock;		/* The new client socket */
    TcpState *newSockState;	/* State for new socket. */
    address addr;		/* The remote address */
    socklen_t len;		/* For accept interface */
Changes to unix/tclUnixTest.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14


15
16
17
18
19
20
21
22
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

-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
-







/*
 * tclUnixTest.c --
 *
 *	Contains platform specific test commands for the Unix platform.
 *
 * Copyright © 1996-1997 Sun Microsystems, Inc.
 * Copyright © 1998 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclUnixTest.c --
 *
 *	Contains platform specific test commands for the Unix platform.
 */

#ifndef USE_TCL_STUBS
#undef BUILD_tcl
#undef STATIC_BUILD
#	undef BUILD_tcl
#	undef STATIC_BUILD
#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include "tclInt.h"

/*
 * The headers are needed for the testalarm command that verifies the use of
 * SA_RESTART in signal handlers.
Changes to unix/tclUnixThrd.c.
1
2
3
4
5
6
7
8
9
10
11
12
13















14
15
16
17
18
19
20
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

-
-
-
-








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclUnixThrd.c --
 *
 *	This file implements the UNIX-specific thread support.
 *
 * Copyright © 1991-1994 The Regents of the University of California.
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 * Copyright © 2008 George Peter Staplin
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclUnixThrd.c --
 *
 *	This file implements the UNIX-specific thread support.
 */

#include "tclInt.h"

#if TCL_THREADS

/*
 * TIP #509. Ensures that Tcl's mutexes are reentrant.
 *
209
210
211
212
213
214
215
216
217


218
219
220
221
222
223
224
220
221
222
223
224
225
226


227
228
229
230
231
232
233
234
235







-
-
+
+







 *----------------------------------------------------------------------
 */

int
TclpThreadCreate(
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread */
    void *clientData,	/* The one argument to Main() */
    size_t stackSize,	/* Size of stack for the new thread */
    void *clientData,		/* The one argument to Main() */
    size_t stackSize,		/* Size of stack for the new thread */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
#if TCL_THREADS
    pthread_attr_t attr;
    pthread_t theThread;
    int result;
Changes to unix/tclUnixTime.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclUnixTime.c --
 *
 *	Contains Unix specific versions of Tcl functions that obtain time
 *	values from the operating system.
 *
 * Copyright © 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclUnixTime.c --
 *
 *	Contains Unix specific versions of Tcl functions that obtain time
 *	values from the operating system.
 */

#include "tclInt.h"
#if defined(TCL_WIDE_CLICKS) && defined(MAC_OSX_TCL)
#include <mach/mach_time.h>
#endif

/*
 * Static functions declared in this file.
Changes to unix/tclXtNotify.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclXtNotify.c --
 *
 *	This file contains the notifier driver implementation for the Xt
 *	intrinsics.
 *
 * Copyright © 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclXtNotify.c --
 *
 *	This file contains the notifier driver implementation for the Xt
 *	intrinsics.
 */

#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include <X11/Intrinsic.h>
#include "tclInt.h"

/*
29
30
31
32
33
34
35
36

37
38
39
40
41
42
43
40
41
42
43
44
45
46

47
48
49
50
51
52
53
54







-
+







				 * time FileHandlerEventProc was called for
				 * this file. */
    XtInputId read;		/* Xt read callback handle. */
    XtInputId write;		/* Xt write callback handle. */
    XtInputId except;		/* Xt exception callback handle. */
    Tcl_FileProc *proc;		/* Procedure to call, in the style of
				 * Tcl_CreateFileHandler. */
    void *clientData;	/* Argument to pass to proc. */
    void *clientData;		/* Argument to pass to proc. */
    struct FileHandler *nextPtr;/* Next in list of all files we care about. */
} FileHandler;

/*
 * The following structure is what is added to the Tcl event queue when file
 * handlers are ready to fire.
 */
259
260
261
262
263
264
265
266

267
268
269
270
271
272
273
270
271
272
273
274
275
276

277
278
279
280
281
282
283
284







-
+







 *	Replaces any previous timer.
 *
 *----------------------------------------------------------------------
 */

static void
SetTimer(
    const Tcl_Time *timePtr)		/* Timeout value, may be NULL. */
    const Tcl_Time *timePtr)	/* Timeout value, may be NULL. */
{
    unsigned long timeout;

    if (!initialized) {
	InitNotifier();
    }

335
336
337
338
339
340
341
342

343
344
345
346
347
348
349
346
347
348
349
350
351
352

353
354
355
356
357
358
359
360







-
+







    int fd,			/* Handle of stream to watch. */
    int mask,			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION: indicates
				 * conditions under which proc should be
				 * called. */
    Tcl_FileProc *proc,		/* Procedure to call for each selected
				 * event. */
    void *clientData)	/* Arbitrary data to pass to proc. */
    void *clientData)		/* Arbitrary data to pass to proc. */
{
    FileHandler *filePtr;

    if (!initialized) {
	InitNotifier();
    }

623
624
625
626
627
628
629
630

631
632
633
634
635
636
637
634
635
636
637
638
639
640

641
642
643
644
645
646
647
648







-
+







 *	Queues file events that are detected by the select.
 *
 *----------------------------------------------------------------------
 */

static int
WaitForEvent(
    const Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
    const Tcl_Time *timePtr)	/* Maximum block time, or NULL. */
{
    int timeout;

    if (!initialized) {
	InitNotifier();
    }

Changes to unix/tclXtTest.c.
1
2
3
4
5
6
7
8
9
10
11















12
13
14
15
16
17
18
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

-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclXtTest.c --
 *
 *	Contains commands for Xt notifier specific tests on Unix.
 *
 * Copyright © 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclXtTest.c --
 *
 *	Contains commands for Xt notifier specific tests on Unix.
 */

#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include <X11/Intrinsic.h>
#include "tcl.h"

static Tcl_ObjCmdProc TesteventloopCmd;
Changes to win/Makefile.in.



1



2
3
4
5
6
7
8
1
2
3
4
5
6
7
8
9
10
11
12
13
14
+
+
+

+
+
+







# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file is a Makefile for Tcl.  If it has the name "Makefile.in" then it
# is a template for a Makefile; to generate the actual Makefile, run
# "./configure", which is a configuration script generated by the "autoconf"
# program (constructs like "@foo@" will get replaced in the actual Makefile.

VERSION = @TCL_VERSION@

80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
86
87
88
89
90
91
92





93
94
95
96
97
98
99







-
-
-
-
-







# To change the compiler switches, for example to change from optimization to
# debugging symbols, change the following line:
#CFLAGS =		$(CFLAGS_DEBUG)
#CFLAGS =		$(CFLAGS_OPTIMIZE)
#CFLAGS =		$(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
CFLAGS =		@CFLAGS@ @CFLAGS_DEFAULT@ -DMP_FIXED_CUTOFFS -D__USE_MINGW_ANSI_STDIO=0

# To compile without backward compatibility and deprecated code uncomment the
# following
NO_DEPRECATED_FLAGS	=
#NO_DEPRECATED_FLAGS	= -DTCL_NO_DEPRECATED

# To enable compilation debugging reverse the comment characters on one of the
# following lines.
COMPILE_DEBUG_FLAGS =
#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG
#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS

SRC_DIR			= @srcdir@
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
145
146
147
148
149
150
151

152
153

154
155
156
157
158
159
160







-


-







TCL_VFS_ROOT		= libtcl.vfs


TCL_STUB_LIB_FILE	= @TCL_STUB_LIB_FILE@
TCL_DLL_FILE		= @TCL_DLL_FILE@
TCL_LIB_FILE		= @TCL_LIB_FILE@
DDE_DLL_FILE		= tcl9dde$(DDEVER)${DLLSUFFIX}
DDE_DLL_FILE8		= tcldde$(DDEVER)${DLLSUFFIX}
DDE_LIB_FILE		= @LIBPREFIX@tcldde$(DDEVER)${DLLSUFFIX}${LIBSUFFIX}
REG_DLL_FILE		= tcl9registry$(REGVER)${DLLSUFFIX}
REG_DLL_FILE8		= tclregistry$(REGVER)${DLLSUFFIX}
REG_LIB_FILE		= @LIBPREFIX@tclregistry$(REGVER)${DLLSUFFIX}${LIBSUFFIX}
TEST_DLL_FILE		= tcltest$(VER)${DLLSUFFIX}
TEST_EXE_FILE		= tcltest${EXESUFFIX}
TEST_LIB_FILE		= @LIBPREFIX@tcltest$(VER)${DLLSUFFIX}${LIBSUFFIX}
TEST_LOAD_PRMS		= lappend ::auto_path {$(ROOT_DIR_WIN_NATIVE)/tests};\
			  package ifneeded dde 1.4.5 [list load ${DDE_DLL_FILE}];\
			  package ifneeded registry 1.3.7 [list load ${REG_DLL_FILE}]
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
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







+

















-







${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} -DMP_PREC=4 \
${AC_FLAGS} ${COMPILE_DEBUG_FLAGS}

TCLTEST_OBJS = \
	tclTest.$(OBJEXT) \
	tclTestABSList.$(OBJEXT) \
	tclTestObj.$(OBJEXT) \
	tclTestObjInterface.$(OBJEXT) \
	tclTestProcBodyObj.$(OBJEXT) \
	tclThreadTest.$(OBJEXT) \
	tclWinTest.$(OBJEXT)

GENERIC_OBJS = \
	regcomp.$(OBJEXT) \
	regexec.$(OBJEXT) \
	regfree.$(OBJEXT) \
	regerror.$(OBJEXT) \
	tclAlloc.$(OBJEXT) \
	tclArithSeries.$(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) \
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
356
357
358
359
360
361
362

363
364
365
366
367
368
369







-







	tclProc.$(OBJEXT) \
	tclProcess.$(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) \
527
528
529
530
531
532
533
534

535
536
537
538
539
540
541
525
526
527
528
529
530
531

532
533
534
535
536
537
538
539







-
+








tcltest.sh: tcltest.cmd

tcltest: binaries $(TEST_EXE_FILE) $(TEST_DLL_FILE) $(CAT32) tcltest.cmd

binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions ${TCL_ZIP_FILE} $(TCLSH)

winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE} ${DDE_DLL_FILE8} ${REG_DLL_FILE8}
winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE}

libraries:

doc:

tclzipfile: ${TCL_ZIP_FILE}

606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
604
605
606
607
608
609
610








611
612
613
614
615
616
617







-
-
-
-
-
-
-
-







	@MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${DDE_DLL_FILE}.manifest

${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS}
	@MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${REG_DLL_FILE}.manifest

${DDE_DLL_FILE8}: ${TCL_STUB_LIB_FILE} tcl8WinDde.$(OBJEXT)
	@MAKE_DLL@ tcl8WinDde.$(OBJEXT) $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${DDE_DLL_FILE8}.manifest

${REG_DLL_FILE8}: ${TCL_STUB_LIB_FILE} tcl8WinReg.$(OBJEXT)
	@MAKE_DLL@ -DTCL_MAJOR_VERSION=8 tcl8WinReg.$(OBJEXT) $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${REG_DLL_FILE8}.manifest

${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS}
	@$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE}
	@MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${TEST_DLL_FILE}.manifest

${TEST_EXE_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} tclTestMain.${OBJEXT}
	@$(RM) ${TEST_EXE_FILE}
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
660
661
662
663
664
665
666



667
668
669



670
671
672
673
674
675
676







-
-
-



-
-
-








tclWinPipe.${OBJEXT}: tclWinPipe.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

tclWinReg.${OBJEXT}: tclWinReg.c
	$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

tcl8WinReg.${OBJEXT}: tclWinReg.c
	$(CC)  -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

tclWinDde.${OBJEXT}: tclWinDde.c
	$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

tcl8WinDde.${OBJEXT}: tclWinDde.c
	$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

tclAppInit.${OBJEXT}: tclAppInit.c
	$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME)

tclMainW.${OBJEXT}: tclMain.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME)

# TIP #430, ZipFS Support
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
861
862
863
864
865
866
867




868
869
870
871
872
873
874
875
876
877




878
879
880
881
882
883
884







-
-
-
-










-
-
-
-







	    done
	@if [ -f $(DDE_DLL_FILE) ]; then \
	    echo Installing $(DDE_DLL_FILE); \
	    $(COPY) $(DDE_DLL_FILE) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \
	    $(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \
		"$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \
	    fi
	@if [ -f $(DDE_DLL_FILE8) ]; then \
	    echo Installing $(DDE_DLL_FILE8); \
	    $(COPY) $(DDE_DLL_FILE8) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \
	    fi
	@if [ -f $(DDE_LIB_FILE) ]; then \
	    echo Installing $(DDE_LIB_FILE); \
	    $(COPY) $(DDE_LIB_FILE) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \
	    fi
	@if [ -f $(REG_DLL_FILE) ]; then \
	    echo Installing $(REG_DLL_FILE); \
	    $(COPY) $(REG_DLL_FILE) "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \
	    $(COPY) $(ROOT_DIR)/library/registry/pkgIndex.tcl \
		"$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \
	    fi
	@if [ -f $(REG_DLL_FILE8) ]; then \
	    echo Installing $(REG_DLL_FILE8); \
	    $(COPY) $(REG_DLL_FILE8) "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \
	    fi
	@if [ -f $(REG_LIB_FILE) ]; then \
	    echo Installing $(REG_LIB_FILE); \
	    $(COPY) $(REG_LIB_FILE) "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \
	    fi

install-libraries: libraries install-tzdata install-msgs
	@for i in "$(prefix)/lib" "$(INCLUDE_INSTALL_DIR)" \
1173
1174
1175
1176
1177
1178
1179
1180

1181
1182
1183
1184
1185
1186
1187
1149
1150
1151
1152
1153
1154
1155

1156
1157
1158
1159
1160
1161
1162
1163







-
+







	$(TCL_EXE) "$(TOOL_DIR_NATIVE)/makeHeader.tcl" \
		"$(TOOL_DIR_NATIVE)/tclOOScript.tcl" \
		"$(GENERIC_DIR_NATIVE)/tclOOScript.h"

#
# This target creates the HTML folder for Tcl & Tk and places it in
# DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool
# workspace. It depends on the Tcl & Tk being in directories called tcl9.* &
# workspace. It depends on the Tcl & Tk being in directories called tcl9.*
# tk8.* up two directories from the TOOL_DIR.
#

TOOL_DIR=$(ROOT_DIR)/tools
HTML_INSTALL_DIR=$(ROOT_DIR)/html
html:
	$(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS)"
Changes to win/cat.c.
1
2
3
4
5
6
7
8
9
10
11















12
13
14
15
16
17
18
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

-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * cat.c --
 *
 *	Program used when testing tclWinPipe.c
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * cat.c --
 *
 *	Program used when testing tclWinPipe.c
 */

#ifdef TCL_BROKEN_MAINARGS
/* On mingw32 and cygwin this doesn't work */
#   undef UNICODE
#   undef _UNICODE
#endif

#include <stdio.h>
Deleted win/configure.
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
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
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
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
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
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
4652
4653
4654
4655
4656
4657
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
4738
4739
4740
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
4811
4812
4813
4814
4815
4816
4817
4818
4819
4820
4821
4822
4823
4824
4825
4826
4827
4828
4829
4830
4831
4832
4833
4834
4835
4836
4837
4838
4839
4840
4841
4842
4843
4844
4845
4846
4847
4848
4849
4850
4851
4852
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
4877
4878
4879
4880
4881
4882
4883
4884
4885
4886
4887
4888
4889
4890
4891
4892
4893
4894
4895
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912
4913
4914
4915
4916
4917
4918
4919
4920
4921
4922
4923
4924
4925
4926
4927
4928
4929
4930
4931
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943
4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
4954
4955
4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
4966
4967
4968
4969
4970
4971
4972
4973
4974
4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991
4992
4993
4994
4995
4996
4997
4998
4999
5000
5001
5002
5003
5004
5005
5006
5007
5008
5009
5010
5011
5012
5013
5014
5015
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
5045
5046
5047
5048
5049
5050
5051
5052
5053
5054
5055
5056
5057
5058
5059
5060
5061
5062
5063
5064
5065
5066
5067
5068
5069
5070
5071
5072
5073
5074
5075
5076
5077
5078
5079
5080
5081
5082
5083
5084
5085
5086
5087
5088
5089
5090
5091
5092
5093
5094
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122
5123
5124
5125
5126
5127
5128
5129
5130
5131
5132
5133
5134
5135
5136
5137
5138
5139
5140
5141
5142
5143
5144
5145
5146
5147
5148
5149
5150
5151
5152
5153
5154
5155
5156
5157
5158
5159
5160
5161
5162
5163
5164
5165
5166
5167
5168
5169
5170
5171
5172
5173
5174
5175
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
5191
5192
5193
5194
5195
5196
5197
5198
5199
5200
5201
5202
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
5237
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248
5249
5250
5251
5252
5253
5254
5255
5256
5257
5258
5259
5260
5261
5262
5263
5264
5265
5266
5267
5268
5269
5270
5271
5272
5273
5274
5275
5276
5277
5278
5279
5280
5281
5282
5283
5284
5285
5286
5287
5288
5289
5290
5291
5292
5293
5294
5295
5296
5297
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
5309
5310
5311
5312
5313
5314
5315
5316
5317
5318
5319
5320
5321
5322
5323
5324
5325
5326
5327
5328
5329
5330
5331
5332
5333
5334
5335
5336
5337
5338
5339
5340
5341
5342
5343
5344
5345
5346
5347
5348
5349
5350
5351
5352
5353
5354
5355
5356
5357
5358
5359
5360
5361
5362
5363
5364
5365
5366
5367
5368
5369
5370
5371
5372
5373
5374
5375
5376
5377
5378
5379
5380
5381
5382
5383
5384
5385
5386
5387
5388
5389
5390
5391
5392
5393
5394
5395
5396
5397
5398
5399
5400
5401
5402
5403
5404
5405
5406
5407
5408
5409
5410
5411
5412
5413
5414
5415
5416
5417
5418
5419
5420
5421
5422
5423
5424
5425
5426
5427
5428
5429
5430
5431
5432
5433
5434
5435
5436
5437
5438
5439
5440
5441
5442
5443
5444
5445
5446
5447
5448
5449
5450
5451
5452
5453
5454
5455
5456
5457
5458
5459
5460
5461
5462
5463
5464
5465
5466
5467
5468
5469
5470
5471
5472
5473
5474
5475
5476
5477
5478
5479
5480
5481
5482
5483
5484
5485
5486
5487
5488
5489
5490
5491
5492
5493
5494
5495
5496
5497
5498
5499
5500
5501
5502
5503
5504
5505
5506
5507
5508
5509
5510
5511
5512
5513
5514
5515
5516
5517
5518
5519
5520
5521
5522
5523
5524
5525
5526
5527
5528
5529
5530
5531
5532
5533
5534
5535
5536
5537
5538
5539
5540
5541
5542
5543
5544
5545
5546
5547
5548
5549
5550
5551
5552
5553
5554
5555
5556
5557
5558
5559
5560
5561
5562
5563
5564
5565
5566
5567
5568
5569
5570
5571
5572
5573
5574
5575
5576
5577
5578
5579
5580
5581
5582
5583
5584
5585
5586
5587
5588
5589
5590
5591
5592
5593
5594
5595
5596
5597
5598
5599
5600
5601
5602
5603
5604
5605
5606
5607
5608
5609
5610
5611
5612
5613
5614
5615
5616
5617
5618
5619
5620
5621
5622
5623
5624
5625
5626
5627
5628
5629
5630
5631
5632
5633
5634
5635
5636
5637
5638
5639
5640
5641
5642
5643
5644
5645
5646
5647
5648
5649
5650
5651
5652
5653
5654
5655
5656
5657
5658
5659
5660
5661
5662
5663
5664
5665
5666
5667
5668
5669
5670
5671
5672
5673
5674
5675
5676
5677
5678
5679
5680
5681
5682
5683
5684
5685
5686
5687
5688
5689
5690
5691
5692
5693
5694
5695
5696
5697
5698
5699
5700
5701
5702
5703
5704
5705
5706
5707
5708
5709
5710
5711
5712
5713
5714
5715
5716
5717
5718
5719
5720
5721
5722
5723
5724
5725
5726
5727
5728
5729
5730
5731
5732
5733
5734
5735
5736
5737
5738
5739
5740
5741
5742
5743
5744
5745
5746
5747
5748
5749
5750
5751
5752
5753
5754
5755
5756
5757
5758
5759
5760
5761
5762
5763
5764
5765
5766
5767
5768
5769
5770
5771
5772
5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789
5790
5791
5792
5793
5794
5795
5796
5797
5798
5799
5800
5801
5802
5803
5804
5805
5806
5807
5808
5809
5810
5811
5812
5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
5834
5835
5836
5837
5838
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
5849
5850
5851
5852
5853
5854
5855
5856
5857
5858
5859
5860
5861
5862
5863
5864
5865
5866
5867
5868
5869
5870
5871
5872
5873
5874
5875
5876
5877
5878
5879
5880
5881
5882
5883
5884
5885
5886
5887
5888
5889
5890
5891
5892
5893
5894
5895
5896
5897
5898
5899
5900
5901
5902
5903
5904
5905
5906
5907
5908
5909
5910
5911
5912
5913
5914
5915
5916
5917
5918
5919
5920
5921
5922
5923
5924
5925
5926
5927
5928
5929
5930
5931
5932
5933
5934
5935
5936
5937
5938
5939
5940
5941
5942
5943
5944
5945
5946
5947
5948
5949
5950
5951
5952
5953
5954
5955
5956
5957
5958
5959
5960
5961
5962
5963
5964
5965
5966
5967
5968
5969
5970
5971
5972
5973
5974
5975
5976
5977
5978
5979
5980
5981
5982
5983
5984
5985
5986
5987
5988
5989
5990
5991
5992
5993
5994
5995
5996
5997
5998
5999
6000
6001
6002
6003
6004
6005
6006
6007
6008
6009
6010
6011
6012
6013
6014
6015
6016
6017
6018
6019
6020
6021
6022
6023
6024
6025
6026
6027
6028
6029
6030
6031
6032
6033
6034
6035
6036
6037
6038
6039
6040
6041
6042
6043
6044
6045
6046
6047
6048
6049
6050
6051
6052
6053
6054
6055
6056
6057
6058
6059
6060
6061
6062
6063
6064
6065
6066
6067
6068
6069
6070
6071
6072
6073
6074
6075
6076
6077
6078
6079
6080
6081
6082
6083
6084
6085
6086
6087
6088
6089
6090
6091
6092
6093
6094
6095
6096
6097
6098
6099
6100
6101
6102
6103
6104
6105
6106
6107
6108
6109
6110
6111
6112
6113
6114
6115
6116
6117
6118
6119
6120
6121
6122
6123
6124
6125
6126
6127
6128
6129
6130
6131
6132
6133
6134
6135
6136
6137
6138
6139
6140
6141
6142
6143
6144
6145
6146
6147
6148
6149
6150
6151
6152
6153
6154
6155
6156
6157
6158
6159
6160
6161
6162
6163
6164
6165
6166
6167
6168
6169
6170
6171
6172
6173
6174
6175
6176
6177
6178
6179
6180
6181
6182
6183
6184
6185
6186
6187
6188
6189
6190
6191
6192
6193
6194
6195
6196
6197
6198
6199
6200
6201
6202
6203
6204
6205
6206
6207
6208
6209
6210
6211
6212
6213
6214
6215
6216
6217
6218
6219
6220
6221
6222
6223
6224
6225
6226
6227
6228
6229
6230
6231
6232
6233
6234
6235
6236
6237
6238
6239
6240
6241
6242
6243
6244
6245
6246
6247
6248
6249
6250
6251
6252
6253
6254
6255
6256
6257
6258
6259
6260
6261
6262
6263
6264
6265
6266
6267
6268
6269
6270
6271
6272
6273
6274
6275
6276
6277
6278
6279
6280
6281
6282
6283
6284
6285
6286
6287
6288
6289
6290
6291
6292
6293
6294
6295
6296
6297
6298
6299
6300
6301
6302
6303
6304
6305
6306
6307
6308
6309
6310
6311
6312
6313
6314
6315
6316
6317
6318
6319
6320
6321
6322
6323
6324
6325
6326
6327
6328
6329
6330
6331
6332
6333
6334
6335
6336
6337
6338
6339
6340
6341
6342
6343
6344
6345
6346
6347
6348
6349
6350
6351
6352
6353
6354
6355
6356
6357
6358
6359
6360
6361
6362
6363
6364
6365
6366
6367
6368
6369
6370
6371
6372
6373
6374
6375
6376
6377
6378
6379
6380
6381
6382
6383
6384
6385
6386
6387
6388
6389
6390
6391
6392
6393
6394
6395
6396
6397
6398
6399
6400
6401
6402
6403
6404
6405
6406
6407
6408
6409
6410
6411
6412
6413
6414
6415
6416
6417
6418
6419
6420
6421
6422
6423
6424
6425
6426
6427
6428
6429
6430
6431
6432
6433
6434
6435
6436
6437
6438
6439
6440
6441
6442
6443
6444
6445
6446
6447
6448
6449
6450
6451
6452
6453
6454
6455
6456
6457
6458
6459
6460
6461
6462
6463
6464
6465
6466
6467
6468
6469
6470
6471
6472
6473
6474
6475
6476
6477
6478
6479
6480
6481
6482
6483
6484
6485
6486
6487
6488
6489
6490
6491
6492
6493
6494
6495
6496
6497
6498
6499
6500
6501
6502
6503
6504
6505
6506
6507
6508
6509
6510
6511
6512
6513
6514
6515
6516
6517
6518
6519
6520
6521
6522
6523
6524
6525
6526
6527
6528
6529
6530
6531
6532
6533
6534
6535
6536
6537
6538
6539
6540
6541
6542
6543
6544
6545
6546
6547
6548
6549
6550
6551
6552
6553
6554
6555
6556
6557
6558
6559
6560
6561
6562
6563
6564
6565
6566
6567
6568
6569
6570
6571
6572
6573
6574
6575
6576
6577
6578
6579
6580
6581
6582
6583
6584
6585
6586
6587
6588
6589
6590
6591
6592
6593
6594
6595
6596
6597
6598
6599
6600
6601
6602
6603
6604
6605
6606
6607
6608
6609
6610
6611
6612
6613
6614
6615
6616
6617
6618
6619
6620
6621
6622
6623
6624
6625
6626
6627
6628
6629
6630
6631
6632
6633
6634
6635
6636
6637
6638
6639
6640
6641
6642
6643
6644
6645
6646
6647
6648
6649
6650
6651
6652
6653
6654
6655
6656
6657
6658
6659
6660
6661
6662
6663
6664
6665
6666
6667
6668
6669
6670
6671
6672
6673
6674
6675
6676
6677
6678
6679
6680
6681
6682
6683
6684
6685
6686
6687
6688
6689
6690
6691
6692
6693
6694
6695
6696
6697
6698
6699
6700
6701
6702
6703
6704
6705
6706
6707
6708
6709
6710
6711
6712
6713
6714
6715
6716
6717
6718
6719
6720
6721
6722
6723
6724
6725
6726
6727
6728
6729
6730
6731
6732
6733
6734
6735
6736
6737
6738
6739
6740
6741
6742
6743
6744
6745
6746
6747
6748
6749
6750
6751
6752
6753
6754
6755
6756
6757
6758
6759
6760
6761
6762
6763
6764
6765
6766
6767
6768
6769
6770
6771
6772
6773
6774
6775
6776
6777
6778
6779
6780
6781
6782
6783
6784
6785
6786
6787
6788
6789
6790
6791
6792
6793
6794
6795
6796
6797
6798
6799
6800
6801
6802
6803
6804
6805
6806
6807
6808
6809
6810
6811
6812
6813
6814
6815
6816
6817
6818
6819
6820
6821
6822
6823
6824
6825
6826
6827
6828
6829
6830
6831
6832
6833
6834
6835
6836
6837
6838
6839
6840
6841
6842
6843
6844
6845
6846
6847
6848
6849
6850
6851
6852
6853
6854
6855
6856
6857
6858
6859
6860
6861
6862
6863
6864
6865
6866
6867
6868
6869
6870
6871
6872
6873
6874
6875
6876
6877
6878
6879
6880
6881
6882
6883
6884
6885
6886
6887
6888
6889
6890
6891
6892
6893
6894
6895
6896
6897
6898
6899
6900
6901
6902
6903
6904
6905
6906
6907
6908
6909
6910
6911
6912
6913
6914
6915
6916
6917
6918
6919
6920
6921
6922
6923
6924
6925
6926
6927
6928
6929
6930
6931
6932
6933
6934
6935
6936
6937
6938
6939
6940
6941
6942
6943
6944
6945
6946
6947
6948
6949
6950
6951
6952
6953
6954
6955
6956
6957
6958
6959
6960
6961
6962
6963
6964
6965
6966
6967
6968
6969
6970
6971
6972
6973
6974
6975
6976
6977
6978
6979
6980
6981
6982
6983
6984
6985
6986
6987
6988
6989
6990
6991
6992
6993
6994
6995
6996
6997
6998
6999
7000
7001
7002
7003
7004
7005
7006
7007
7008
7009
7010
7011
7012
7013
7014
7015
7016
7017
7018
7019
7020
7021
7022
7023
7024
7025
7026
7027
7028
7029
7030
7031
7032
7033
7034
7035
7036
7037
7038
7039
7040
7041
7042
7043
7044
7045
7046
7047
7048
7049
7050
7051
7052
7053
7054
7055
7056
7057
7058
7059
7060
7061
7062
7063
7064
7065
7066
7067
7068
7069
7070
7071
7072
7073
7074
7075
7076
7077
7078
7079
7080
7081
7082
7083
7084
7085
7086
7087
7088
7089
7090
7091
7092
7093
7094
7095
7096
7097
7098
7099
7100
7101
7102
7103
7104
7105
7106
7107
7108
7109
7110
7111
7112
7113
7114
7115
7116
7117
7118
7119
7120
7121
7122
7123
7124
7125
7126
7127
7128
7129
7130
7131
7132
7133
7134
7135
7136
7137
7138
7139
7140
7141
7142
7143
7144
7145
7146
7147
7148
7149
7150
7151
7152
7153
7154
7155
7156
7157
7158
7159
7160
7161
7162
7163
7164
7165
7166
7167
7168
































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.72 for tcl 9.0.
#
#
# Copyright (C) 1992-1996, 1998-2017, 2020-2023 Free Software Foundation,
# Inc.
#
#
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
## -------------------- ##
## M4sh Initialization. ##
## -------------------- ##

# Be more Bourne compatible
DUALCASE=1; export DUALCASE # for MKS sh
if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1
then :
  emulate sh
  NULLCMD=:
  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
  # is contrary to our usage.  Disable this feature.
  alias -g '${1+"$@"}'='"$@"'
  setopt NO_GLOB_SUBST
else case e in #(
  e) case `(set -o) 2>/dev/null` in #(
  *posix*) :
    set -o posix ;; #(
  *) :
     ;;
esac ;;
esac
fi



# Reset variables that may have inherited troublesome values from
# the environment.

# IFS needs to be set, to space, tab, and newline, in precisely that order.
# (If _AS_PATH_WALK were called with IFS unset, it would have the
# side effect of setting IFS to empty, thus disabling word splitting.)
# Quoting is to prevent editors from complaining about space-tab.
as_nl='
'
export as_nl
IFS=" ""	$as_nl"

PS1='$ '
PS2='> '
PS4='+ '

# Ensure predictable behavior from utilities with locale-dependent output.
LC_ALL=C
export LC_ALL
LANGUAGE=C
export LANGUAGE

# We cannot yet rely on "unset" to work, but we need these variables
# to be unset--not just set to an empty or harmless value--now, to
# avoid bugs in old shells (e.g. pre-3.0 UWIN ksh).  This construct
# also avoids known problems related to "unset" and subshell syntax
# in other old shells (e.g. bash 2.01 and pdksh 5.2.14).
for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH
do eval test \${$as_var+y} \
  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
done

# Ensure that fds 0, 1, and 2 are open.
if (exec 3>&0) 2>/dev/null; then :; else exec 0</dev/null; fi
if (exec 3>&1) 2>/dev/null; then :; else exec 1>/dev/null; fi
if (exec 3>&2)            ; then :; else exec 2>/dev/null; fi

# The user is always right.
if ${PATH_SEPARATOR+false} :; then
  PATH_SEPARATOR=:
  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
      PATH_SEPARATOR=';'
  }
fi


# Find who we are.  Look in the path if we contain no directory separator.
as_myself=
case $0 in #((
  *[\\/]* ) as_myself=$0 ;;
  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  case $as_dir in #(((
    '') as_dir=./ ;;
    */) ;;
    *) as_dir=$as_dir/ ;;
  esac
    test -r "$as_dir$0" && as_myself=$as_dir$0 && break
  done
IFS=$as_save_IFS

     ;;
esac
# We did not find ourselves, most probably we were run as 'sh COMMAND'
# in which case we are not to be found in the path.
if test "x$as_myself" = x; then
  as_myself=$0
fi
if test ! -f "$as_myself"; then
  printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
  exit 1
fi


# Use a proper internal environment variable to ensure we don't fall
  # into an infinite loop, continuously re-executing ourselves.
  if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then
    _as_can_reexec=no; export _as_can_reexec;
    # We cannot yet assume a decent shell, so we have to provide a
# neutralization value for shells without unset; and this also
# works around shells that cannot unset nonexistent variables.
# Preserve -v and -x to the replacement shell.
BASH_ENV=/dev/null
ENV=/dev/null
(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
case $- in # ((((
  *v*x* | *x*v* ) as_opts=-vx ;;
  *v* ) as_opts=-v ;;
  *x* ) as_opts=-x ;;
  * ) as_opts= ;;
esac
exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
# Admittedly, this is quite paranoid, since all the known shells bail
# out after a failed 'exec'.
printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2
exit 255
  fi
  # We don't want this to propagate to other subprocesses.
          { _as_can_reexec=; unset _as_can_reexec;}
if test "x$CONFIG_SHELL" = x; then
  as_bourne_compatible="if test \${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1
then :
  emulate sh
  NULLCMD=:
  # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which
  # is contrary to our usage.  Disable this feature.
  alias -g '\${1+\"\$@\"}'='\"\$@\"'
  setopt NO_GLOB_SUBST
else case e in #(
  e) case \`(set -o) 2>/dev/null\` in #(
  *posix*) :
    set -o posix ;; #(
  *) :
     ;;
esac ;;
esac
fi
"
  as_required="as_fn_return () { (exit \$1); }
as_fn_success () { as_fn_return 0; }
as_fn_failure () { as_fn_return 1; }
as_fn_ret_success () { return 0; }
as_fn_ret_failure () { return 1; }

exitcode=0
as_fn_success || { exitcode=1; echo as_fn_success failed.; }
as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; }
as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; }
as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; }
if ( set x; as_fn_ret_success y && test x = \"\$1\" )
then :

else case e in #(
  e) exitcode=1; echo positional parameters were not saved. ;;
esac
fi
test x\$exitcode = x0 || exit 1
blah=\$(echo \$(echo blah))
test x\"\$blah\" = xblah || exit 1
test -x / || exit 1"
  as_suggested="  as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO
  as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO
  eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&
  test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1
test \$(( 1 + 1 )) = 2 || exit 1"
  if (eval "$as_required") 2>/dev/null
then :
  as_have_required=yes
else case e in #(
  e) as_have_required=no ;;
esac
fi
  if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null
then :

else case e in #(
  e) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
as_found=false
for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
do
  IFS=$as_save_IFS
  case $as_dir in #(((
    '') as_dir=./ ;;
    */) ;;
    *) as_dir=$as_dir/ ;;
  esac
  as_found=:
  case $as_dir in #(
	 /*)
	   for as_base in sh bash ksh sh5; do
	     # Try only shells that exist, to save several forks.
	     as_shell=$as_dir$as_base
	     if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&
		    as_run=a "$as_shell" -c "$as_bourne_compatible""$as_required" 2>/dev/null
then :
  CONFIG_SHELL=$as_shell as_have_required=yes
		   if as_run=a "$as_shell" -c "$as_bourne_compatible""$as_suggested" 2>/dev/null
then :
  break 2
fi
fi
	   done;;
       esac
  as_found=false
done
IFS=$as_save_IFS
if $as_found
then :

else case e in #(
  e) if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&
	      as_run=a "$SHELL" -c "$as_bourne_compatible""$as_required" 2>/dev/null
then :
  CONFIG_SHELL=$SHELL as_have_required=yes
fi ;;
esac
fi


      if test "x$CONFIG_SHELL" != x
then :
  export CONFIG_SHELL
             # We cannot yet assume a decent shell, so we have to provide a
# neutralization value for shells without unset; and this also
# works around shells that cannot unset nonexistent variables.
# Preserve -v and -x to the replacement shell.
BASH_ENV=/dev/null
ENV=/dev/null
(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
case $- in # ((((
  *v*x* | *x*v* ) as_opts=-vx ;;
  *v* ) as_opts=-v ;;
  *x* ) as_opts=-x ;;
  * ) as_opts= ;;
esac
exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
# Admittedly, this is quite paranoid, since all the known shells bail
# out after a failed 'exec'.
printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2
exit 255
fi

    if test x$as_have_required = xno
then :
  printf "%s\n" "$0: This script requires a shell more modern than all"
  printf "%s\n" "$0: the shells that I found on your system."
  if test ${ZSH_VERSION+y} ; then
    printf "%s\n" "$0: In particular, zsh $ZSH_VERSION has bugs and should"
    printf "%s\n" "$0: be upgraded to zsh 4.3.4 or later."
  else
    printf "%s\n" "$0: Please tell bug-autoconf@gnu.org about your system,
$0: including any error possibly output before this
$0: message. Then install a modern shell, or manually run
$0: the script under such a shell if you do have one."
  fi
  exit 1
fi ;;
esac
fi
fi
SHELL=${CONFIG_SHELL-/bin/sh}
export SHELL
# Unset more variables known to interfere with behavior of common tools.
CLICOLOR_FORCE= GREP_OPTIONS=
unset CLICOLOR_FORCE GREP_OPTIONS

## --------------------- ##
## M4sh Shell Functions. ##
## --------------------- ##
# as_fn_unset VAR
# ---------------
# Portably unset VAR.
as_fn_unset ()
{
  { eval $1=; unset $1;}
}
as_unset=as_fn_unset


# as_fn_set_status STATUS
# -----------------------
# Set $? to STATUS, without forking.
as_fn_set_status ()
{
  return $1
} # as_fn_set_status

# as_fn_exit STATUS
# -----------------
# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
as_fn_exit ()
{
  set +e
  as_fn_set_status $1
  exit $1
} # as_fn_exit

# as_fn_mkdir_p
# -------------
# Create "$as_dir" as a directory, including parents if necessary.
as_fn_mkdir_p ()
{

  case $as_dir in #(
  -*) as_dir=./$as_dir;;
  esac
  test -d "$as_dir" || eval $as_mkdir_p || {
    as_dirs=
    while :; do
      case $as_dir in #(
      *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
      *) as_qdir=$as_dir;;
      esac
      as_dirs="'$as_qdir' $as_dirs"
      as_dir=`$as_dirname -- "$as_dir" ||
$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
	 X"$as_dir" : 'X\(//\)[^/]' \| \
	 X"$as_dir" : 'X\(//\)$' \| \
	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
printf "%s\n" X"$as_dir" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)[^/].*/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\).*/{
	    s//\1/
	    q
	  }
	  s/.*/./; q'`
      test -d "$as_dir" && break
    done
    test -z "$as_dirs" || eval "mkdir $as_dirs"
  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"


} # as_fn_mkdir_p

# as_fn_executable_p FILE
# -----------------------
# Test if FILE is an executable regular file.
as_fn_executable_p ()
{
  test -f "$1" && test -x "$1"
} # as_fn_executable_p
# as_fn_append VAR VALUE
# ----------------------
# Append the text in VALUE to the end of the definition contained in VAR. Take
# advantage of any shell optimizations that allow amortized linear growth over
# repeated appends, instead of the typical quadratic growth present in naive
# implementations.
if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null
then :
  eval 'as_fn_append ()
  {
    eval $1+=\$2
  }'
else case e in #(
  e) as_fn_append ()
  {
    eval $1=\$$1\$2
  } ;;
esac
fi # as_fn_append

# as_fn_arith ARG...
# ------------------
# Perform arithmetic evaluation on the ARGs, and store the result in the
# global $as_val. Take advantage of shells that can avoid forks. The arguments
# must be portable across $(()) and expr.
if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null
then :
  eval 'as_fn_arith ()
  {
    as_val=$(( $* ))
  }'
else case e in #(
  e) as_fn_arith ()
  {
    as_val=`expr "$@" || test $? -eq 1`
  } ;;
esac
fi # as_fn_arith


# as_fn_error STATUS ERROR [LINENO LOG_FD]
# ----------------------------------------
# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
# script with STATUS, using 1 if that was 0.
as_fn_error ()
{
  as_status=$1; test $as_status -eq 0 && as_status=1
  if test "$4"; then
    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
    printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
  fi
  printf "%s\n" "$as_me: error: $2" >&2
  as_fn_exit $as_status
} # as_fn_error

if expr a : '\(a\)' >/dev/null 2>&1 &&
   test "X`expr 00001 : '.*\(...\)'`" = X001; then
  as_expr=expr
else
  as_expr=false
fi

if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
  as_basename=basename
else
  as_basename=false
fi

if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
  as_dirname=dirname
else
  as_dirname=false
fi

as_me=`$as_basename -- "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
	 X"$0" : 'X\(//\)$' \| \
	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
printf "%s\n" X/"$0" |
    sed '/^.*\/\([^/][^/]*\)\/*$/{
	    s//\1/
	    q
	  }
	  /^X\/\(\/\/\)$/{
	    s//\1/
	    q
	  }
	  /^X\/\(\/\).*/{
	    s//\1/
	    q
	  }
	  s/.*/./; q'`

# Avoid depending upon Character Ranges.
as_cr_letters='abcdefghijklmnopqrstuvwxyz'
as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
as_cr_Letters=$as_cr_letters$as_cr_LETTERS
as_cr_digits='0123456789'
as_cr_alnum=$as_cr_Letters$as_cr_digits


  as_lineno_1=$LINENO as_lineno_1a=$LINENO
  as_lineno_2=$LINENO as_lineno_2a=$LINENO
  eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" &&
  test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || {
  # Blame Lee E. McMahon (1931-1989) for sed's syntax.  :-)
  sed -n '
    p
    /[$]LINENO/=
  ' <$as_myself |
    sed '
      t clear
      :clear
      s/[$]LINENO.*/&-/
      t lineno
      b
      :lineno
      N
      :loop
      s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/
      t loop
      s/-\n.*//
    ' >$as_me.lineno &&
  chmod +x "$as_me.lineno" ||
    { printf "%s\n" "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }

  # If we had to re-execute with $CONFIG_SHELL, we're ensured to have
  # already done that, so ensure we don't try to do so again and fall
  # in an infinite loop.  This has already happened in practice.
  _as_can_reexec=no; export _as_can_reexec
  # Don't try to exec as it changes $[0], causing all sort of problems
  # (the dirname of $[0] is not the place where we might find the
  # original and so on.  Autoconf is especially sensitive to this).
  . "./$as_me.lineno"
  # Exit status is that of the last command.
  exit
}


# Determine whether it's possible to make 'echo' print without a newline.
# These variables are no longer used directly by Autoconf, but are AC_SUBSTed
# for compatibility with existing Makefiles.
ECHO_C= ECHO_N= ECHO_T=
case `echo -n x` in #(((((
-n*)
  case `echo 'xy\c'` in
  *c*) ECHO_T='	';;	# ECHO_T is single tab character.
  xy)  ECHO_C='\c';;
  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null
       ECHO_T='	';;
  esac;;
*)
  ECHO_N='-n';;
esac

# For backward compatibility with old third-party macros, we provide
# the shell variables $as_echo and $as_echo_n.  New code should use
# AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively.
as_echo='printf %s\n'
as_echo_n='printf %s'

rm -f conf$$ conf$$.exe conf$$.file
if test -d conf$$.dir; then
  rm -f conf$$.dir/conf$$.file
else
  rm -f conf$$.dir
  mkdir conf$$.dir 2>/dev/null
fi
if (echo >conf$$.file) 2>/dev/null; then
  if ln -s conf$$.file conf$$ 2>/dev/null; then
    as_ln_s='ln -s'
    # ... but there are two gotchas:
    # 1) On MSYS, both 'ln -s file dir' and 'ln file dir' fail.
    # 2) DJGPP < 2.04 has no symlinks; 'ln -s' creates a wrapper executable.
    # In both cases, we have to default to 'cp -pR'.
    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
      as_ln_s='cp -pR'
  elif ln conf$$.file conf$$ 2>/dev/null; then
    as_ln_s=ln
  else
    as_ln_s='cp -pR'
  fi
else
  as_ln_s='cp -pR'
fi
rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
rmdir conf$$.dir 2>/dev/null

if mkdir -p . 2>/dev/null; then
  as_mkdir_p='mkdir -p "$as_dir"'
else
  test -d ./-p && rmdir ./-p
  as_mkdir_p=false
fi

as_test_x='test -x'
as_executable_p=as_fn_executable_p

# Sed expression to map a string onto a valid CPP name.
as_sed_cpp="y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g"
as_tr_cpp="eval sed '$as_sed_cpp'" # deprecated

# Sed expression to map a string onto a valid variable name.
as_sed_sh="y%*+%pp%;s%[^_$as_cr_alnum]%_%g"
as_tr_sh="eval sed '$as_sed_sh'" # deprecated


test -n "$DJDIR" || exec 7<&0 </dev/null
exec 6>&1

# Name of the host.
# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status,
# so uname gets run too.
ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`

#
# Initializations.
#
ac_default_prefix=/usr/local
ac_clean_files=
ac_config_libobj_dir=.
LIBOBJS=
cross_compiling=no
subdirs=
MFLAGS=
MAKEFLAGS=

# Identity of this package.
PACKAGE_NAME='tcl'
PACKAGE_TARNAME='tcl'
PACKAGE_VERSION='9.0'
PACKAGE_STRING='tcl 9.0'
PACKAGE_BUGREPORT=''
PACKAGE_URL=''

ac_unique_file="../generic/tcl.h"
# Factoring default headers for most tests.
ac_includes_default="\
#include <stddef.h>
#ifdef HAVE_STDIO_H
# include <stdio.h>
#endif
#ifdef HAVE_STDLIB_H
# include <stdlib.h>
#endif
#ifdef HAVE_STRING_H
# include <string.h>
#endif
#ifdef HAVE_INTTYPES_H
# include <inttypes.h>
#endif
#ifdef HAVE_STDINT_H
# include <stdint.h>
#endif
#ifdef HAVE_STRINGS_H
# include <strings.h>
#endif
#ifdef HAVE_SYS_TYPES_H
# include <sys/types.h>
#endif
#ifdef HAVE_SYS_STAT_H
# include <sys/stat.h>
#endif
#ifdef HAVE_UNISTD_H
# include <unistd.h>
#endif"

ac_header_c_list=
ac_subst_vars='LTLIBOBJS
LIBOBJS
RES
RC_DEFINES
RC_DEFINE
RC_INCLUDE
RC_TYPE
RC_OUT
TCL_REG_MINOR_VERSION
TCL_REG_MAJOR_VERSION
TCL_REG_VERSION
TCL_DDE_MINOR_VERSION
TCL_DDE_MAJOR_VERSION
TCL_DDE_VERSION
TCL_PACKAGE_PATH
TCL_BUILD_LIB_SPEC
MAKE_EXE
MAKE_DLL
POST_MAKE_LIB
MAKE_STUB_LIB
MAKE_LIB
LIBRARIES
EXESUFFIX
LIBSUFFIX
LIBPREFIX
DLLSUFFIX
LIBS_GUI
TCL_SHARED_BUILD
SHLIB_SUFFIX
SHLIB_CFLAGS
SHLIB_LD_LIBS
SHLIB_LD
STLIB_LD
LDFLAGS_WINDOW
LDFLAGS_CONSOLE
LDFLAGS_OPTIMIZE
LDFLAGS_DEBUG
CC_EXENAME
CC_OBJNAME
DEPARG
EXTRA_CFLAGS
CFG_TCL_UNSHARED_LIB_SUFFIX
CFG_TCL_SHARED_LIB_SUFFIX
TCL_BIN_DIR
TCL_SRC_DIR
TCL_DLL_FILE
TCL_BUILD_STUB_LIB_PATH
TCL_BUILD_STUB_LIB_SPEC
TCL_INCLUDE_SPEC
TCL_STUB_LIB_PATH
TCL_STUB_LIB_SPEC
TCL_STUB_LIB_FLAG
TCL_STUB_LIB_FILE
TCL_LIB_SPEC
TCL_IMPORT_LIB_FLAG
TCL_IMPORT_LIB_FILE
TCL_STATIC_LIB_FLAG
TCL_STATIC_LIB_FILE
TCL_LIB_FLAG
TCL_LIB_FILE
TCL_EXE
PKG_CFG_ARGS
TCL_PATCH_LEVEL
TCL_MINOR_VERSION
TCL_MAJOR_VERSION
TCL_VERSION
MACHINE
TCL_WIN_VERSION
VC_MANIFEST_EMBED_EXE
VC_MANIFEST_EMBED_DLL
CPP
LDFLAGS_DEFAULT
CFLAGS_DEFAULT
INSTALL_MSGS
INSTALL_LIBRARIES
TCL_ZIP_FILE
ZIPFS_BUILD
ZIP_INSTALL_OBJS
ZIP_PROG_VFSSEARCH
ZIP_PROG_OPTIONS
ZIP_PROG
TCLSH_PROG
EXEEXT_FOR_BUILD
CC_FOR_BUILD
TCL_TOMMATH_LIB_NAME
TCL_ZLIB_LIB_NAME
TOMMATH_OBJS
ZLIB_OBJS
TOMMATH_LIBS
ZLIB_LIBS
TOMMATH_DLL_FILE
ZLIB_DLL_FILE
CFLAGS_NOLTO
CFLAGS_WARNING
CFLAGS_OPTIMIZE
CFLAGS_DEBUG
DL_LIBS
WINE
CYGPATH
SHARED_BUILD
SET_MAKE
RC
RANLIB
AR
OBJEXT
EXEEXT
ac_ct_CC
CPPFLAGS
LDFLAGS
CFLAGS
CC
target_alias
host_alias
build_alias
LIBS
ECHO_T
ECHO_N
ECHO_C
DEFS
mandir
localedir
libdir
psdir
pdfdir
dvidir
htmldir
infodir
docdir
oldincludedir
includedir
runstatedir
localstatedir
sharedstatedir
sysconfdir
datadir
datarootdir
libexecdir
sbindir
bindir
program_transform_name
prefix
exec_prefix
PACKAGE_URL
PACKAGE_BUGREPORT
PACKAGE_STRING
PACKAGE_VERSION
PACKAGE_TARNAME
PACKAGE_NAME
PATH_SEPARATOR
SHELL
OBJEXT_FOR_BUILD'
ac_subst_files=''
ac_user_opts='
enable_option_checking
with_encoding
enable_shared
enable_64bit
enable_zipfs
enable_symbols
enable_embedded_manifest
'
      ac_precious_vars='build_alias
host_alias
target_alias
CC
CFLAGS
LDFLAGS
LIBS
CPPFLAGS
CPP'


# Initialize some variables set by options.
ac_init_help=
ac_init_version=false
ac_unrecognized_opts=
ac_unrecognized_sep=
# The variables have the same names as the options, with
# dashes changed to underlines.
cache_file=/dev/null
exec_prefix=NONE
no_create=
no_recursion=
prefix=NONE
program_prefix=NONE
program_suffix=NONE
program_transform_name=s,x,x,
silent=
site=
srcdir=
verbose=
x_includes=NONE
x_libraries=NONE

# Installation directory options.
# These are left unexpanded so users can "make install exec_prefix=/foo"
# and all the variables that are supposed to be based on exec_prefix
# by default will actually change.
# Use braces instead of parens because sh, perl, etc. also accept them.
# (The list follows the same order as the GNU Coding Standards.)
bindir='${exec_prefix}/bin'
sbindir='${exec_prefix}/sbin'
libexecdir='${exec_prefix}/libexec'
datarootdir='${prefix}/share'
datadir='${datarootdir}'
sysconfdir='${prefix}/etc'
sharedstatedir='${prefix}/com'
localstatedir='${prefix}/var'
runstatedir='${localstatedir}/run'
includedir='${prefix}/include'
oldincludedir='/usr/include'
docdir='${datarootdir}/doc/${PACKAGE_TARNAME}'
infodir='${datarootdir}/info'
htmldir='${docdir}'
dvidir='${docdir}'
pdfdir='${docdir}'
psdir='${docdir}'
libdir='${exec_prefix}/lib'
localedir='${datarootdir}/locale'
mandir='${datarootdir}/man'

ac_prev=
ac_dashdash=
for ac_option
do
  # If the previous option needs an argument, assign it.
  if test -n "$ac_prev"; then
    eval $ac_prev=\$ac_option
    ac_prev=
    continue
  fi

  case $ac_option in
  *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;
  *=)   ac_optarg= ;;
  *)    ac_optarg=yes ;;
  esac

  case $ac_dashdash$ac_option in
  --)
    ac_dashdash=yes ;;

  -bindir | --bindir | --bindi | --bind | --bin | --bi)
    ac_prev=bindir ;;
  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
    bindir=$ac_optarg ;;

  -build | --build | --buil | --bui | --bu)
    ac_prev=build_alias ;;
  -build=* | --build=* | --buil=* | --bui=* | --bu=*)
    build_alias=$ac_optarg ;;

  -cache-file | --cache-file | --cache-fil | --cache-fi \
  | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
    ac_prev=cache_file ;;
  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
    cache_file=$ac_optarg ;;

  --config-cache | -C)
    cache_file=config.cache ;;

  -datadir | --datadir | --datadi | --datad)
    ac_prev=datadir ;;
  -datadir=* | --datadir=* | --datadi=* | --datad=*)
    datadir=$ac_optarg ;;

  -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \
  | --dataroo | --dataro | --datar)
    ac_prev=datarootdir ;;
  -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \
  | --dataroot=* | --dataroo=* | --dataro=* | --datar=*)
    datarootdir=$ac_optarg ;;

  -disable-* | --disable-*)
    ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
    # Reject names that are not valid shell variable names.
    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
      as_fn_error $? "invalid feature name: '$ac_useropt'"
    ac_useropt_orig=$ac_useropt
    ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'`
    case $ac_user_opts in
      *"
"enable_$ac_useropt"
"*) ;;
      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig"
	 ac_unrecognized_sep=', ';;
    esac
    eval enable_$ac_useropt=no ;;

  -docdir | --docdir | --docdi | --doc | --do)
    ac_prev=docdir ;;
  -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)
    docdir=$ac_optarg ;;

  -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)
    ac_prev=dvidir ;;
  -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)
    dvidir=$ac_optarg ;;

  -enable-* | --enable-*)
    ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
    # Reject names that are not valid shell variable names.
    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
      as_fn_error $? "invalid feature name: '$ac_useropt'"
    ac_useropt_orig=$ac_useropt
    ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'`
    case $ac_user_opts in
      *"
"enable_$ac_useropt"
"*) ;;
      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig"
	 ac_unrecognized_sep=', ';;
    esac
    eval enable_$ac_useropt=\$ac_optarg ;;

  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
  | --exec | --exe | --ex)
    ac_prev=exec_prefix ;;
  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
  | --exec=* | --exe=* | --ex=*)
    exec_prefix=$ac_optarg ;;

  -gas | --gas | --ga | --g)
    # Obsolete; use --with-gas.
    with_gas=yes ;;

  -help | --help | --hel | --he | -h)
    ac_init_help=long ;;
  -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)
    ac_init_help=recursive ;;
  -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)
    ac_init_help=short ;;

  -host | --host | --hos | --ho)
    ac_prev=host_alias ;;
  -host=* | --host=* | --hos=* | --ho=*)
    host_alias=$ac_optarg ;;

  -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)
    ac_prev=htmldir ;;
  -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \
  | --ht=*)
    htmldir=$ac_optarg ;;

  -includedir | --includedir | --includedi | --included | --include \
  | --includ | --inclu | --incl | --inc)
    ac_prev=includedir ;;
  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
  | --includ=* | --inclu=* | --incl=* | --inc=*)
    includedir=$ac_optarg ;;

  -infodir | --infodir | --infodi | --infod | --info | --inf)
    ac_prev=infodir ;;
  -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
    infodir=$ac_optarg ;;

  -libdir | --libdir | --libdi | --libd)
    ac_prev=libdir ;;
  -libdir=* | --libdir=* | --libdi=* | --libd=*)
    libdir=$ac_optarg ;;

  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
  | --libexe | --libex | --libe)
    ac_prev=libexecdir ;;
  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
  | --libexe=* | --libex=* | --libe=*)
    libexecdir=$ac_optarg ;;

  -localedir | --localedir | --localedi | --localed | --locale)
    ac_prev=localedir ;;
  -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)
    localedir=$ac_optarg ;;

  -localstatedir | --localstatedir | --localstatedi | --localstated \
  | --localstate | --localstat | --localsta | --localst | --locals)
    ac_prev=localstatedir ;;
  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
  | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)
    localstatedir=$ac_optarg ;;

  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
    ac_prev=mandir ;;
  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
    mandir=$ac_optarg ;;

  -nfp | --nfp | --nf)
    # Obsolete; use --without-fp.
    with_fp=no ;;

  -no-create | --no-create | --no-creat | --no-crea | --no-cre \
  | --no-cr | --no-c | -n)
    no_create=yes ;;

  -no-recursion | --no-recursion | --no-recursio | --no-recursi \
  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
    no_recursion=yes ;;

  -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
  | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
  | --oldin | --oldi | --old | --ol | --o)
    ac_prev=oldincludedir ;;
  -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
  | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
  | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
    oldincludedir=$ac_optarg ;;

  -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
    ac_prev=prefix ;;
  -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
    prefix=$ac_optarg ;;

  -program-prefix | --program-prefix | --program-prefi | --program-pref \
  | --program-pre | --program-pr | --program-p)
    ac_prev=program_prefix ;;
  -program-prefix=* | --program-prefix=* | --program-prefi=* \
  | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
    program_prefix=$ac_optarg ;;

  -program-suffix | --program-suffix | --program-suffi | --program-suff \
  | --program-suf | --program-su | --program-s)
    ac_prev=program_suffix ;;
  -program-suffix=* | --program-suffix=* | --program-suffi=* \
  | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
    program_suffix=$ac_optarg ;;

  -program-transform-name | --program-transform-name \
  | --program-transform-nam | --program-transform-na \
  | --program-transform-n | --program-transform- \
  | --program-transform | --program-transfor \
  | --program-transfo | --program-transf \
  | --program-trans | --program-tran \
  | --progr-tra | --program-tr | --program-t)
    ac_prev=program_transform_name ;;
  -program-transform-name=* | --program-transform-name=* \
  | --program-transform-nam=* | --program-transform-na=* \
  | --program-transform-n=* | --program-transform-=* \
  | --program-transform=* | --program-transfor=* \
  | --program-transfo=* | --program-transf=* \
  | --program-trans=* | --program-tran=* \
  | --progr-tra=* | --program-tr=* | --program-t=*)
    program_transform_name=$ac_optarg ;;

  -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)
    ac_prev=pdfdir ;;
  -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)
    pdfdir=$ac_optarg ;;

  -psdir | --psdir | --psdi | --psd | --ps)
    ac_prev=psdir ;;
  -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)
    psdir=$ac_optarg ;;

  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
  | -silent | --silent | --silen | --sile | --sil)
    silent=yes ;;

  -runstatedir | --runstatedir | --runstatedi | --runstated \
  | --runstate | --runstat | --runsta | --runst | --runs \
  | --run | --ru | --r)
    ac_prev=runstatedir ;;
  -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \
  | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \
  | --run=* | --ru=* | --r=*)
    runstatedir=$ac_optarg ;;

  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
    ac_prev=sbindir ;;
  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
  | --sbi=* | --sb=*)
    sbindir=$ac_optarg ;;

  -sharedstatedir | --sharedstatedir | --sharedstatedi \
  | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
  | --sharedst | --shareds | --shared | --share | --shar \
  | --sha | --sh)
    ac_prev=sharedstatedir ;;
  -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
  | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
  | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
  | --sha=* | --sh=*)
    sharedstatedir=$ac_optarg ;;

  -site | --site | --sit)
    ac_prev=site ;;
  -site=* | --site=* | --sit=*)
    site=$ac_optarg ;;

  -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
    ac_prev=srcdir ;;
  -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
    srcdir=$ac_optarg ;;

  -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
  | --syscon | --sysco | --sysc | --sys | --sy)
    ac_prev=sysconfdir ;;
  -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
  | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
    sysconfdir=$ac_optarg ;;

  -target | --target | --targe | --targ | --tar | --ta | --t)
    ac_prev=target_alias ;;
  -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
    target_alias=$ac_optarg ;;

  -v | -verbose | --verbose | --verbos | --verbo | --verb)
    verbose=yes ;;

  -version | --version | --versio | --versi | --vers | -V)
    ac_init_version=: ;;

  -with-* | --with-*)
    ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
    # Reject names that are not valid shell variable names.
    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
      as_fn_error $? "invalid package name: '$ac_useropt'"
    ac_useropt_orig=$ac_useropt
    ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'`
    case $ac_user_opts in
      *"
"with_$ac_useropt"
"*) ;;
      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig"
	 ac_unrecognized_sep=', ';;
    esac
    eval with_$ac_useropt=\$ac_optarg ;;

  -without-* | --without-*)
    ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'`
    # Reject names that are not valid shell variable names.
    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
      as_fn_error $? "invalid package name: '$ac_useropt'"
    ac_useropt_orig=$ac_useropt
    ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'`
    case $ac_user_opts in
      *"
"with_$ac_useropt"
"*) ;;
      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig"
	 ac_unrecognized_sep=', ';;
    esac
    eval with_$ac_useropt=no ;;

  --x)
    # Obsolete; use --with-x.
    with_x=yes ;;

  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
  | --x-incl | --x-inc | --x-in | --x-i)
    ac_prev=x_includes ;;
  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
    x_includes=$ac_optarg ;;

  -x-libraries | --x-libraries | --x-librarie | --x-librari \
  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
    ac_prev=x_libraries ;;
  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
    x_libraries=$ac_optarg ;;

  -*) as_fn_error $? "unrecognized option: '$ac_option'
Try '$0 --help' for more information"
    ;;

  *=*)
    ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
    # Reject names that are not valid shell variable names.
    case $ac_envvar in #(
      '' | [0-9]* | *[!_$as_cr_alnum]* )
      as_fn_error $? "invalid variable name: '$ac_envvar'" ;;
    esac
    eval $ac_envvar=\$ac_optarg
    export $ac_envvar ;;

  *)
    # FIXME: should be removed in autoconf 3.0.
    printf "%s\n" "$as_me: WARNING: you should use --build, --host, --target" >&2
    expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
      printf "%s\n" "$as_me: WARNING: invalid host type: $ac_option" >&2
    : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}"
    ;;

  esac
done

if test -n "$ac_prev"; then
  ac_option=--`echo $ac_prev | sed 's/_/-/g'`
  as_fn_error $? "missing argument to $ac_option"
fi

if test -n "$ac_unrecognized_opts"; then
  case $enable_option_checking in
    no) ;;
    fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;;
    *)     printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;
  esac
fi

# Check all directory arguments for consistency.
for ac_var in	exec_prefix prefix bindir sbindir libexecdir datarootdir \
		datadir sysconfdir sharedstatedir localstatedir includedir \
		oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
		libdir localedir mandir runstatedir
do
  eval ac_val=\$$ac_var
  # Remove trailing slashes.
  case $ac_val in
    */ )
      ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`
      eval $ac_var=\$ac_val;;
  esac
  # Be sure to have absolute directory names.
  case $ac_val in
    [\\/$]* | ?:[\\/]* )  continue;;
    NONE | '' ) case $ac_var in *prefix ) continue;; esac;;
  esac
  as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val"
done

# There might be people who depend on the old broken behavior: '$host'
# used to hold the argument of --host etc.
# FIXME: To remove some day.
build=$build_alias
host=$host_alias
target=$target_alias

# FIXME: To remove some day.
if test "x$host_alias" != x; then
  if test "x$build_alias" = x; then
    cross_compiling=maybe
  elif test "x$build_alias" != "x$host_alias"; then
    cross_compiling=yes
  fi
fi

ac_tool_prefix=
test -n "$host_alias" && ac_tool_prefix=$host_alias-

test "$silent" = yes && exec 6>/dev/null


ac_pwd=`pwd` && test -n "$ac_pwd" &&
ac_ls_di=`ls -di .` &&
ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||
  as_fn_error $? "working directory cannot be determined"
test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||
  as_fn_error $? "pwd does not report name of working directory"


# Find the source files, if location was not specified.
if test -z "$srcdir"; then
  ac_srcdir_defaulted=yes
  # Try the directory containing this script, then the parent directory.
  ac_confdir=`$as_dirname -- "$as_myself" ||
$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
	 X"$as_myself" : 'X\(//\)[^/]' \| \
	 X"$as_myself" : 'X\(//\)$' \| \
	 X"$as_myself" : 'X\(/\)' \| . 2>/dev/null ||
printf "%s\n" X"$as_myself" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)[^/].*/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\).*/{
	    s//\1/
	    q
	  }
	  s/.*/./; q'`
  srcdir=$ac_confdir
  if test ! -r "$srcdir/$ac_unique_file"; then
    srcdir=..
  fi
else
  ac_srcdir_defaulted=no
fi
if test ! -r "$srcdir/$ac_unique_file"; then
  test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."
  as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir"
fi
ac_msg="sources are in $srcdir, but 'cd $srcdir' does not work"
ac_abs_confdir=`(
	cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg"
	pwd)`
# When building in place, set srcdir=.
if test "$ac_abs_confdir" = "$ac_pwd"; then
  srcdir=.
fi
# Remove unnecessary trailing slashes from srcdir.
# Double slashes in file names in object file debugging info
# mess up M-x gdb in Emacs.
case $srcdir in
*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;
esac
for ac_var in $ac_precious_vars; do
  eval ac_env_${ac_var}_set=\${${ac_var}+set}
  eval ac_env_${ac_var}_value=\$${ac_var}
  eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}
  eval ac_cv_env_${ac_var}_value=\$${ac_var}
done

#
# Report the --help message.
#
if test "$ac_init_help" = "long"; then
  # Omit some internal or obsolete options to make the list less imposing.
  # This message is too long to be a string in the A/UX 3.1 sh.
  cat <<_ACEOF
'configure' configures tcl 9.0 to adapt to many kinds of systems.

Usage: $0 [OPTION]... [VAR=VALUE]...

To assign environment variables (e.g., CC, CFLAGS...), specify them as
VAR=VALUE.  See below for descriptions of some of the useful variables.

Defaults for the options are specified in brackets.

Configuration:
  -h, --help              display this help and exit
      --help=short        display options specific to this package
      --help=recursive    display the short help of all the included packages
  -V, --version           display version information and exit
  -q, --quiet, --silent   do not print 'checking ...' messages
      --cache-file=FILE   cache test results in FILE [disabled]
  -C, --config-cache      alias for '--cache-file=config.cache'
  -n, --no-create         do not create output files
      --srcdir=DIR        find the sources in DIR [configure dir or '..']

Installation directories:
  --prefix=PREFIX         install architecture-independent files in PREFIX
                          [$ac_default_prefix]
  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX
                          [PREFIX]

By default, 'make install' will install all the files in
'$ac_default_prefix/bin', '$ac_default_prefix/lib' etc.  You can specify
an installation prefix other than '$ac_default_prefix' using '--prefix',
for instance '--prefix=\$HOME'.

For better control, use the options below.

Fine tuning of the installation directories:
  --bindir=DIR            user executables [EPREFIX/bin]
  --sbindir=DIR           system admin executables [EPREFIX/sbin]
  --libexecdir=DIR        program executables [EPREFIX/libexec]
  --sysconfdir=DIR        read-only single-machine data [PREFIX/etc]
  --sharedstatedir=DIR    modifiable architecture-independent data [PREFIX/com]
  --localstatedir=DIR     modifiable single-machine data [PREFIX/var]
  --runstatedir=DIR       modifiable per-process data [LOCALSTATEDIR/run]
  --libdir=DIR            object code libraries [EPREFIX/lib]
  --includedir=DIR        C header files [PREFIX/include]
  --oldincludedir=DIR     C header files for non-gcc [/usr/include]
  --datarootdir=DIR       read-only arch.-independent data root [PREFIX/share]
  --datadir=DIR           read-only architecture-independent data [DATAROOTDIR]
  --infodir=DIR           info documentation [DATAROOTDIR/info]
  --localedir=DIR         locale-dependent data [DATAROOTDIR/locale]
  --mandir=DIR            man documentation [DATAROOTDIR/man]
  --docdir=DIR            documentation root [DATAROOTDIR/doc/tcl]
  --htmldir=DIR           html documentation [DOCDIR]
  --dvidir=DIR            dvi documentation [DOCDIR]
  --pdfdir=DIR            pdf documentation [DOCDIR]
  --psdir=DIR             ps documentation [DOCDIR]
_ACEOF

  cat <<\_ACEOF
_ACEOF
fi

if test -n "$ac_init_help"; then
  case $ac_init_help in
     short | recursive ) echo "Configuration of tcl 9.0:";;
   esac
  cat <<\_ACEOF

Optional Features:
  --disable-option-checking  ignore unrecognized --enable/--with options
  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
  --enable-shared         build and link with shared libraries (default: on)
  --enable-64bit          enable 64bit support (where applicable)
  --enable-zipfs          build with Zipfs support (default: on)
  --enable-symbols        build with debugging symbols (default: off)
  --enable-embedded-manifest
                          embed manifest if possible (default: yes)

Optional Packages:
  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]
  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)
  --with-encoding         encoding for configuration values

Some influential environment variables:
  CC          C compiler command
  CFLAGS      C compiler flags
  LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
              nonstandard directory <lib dir>
  LIBS        libraries to pass to the linker, e.g. -l<library>
  CPPFLAGS    (Objective) C/C++ preprocessor flags, e.g. -I<include dir> if
              you have headers in a nonstandard directory <include dir>
  CPP         C preprocessor

Use these variables to override the choices made by 'configure' or to help
it to find libraries and programs with nonstandard names/locations.

Report bugs to the package provider.
_ACEOF
ac_status=$?
fi

if test "$ac_init_help" = "recursive"; then
  # If there are subdirs, report their specific --help.
  for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue
    test -d "$ac_dir" ||
      { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } ||
      continue
    ac_builddir=.

case "$ac_dir" in
.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
*)
  ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'`
  # A ".." for each directory in $ac_dir_suffix.
  ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
  case $ac_top_builddir_sub in
  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;
  esac ;;
esac
ac_abs_top_builddir=$ac_pwd
ac_abs_builddir=$ac_pwd$ac_dir_suffix
# for backward compatibility:
ac_top_builddir=$ac_top_build_prefix

case $srcdir in
  .)  # We are building in place.
    ac_srcdir=.
    ac_top_srcdir=$ac_top_builddir_sub
    ac_abs_top_srcdir=$ac_pwd ;;
  [\\/]* | ?:[\\/]* )  # Absolute name.
    ac_srcdir=$srcdir$ac_dir_suffix;
    ac_top_srcdir=$srcdir
    ac_abs_top_srcdir=$srcdir ;;
  *) # Relative name.
    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
    ac_top_srcdir=$ac_top_build_prefix$srcdir
    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
esac
ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix

    cd "$ac_dir" || { ac_status=$?; continue; }
    # Check for configure.gnu first; this name is used for a wrapper for
    # Metaconfig's "Configure" on case-insensitive file systems.
    if test -f "$ac_srcdir/configure.gnu"; then
      echo &&
      $SHELL "$ac_srcdir/configure.gnu" --help=recursive
    elif test -f "$ac_srcdir/configure"; then
      echo &&
      $SHELL "$ac_srcdir/configure" --help=recursive
    else
      printf "%s\n" "$as_me: WARNING: no configuration information is in $ac_dir" >&2
    fi || ac_status=$?
    cd "$ac_pwd" || { ac_status=$?; break; }
  done
fi

test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
  cat <<\_ACEOF
tcl configure 9.0
generated by GNU Autoconf 2.72

Copyright (C) 2023 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
  exit
fi

## ------------------------ ##
## Autoconf initialization. ##
## ------------------------ ##

# ac_fn_c_try_compile LINENO
# --------------------------
# Try to compile conftest.$ac_ext, and return whether this succeeded.
ac_fn_c_try_compile ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
  rm -f conftest.$ac_objext conftest.beam
  if { { ac_try="$ac_compile"
case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
printf "%s\n" "$ac_try_echo"; } >&5
  (eval "$ac_compile") 2>conftest.err
  ac_status=$?
  if test -s conftest.err; then
    grep -v '^ *+' conftest.err >conftest.er1
    cat conftest.er1 >&5
    mv -f conftest.er1 conftest.err
  fi
  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; } && {
	 test -z "$ac_c_werror_flag" ||
	 test ! -s conftest.err
       } && test -s conftest.$ac_objext
then :
  ac_retval=0
else case e in #(
  e) printf "%s\n" "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

	ac_retval=1 ;;
esac
fi
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
  as_fn_set_status $ac_retval

} # ac_fn_c_try_compile

# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES
# -------------------------------------------------------
# Tests whether HEADER exists and can be compiled using the include files in
# INCLUDES, setting the cache variable VAR accordingly.
ac_fn_c_check_header_compile ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
printf %s "checking for $2... " >&6; }
if eval test \${$3+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$4
#include <$2>
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
  eval "$3=yes"
else case e in #(
  e) eval "$3=no" ;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;;
esac
fi
eval ac_res=\$$3
	       { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
printf "%s\n" "$ac_res" >&6; }
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno

} # ac_fn_c_check_header_compile

# ac_fn_c_check_type LINENO TYPE VAR INCLUDES
# -------------------------------------------
# Tests whether TYPE exists after having included INCLUDES, setting cache
# variable VAR accordingly.
ac_fn_c_check_type ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
printf %s "checking for $2... " >&6; }
if eval test \${$3+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) eval "$3=no"
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$4
int
main (void)
{
if (sizeof ($2))
	 return 0;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$4
int
main (void)
{
if (sizeof (($2)))
	    return 0;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :

else case e in #(
  e) eval "$3=yes" ;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;;
esac
fi
eval ac_res=\$$3
	       { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
printf "%s\n" "$ac_res" >&6; }
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno

} # ac_fn_c_check_type

# ac_fn_c_try_cpp LINENO
# ----------------------
# Try to preprocess conftest.$ac_ext, and return whether this succeeded.
ac_fn_c_try_cpp ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
  if { { ac_try="$ac_cpp conftest.$ac_ext"
case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
printf "%s\n" "$ac_try_echo"; } >&5
  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err
  ac_status=$?
  if test -s conftest.err; then
    grep -v '^ *+' conftest.err >conftest.er1
    cat conftest.er1 >&5
    mv -f conftest.er1 conftest.err
  fi
  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; } > conftest.i && {
	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
	 test ! -s conftest.err
       }
then :
  ac_retval=0
else case e in #(
  e) printf "%s\n" "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

    ac_retval=1 ;;
esac
fi
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
  as_fn_set_status $ac_retval

} # ac_fn_c_try_cpp
ac_configure_args_raw=
for ac_arg
do
  case $ac_arg in
  *\'*)
    ac_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
  esac
  as_fn_append ac_configure_args_raw " '$ac_arg'"
done

case $ac_configure_args_raw in
  *$as_nl*)
    ac_safe_unquote= ;;
  *)
    ac_unsafe_z='|&;<>()$`\\"*?[ ''	' # This string ends in space, tab.
    ac_unsafe_a="$ac_unsafe_z#~"
    ac_safe_unquote="s/ '\\([^$ac_unsafe_a][^$ac_unsafe_z]*\\)'/ \\1/g"
    ac_configure_args_raw=`      printf "%s\n" "$ac_configure_args_raw" | sed "$ac_safe_unquote"`;;
esac

cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.

It was created by tcl $as_me 9.0, which was
generated by GNU Autoconf 2.72.  Invocation command line was

  $ $0$ac_configure_args_raw

_ACEOF
exec 5>>config.log
{
cat <<_ASUNAME
## --------- ##
## Platform. ##
## --------- ##

hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`
uname -m = `(uname -m) 2>/dev/null || echo unknown`
uname -r = `(uname -r) 2>/dev/null || echo unknown`
uname -s = `(uname -s) 2>/dev/null || echo unknown`
uname -v = `(uname -v) 2>/dev/null || echo unknown`

/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`
/bin/uname -X     = `(/bin/uname -X) 2>/dev/null     || echo unknown`

/bin/arch              = `(/bin/arch) 2>/dev/null              || echo unknown`
/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null       || echo unknown`
/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`
/usr/bin/hostinfo      = `(/usr/bin/hostinfo) 2>/dev/null      || echo unknown`
/bin/machine           = `(/bin/machine) 2>/dev/null           || echo unknown`
/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null       || echo unknown`
/bin/universe          = `(/bin/universe) 2>/dev/null          || echo unknown`

_ASUNAME

as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  case $as_dir in #(((
    '') as_dir=./ ;;
    */) ;;
    *) as_dir=$as_dir/ ;;
  esac
    printf "%s\n" "PATH: $as_dir"
  done
IFS=$as_save_IFS

} >&5

cat >&5 <<_ACEOF


## ----------- ##
## Core tests. ##
## ----------- ##

_ACEOF


# Keep a trace of the command line.
# Strip out --no-create and --no-recursion so they do not pile up.
# Strip out --silent because we don't want to record it for future runs.
# Also quote any args containing shell meta-characters.
# Make two passes to allow for proper duplicate-argument suppression.
ac_configure_args=
ac_configure_args0=
ac_configure_args1=
ac_must_keep_next=false
for ac_pass in 1 2
do
  for ac_arg
  do
    case $ac_arg in
    -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;
    -q | -quiet | --quiet | --quie | --qui | --qu | --q \
    | -silent | --silent | --silen | --sile | --sil)
      continue ;;
    *\'*)
      ac_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
    esac
    case $ac_pass in
    1) as_fn_append ac_configure_args0 " '$ac_arg'" ;;
    2)
      as_fn_append ac_configure_args1 " '$ac_arg'"
      if test $ac_must_keep_next = true; then
	ac_must_keep_next=false # Got value, back to normal.
      else
	case $ac_arg in
	  *=* | --config-cache | -C | -disable-* | --disable-* \
	  | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \
	  | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \
	  | -with-* | --with-* | -without-* | --without-* | --x)
	    case "$ac_configure_args0 " in
	      "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;
	    esac
	    ;;
	  -* ) ac_must_keep_next=true ;;
	esac
      fi
      as_fn_append ac_configure_args " '$ac_arg'"
      ;;
    esac
  done
done
{ ac_configure_args0=; unset ac_configure_args0;}
{ ac_configure_args1=; unset ac_configure_args1;}

# When interrupted or exit'd, cleanup temporary files, and complete
# config.log.  We remove comments because anyway the quotes in there
# would cause problems or look ugly.
# WARNING: Use '\'' to represent an apostrophe within the trap.
# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.
trap 'exit_status=$?
  # Sanitize IFS.
  IFS=" ""	$as_nl"
  # Save into config.log some information that might help in debugging.
  {
    echo

    printf "%s\n" "## ---------------- ##
## Cache variables. ##
## ---------------- ##"
    echo
    # The following way of writing the cache mishandles newlines in values,
(
  for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do
    eval ac_val=\$$ac_var
    case $ac_val in #(
    *${as_nl}*)
      case $ac_var in #(
      *_cv_*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
      esac
      case $ac_var in #(
      _ | IFS | as_nl) ;; #(
      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
      *) { eval $ac_var=; unset $ac_var;} ;;
      esac ;;
    esac
  done
  (set) 2>&1 |
    case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(
    *${as_nl}ac_space=\ *)
      sed -n \
	"s/'\''/'\''\\\\'\'''\''/g;
	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"
      ;; #(
    *)
      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
      ;;
    esac |
    sort
)
    echo

    printf "%s\n" "## ----------------- ##
## Output variables. ##
## ----------------- ##"
    echo
    for ac_var in $ac_subst_vars
    do
      eval ac_val=\$$ac_var
      case $ac_val in
      *\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
      esac
      printf "%s\n" "$ac_var='\''$ac_val'\''"
    done | sort
    echo

    if test -n "$ac_subst_files"; then
      printf "%s\n" "## ------------------- ##
## File substitutions. ##
## ------------------- ##"
      echo
      for ac_var in $ac_subst_files
      do
	eval ac_val=\$$ac_var
	case $ac_val in
	*\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
	esac
	printf "%s\n" "$ac_var='\''$ac_val'\''"
      done | sort
      echo
    fi

    if test -s confdefs.h; then
      printf "%s\n" "## ----------- ##
## confdefs.h. ##
## ----------- ##"
      echo
      cat confdefs.h
      echo
    fi
    test "$ac_signal" != 0 &&
      printf "%s\n" "$as_me: caught signal $ac_signal"
    printf "%s\n" "$as_me: exit $exit_status"
  } >&5
  rm -f core *.core core.conftest.* &&
    rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&
    exit $exit_status
' 0
for ac_signal in 1 2 13 15; do
  trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal
done
ac_signal=0

# confdefs.h avoids OS command line length limits that DEFS can exceed.
rm -f -r conftest* confdefs.h

printf "%s\n" "/* confdefs.h */" > confdefs.h

# Predefined preprocessor variables.

printf "%s\n" "#define PACKAGE_NAME \"$PACKAGE_NAME\"" >>confdefs.h

printf "%s\n" "#define PACKAGE_TARNAME \"$PACKAGE_TARNAME\"" >>confdefs.h

printf "%s\n" "#define PACKAGE_VERSION \"$PACKAGE_VERSION\"" >>confdefs.h

printf "%s\n" "#define PACKAGE_STRING \"$PACKAGE_STRING\"" >>confdefs.h

printf "%s\n" "#define PACKAGE_BUGREPORT \"$PACKAGE_BUGREPORT\"" >>confdefs.h

printf "%s\n" "#define PACKAGE_URL \"$PACKAGE_URL\"" >>confdefs.h


# Let the site file select an alternate cache file if it wants to.
# Prefer an explicitly selected file to automatically selected ones.
if test -n "$CONFIG_SITE"; then
  ac_site_files="$CONFIG_SITE"
elif test "x$prefix" != xNONE; then
  ac_site_files="$prefix/share/config.site $prefix/etc/config.site"
else
  ac_site_files="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
fi

for ac_site_file in $ac_site_files
do
  case $ac_site_file in #(
  */*) :
     ;; #(
  *) :
    ac_site_file=./$ac_site_file ;;
esac
  if test -f "$ac_site_file" && test -r "$ac_site_file"; then
    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5
printf "%s\n" "$as_me: loading site script $ac_site_file" >&6;}
    sed 's/^/| /' "$ac_site_file" >&5
    . "$ac_site_file" \
      || { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5
printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;}
as_fn_error $? "failed to load site script $ac_site_file
See 'config.log' for more details" "$LINENO" 5; }
  fi
done

if test -r "$cache_file"; then
  # Some versions of bash will fail to source /dev/null (special files
  # actually), so we avoid doing that.  DJGPP emulates it as a regular file.
  if test /dev/null != "$cache_file" && test -f "$cache_file"; then
    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5
printf "%s\n" "$as_me: loading cache $cache_file" >&6;}
    case $cache_file in
      [\\/]* | ?:[\\/]* ) . "$cache_file";;
      *)                      . "./$cache_file";;
    esac
  fi
else
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5
printf "%s\n" "$as_me: creating cache $cache_file" >&6;}
  >$cache_file
fi

# Test code for whether the C compiler supports C89 (global declarations)
ac_c_conftest_c89_globals='
/* Does the compiler advertise C89 conformance?
   Do not test the value of __STDC__, because some compilers set it to 0
   while being otherwise adequately conformant. */
#if !defined __STDC__
# error "Compiler does not advertise C89 conformance"
#endif

#include <stddef.h>
#include <stdarg.h>
struct stat;
/* Most of the following tests are stolen from RCS 5.7 src/conf.sh.  */
struct buf { int x; };
struct buf * (*rcsopen) (struct buf *, struct stat *, int);
static char *e (char **p, int i)
{
  return p[i];
}
static char *f (char * (*g) (char **, int), char **p, ...)
{
  char *s;
  va_list v;
  va_start (v,p);
  s = g (p, va_arg (v,int));
  va_end (v);
  return s;
}

/* C89 style stringification. */
#define noexpand_stringify(a) #a
const char *stringified = noexpand_stringify(arbitrary+token=sequence);

/* C89 style token pasting.  Exercises some of the corner cases that
   e.g. old MSVC gets wrong, but not very hard. */
#define noexpand_concat(a,b) a##b
#define expand_concat(a,b) noexpand_concat(a,b)
extern int vA;
extern int vbee;
#define aye A
#define bee B
int *pvA = &expand_concat(v,aye);
int *pvbee = &noexpand_concat(v,bee);

/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default.  It has
   function prototypes and stuff, but not \xHH hex character constants.
   These do not provoke an error unfortunately, instead are silently treated
   as an "x".  The following induces an error, until -std is added to get
   proper ANSI mode.  Curiously \x00 != x always comes out true, for an
   array size at least.  It is necessary to write \x00 == 0 to get something
   that is true only with -std.  */
int osf4_cc_array ['\''\x00'\'' == 0 ? 1 : -1];

/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters
   inside strings and character constants.  */
#define FOO(x) '\''x'\''
int xlc6_cc_array[FOO(a) == '\''x'\'' ? 1 : -1];

int test (int i, double x);
struct s1 {int (*f) (int a);};
struct s2 {int (*f) (double a);};
int pairnames (int, char **, int *(*)(struct buf *, struct stat *, int),
               int, int);'

# Test code for whether the C compiler supports C89 (body of main).
ac_c_conftest_c89_main='
ok |= (argc == 0 || f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]);
'

# Test code for whether the C compiler supports C99 (global declarations)
ac_c_conftest_c99_globals='
/* Does the compiler advertise C99 conformance? */
#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L
# error "Compiler does not advertise C99 conformance"
#endif

// See if C++-style comments work.

#include <stdbool.h>
extern int puts (const char *);
extern int printf (const char *, ...);
extern int dprintf (int, const char *, ...);
extern void *malloc (size_t);
extern void free (void *);

// Check varargs macros.  These examples are taken from C99 6.10.3.5.
// dprintf is used instead of fprintf to avoid needing to declare
// FILE and stderr.
#define debug(...) dprintf (2, __VA_ARGS__)
#define showlist(...) puts (#__VA_ARGS__)
#define report(test,...) ((test) ? puts (#test) : printf (__VA_ARGS__))
static void
test_varargs_macros (void)
{
  int x = 1234;
  int y = 5678;
  debug ("Flag");
  debug ("X = %d\n", x);
  showlist (The first, second, and third items.);
  report (x>y, "x is %d but y is %d", x, y);
}

// Check long long types.
#define BIG64 18446744073709551615ull
#define BIG32 4294967295ul
#define BIG_OK (BIG64 / BIG32 == 4294967297ull && BIG64 % BIG32 == 0)
#if !BIG_OK
  #error "your preprocessor is broken"
#endif
#if BIG_OK
#else
  #error "your preprocessor is broken"
#endif
static long long int bignum = -9223372036854775807LL;
static unsigned long long int ubignum = BIG64;

struct incomplete_array
{
  int datasize;
  double data[];
};

struct named_init {
  int number;
  const wchar_t *name;
  double average;
};

typedef const char *ccp;

static inline int
test_restrict (ccp restrict text)
{
  // Iterate through items via the restricted pointer.
  // Also check for declarations in for loops.
  for (unsigned int i = 0; *(text+i) != '\''\0'\''; ++i)
    continue;
  return 0;
}

// Check varargs and va_copy.
static bool
test_varargs (const char *format, ...)
{
  va_list args;
  va_start (args, format);
  va_list args_copy;
  va_copy (args_copy, args);

  const char *str = "";
  int number = 0;
  float fnumber = 0;

  while (*format)
    {
      switch (*format++)
	{
	case '\''s'\'': // string
	  str = va_arg (args_copy, const char *);
	  break;
	case '\''d'\'': // int
	  number = va_arg (args_copy, int);
	  break;
	case '\''f'\'': // float
	  fnumber = va_arg (args_copy, double);
	  break;
	default:
	  break;
	}
    }
  va_end (args_copy);
  va_end (args);

  return *str && number && fnumber;
}
'

# Test code for whether the C compiler supports C99 (body of main).
ac_c_conftest_c99_main='
  // Check bool.
  _Bool success = false;
  success |= (argc != 0);

  // Check restrict.
  if (test_restrict ("String literal") == 0)
    success = true;
  char *restrict newvar = "Another string";

  // Check varargs.
  success &= test_varargs ("s, d'\'' f .", "string", 65, 34.234);
  test_varargs_macros ();

  // Check flexible array members.
  struct incomplete_array *ia =
    malloc (sizeof (struct incomplete_array) + (sizeof (double) * 10));
  ia->datasize = 10;
  for (int i = 0; i < ia->datasize; ++i)
    ia->data[i] = i * 1.234;
  // Work around memory leak warnings.
  free (ia);

  // Check named initializers.
  struct named_init ni = {
    .number = 34,
    .name = L"Test wide string",
    .average = 543.34343,
  };

  ni.number = 58;

  int dynamic_array[ni.number];
  dynamic_array[0] = argv[0][0];
  dynamic_array[ni.number - 1] = 543;

  // work around unused variable warnings
  ok |= (!success || bignum == 0LL || ubignum == 0uLL || newvar[0] == '\''x'\''
	 || dynamic_array[ni.number - 1] != 543);
'

# Test code for whether the C compiler supports C11 (global declarations)
ac_c_conftest_c11_globals='
/* Does the compiler advertise C11 conformance? */
#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112L
# error "Compiler does not advertise C11 conformance"
#endif

// Check _Alignas.
char _Alignas (double) aligned_as_double;
char _Alignas (0) no_special_alignment;
extern char aligned_as_int;
char _Alignas (0) _Alignas (int) aligned_as_int;

// Check _Alignof.
enum
{
  int_alignment = _Alignof (int),
  int_array_alignment = _Alignof (int[100]),
  char_alignment = _Alignof (char)
};
_Static_assert (0 < -_Alignof (int), "_Alignof is signed");

// Check _Noreturn.
int _Noreturn does_not_return (void) { for (;;) continue; }

// Check _Static_assert.
struct test_static_assert
{
  int x;
  _Static_assert (sizeof (int) <= sizeof (long int),
                  "_Static_assert does not work in struct");
  long int y;
};

// Check UTF-8 literals.
#define u8 syntax error!
char const utf8_literal[] = u8"happens to be ASCII" "another string";

// Check duplicate typedefs.
typedef long *long_ptr;
typedef long int *long_ptr;
typedef long_ptr long_ptr;

// Anonymous structures and unions -- taken from C11 6.7.2.1 Example 1.
struct anonymous
{
  union {
    struct { int i; int j; };
    struct { int k; long int l; } w;
  };
  int m;
} v1;
'

# Test code for whether the C compiler supports C11 (body of main).
ac_c_conftest_c11_main='
  _Static_assert ((offsetof (struct anonymous, i)
		   == offsetof (struct anonymous, w.k)),
		  "Anonymous union alignment botch");
  v1.i = 2;
  v1.w.k = 5;
  ok |= v1.i != 5;
'

# Test code for whether the C compiler supports C11 (complete).
ac_c_conftest_c11_program="${ac_c_conftest_c89_globals}
${ac_c_conftest_c99_globals}
${ac_c_conftest_c11_globals}

int
main (int argc, char **argv)
{
  int ok = 0;
  ${ac_c_conftest_c89_main}
  ${ac_c_conftest_c99_main}
  ${ac_c_conftest_c11_main}
  return ok;
}
"

# Test code for whether the C compiler supports C99 (complete).
ac_c_conftest_c99_program="${ac_c_conftest_c89_globals}
${ac_c_conftest_c99_globals}

int
main (int argc, char **argv)
{
  int ok = 0;
  ${ac_c_conftest_c89_main}
  ${ac_c_conftest_c99_main}
  return ok;
}
"

# Test code for whether the C compiler supports C89 (complete).
ac_c_conftest_c89_program="${ac_c_conftest_c89_globals}

int
main (int argc, char **argv)
{
  int ok = 0;
  ${ac_c_conftest_c89_main}
  return ok;
}
"

as_fn_append ac_header_c_list " stdio.h stdio_h HAVE_STDIO_H"
as_fn_append ac_header_c_list " stdlib.h stdlib_h HAVE_STDLIB_H"
as_fn_append ac_header_c_list " string.h string_h HAVE_STRING_H"
as_fn_append ac_header_c_list " inttypes.h inttypes_h HAVE_INTTYPES_H"
as_fn_append ac_header_c_list " stdint.h stdint_h HAVE_STDINT_H"
as_fn_append ac_header_c_list " strings.h strings_h HAVE_STRINGS_H"
as_fn_append ac_header_c_list " sys/stat.h sys_stat_h HAVE_SYS_STAT_H"
as_fn_append ac_header_c_list " sys/types.h sys_types_h HAVE_SYS_TYPES_H"
as_fn_append ac_header_c_list " unistd.h unistd_h HAVE_UNISTD_H"
# Check that the precious variables saved in the cache have kept the same
# value.
ac_cache_corrupted=false
for ac_var in $ac_precious_vars; do
  eval ac_old_set=\$ac_cv_env_${ac_var}_set
  eval ac_new_set=\$ac_env_${ac_var}_set
  eval ac_old_val=\$ac_cv_env_${ac_var}_value
  eval ac_new_val=\$ac_env_${ac_var}_value
  case $ac_old_set,$ac_new_set in
    set,)
      { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' was set to '$ac_old_val' in the previous run" >&5
printf "%s\n" "$as_me: error: '$ac_var' was set to '$ac_old_val' in the previous run" >&2;}
      ac_cache_corrupted=: ;;
    ,set)
      { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' was not set in the previous run" >&5
printf "%s\n" "$as_me: error: '$ac_var' was not set in the previous run" >&2;}
      ac_cache_corrupted=: ;;
    ,);;
    *)
      if test "x$ac_old_val" != "x$ac_new_val"; then
	# differences in whitespace do not lead to failure.
	ac_old_val_w=`echo x $ac_old_val`
	ac_new_val_w=`echo x $ac_new_val`
	if test "$ac_old_val_w" != "$ac_new_val_w"; then
	  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' has changed since the previous run:" >&5
printf "%s\n" "$as_me: error: '$ac_var' has changed since the previous run:" >&2;}
	  ac_cache_corrupted=:
	else
	  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in '$ac_var' since the previous run:" >&5
printf "%s\n" "$as_me: warning: ignoring whitespace changes in '$ac_var' since the previous run:" >&2;}
	  eval $ac_var=\$ac_old_val
	fi
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}:   former value:  '$ac_old_val'" >&5
printf "%s\n" "$as_me:   former value:  '$ac_old_val'" >&2;}
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}:   current value: '$ac_new_val'" >&5
printf "%s\n" "$as_me:   current value: '$ac_new_val'" >&2;}
      fi;;
  esac
  # Pass precious variables to config.status.
  if test "$ac_new_set" = set; then
    case $ac_new_val in
    *\'*) ac_arg=$ac_var=`printf "%s\n" "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
    *) ac_arg=$ac_var=$ac_new_val ;;
    esac
    case " $ac_configure_args " in
      *" '$ac_arg' "*) ;; # Avoid dups.  Use of quotes ensures accuracy.
      *) as_fn_append ac_configure_args " '$ac_arg'" ;;
    esac
  fi
done
if $ac_cache_corrupted; then
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5
printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;}
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5
printf "%s\n" "$as_me: error: changes in the environment can compromise the build" >&2;}
  as_fn_error $? "run '${MAKE-make} distclean' and/or 'rm $cache_file'
	    and start over" "$LINENO" 5
fi
## -------------------- ##
## Main body of script. ##
## -------------------- ##

ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu





# The following define is needed when building with Cygwin since newer
# versions of autoconf incorrectly set SHELL to /bin/bash instead of
# /bin/sh. The bash shell seems to suffer from some strange failures.
SHELL=/bin/sh

TCL_VERSION=9.0
TCL_MAJOR_VERSION=9
TCL_MINOR_VERSION=0
TCL_PATCH_LEVEL="b4"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION

TCL_DDE_VERSION=1.4
TCL_DDE_MAJOR_VERSION=1
TCL_DDE_MINOR_VERSION=4
DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION

TCL_REG_VERSION=1.3
TCL_REG_MAJOR_VERSION=1
TCL_REG_MINOR_VERSION=3
REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION

PKG_CFG_ARGS=$@

#------------------------------------------------------------------------
# Empty slate for bundled packages, to avoid stale configuration
#------------------------------------------------------------------------
rm -Rf pkgs

#------------------------------------------------------------------------
# Handle the --prefix=... option
#------------------------------------------------------------------------

if test "${prefix}" = "NONE"; then
    prefix=/usr/local
fi
if test "${exec_prefix}" = "NONE"; then
    exec_prefix=$prefix
fi
# libdir must be a fully qualified path (not ${exec_prefix}/lib)
eval libdir="$libdir"

#------------------------------------------------------------------------
# Standard compiler checks
#------------------------------------------------------------------------

# If the user did not set CFLAGS, set it now to keep
# the AC_PROG_CC macro from adding "-g -O2".
if test "${CFLAGS+set}" != "set" ; then
    CFLAGS=""
fi










ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
if test -n "$ac_tool_prefix"; then
  # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.
set dummy ${ac_tool_prefix}gcc; ac_word=$2
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
printf %s "checking for $ac_word... " >&6; }
if test ${ac_cv_prog_CC+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) if test -n "$CC"; then
  ac_cv_prog_CC="$CC" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  case $as_dir in #(((
    '') as_dir=./ ;;
    */) ;;
    *) as_dir=$as_dir/ ;;
  esac
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then
    ac_cv_prog_CC="${ac_tool_prefix}gcc"
    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
IFS=$as_save_IFS

fi ;;
esac
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
printf "%s\n" "$CC" >&6; }
else
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
fi


fi
if test -z "$ac_cv_prog_CC"; then
  ac_ct_CC=$CC
  # Extract the first word of "gcc", so it can be a program name with args.
set dummy gcc; ac_word=$2
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
printf %s "checking for $ac_word... " >&6; }
if test ${ac_cv_prog_ac_ct_CC+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) if test -n "$ac_ct_CC"; then
  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  case $as_dir in #(((
    '') as_dir=./ ;;
    */) ;;
    *) as_dir=$as_dir/ ;;
  esac
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then
    ac_cv_prog_ac_ct_CC="gcc"
    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
IFS=$as_save_IFS

fi ;;
esac
fi
ac_ct_CC=$ac_cv_prog_ac_ct_CC
if test -n "$ac_ct_CC"; then
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
printf "%s\n" "$ac_ct_CC" >&6; }
else
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
fi

  if test "x$ac_ct_CC" = x; then
    CC=""
  else
    case $cross_compiling:$ac_tool_warned in
yes:)
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
    CC=$ac_ct_CC
  fi
else
  CC="$ac_cv_prog_CC"
fi

if test -z "$CC"; then
          if test -n "$ac_tool_prefix"; then
    # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
set dummy ${ac_tool_prefix}cc; ac_word=$2
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
printf %s "checking for $ac_word... " >&6; }
if test ${ac_cv_prog_CC+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) if test -n "$CC"; then
  ac_cv_prog_CC="$CC" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  case $as_dir in #(((
    '') as_dir=./ ;;
    */) ;;
    *) as_dir=$as_dir/ ;;
  esac
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then
    ac_cv_prog_CC="${ac_tool_prefix}cc"
    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
IFS=$as_save_IFS

fi ;;
esac
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
printf "%s\n" "$CC" >&6; }
else
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
fi


  fi
fi
if test -z "$CC"; then
  # Extract the first word of "cc", so it can be a program name with args.
set dummy cc; ac_word=$2
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
printf %s "checking for $ac_word... " >&6; }
if test ${ac_cv_prog_CC+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) if test -n "$CC"; then
  ac_cv_prog_CC="$CC" # Let the user override the test.
else
  ac_prog_rejected=no
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  case $as_dir in #(((
    '') as_dir=./ ;;
    */) ;;
    *) as_dir=$as_dir/ ;;
  esac
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then
    if test "$as_dir$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
       ac_prog_rejected=yes
       continue
     fi
    ac_cv_prog_CC="cc"
    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
IFS=$as_save_IFS

if test $ac_prog_rejected = yes; then
  # We found a bogon in the path, so make sure we never use it.
  set dummy $ac_cv_prog_CC
  shift
  if test $# != 0; then
    # We chose a different compiler from the bogus one.
    # However, it has the same basename, so the bogon will be chosen
    # first if we set CC to just the basename; use the full file name.
    shift
    ac_cv_prog_CC="$as_dir$ac_word${1+' '}$@"
  fi
fi
fi ;;
esac
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
printf "%s\n" "$CC" >&6; }
else
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
fi


fi
if test -z "$CC"; then
  if test -n "$ac_tool_prefix"; then
  for ac_prog in cl.exe
  do
    # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
set dummy $ac_tool_prefix$ac_prog; ac_word=$2
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
printf %s "checking for $ac_word... " >&6; }
if test ${ac_cv_prog_CC+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) if test -n "$CC"; then
  ac_cv_prog_CC="$CC" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  case $as_dir in #(((
    '') as_dir=./ ;;
    */) ;;
    *) as_dir=$as_dir/ ;;
  esac
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then
    ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
IFS=$as_save_IFS

fi ;;
esac
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
printf "%s\n" "$CC" >&6; }
else
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
fi


    test -n "$CC" && break
  done
fi
if test -z "$CC"; then
  ac_ct_CC=$CC
  for ac_prog in cl.exe
do
  # Extract the first word of "$ac_prog", so it can be a program name with args.
set dummy $ac_prog; ac_word=$2
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
printf %s "checking for $ac_word... " >&6; }
if test ${ac_cv_prog_ac_ct_CC+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) if test -n "$ac_ct_CC"; then
  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  case $as_dir in #(((
    '') as_dir=./ ;;
    */) ;;
    *) as_dir=$as_dir/ ;;
  esac
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then
    ac_cv_prog_ac_ct_CC="$ac_prog"
    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
IFS=$as_save_IFS

fi ;;
esac
fi
ac_ct_CC=$ac_cv_prog_ac_ct_CC
if test -n "$ac_ct_CC"; then
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
printf "%s\n" "$ac_ct_CC" >&6; }
else
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
fi


  test -n "$ac_ct_CC" && break
done

  if test "x$ac_ct_CC" = x; then
    CC=""
  else
    case $cross_compiling:$ac_tool_warned in
yes:)
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
    CC=$ac_ct_CC
  fi
fi

fi
if test -z "$CC"; then
  if test -n "$ac_tool_prefix"; then
  # Extract the first word of "${ac_tool_prefix}clang", so it can be a program name with args.
set dummy ${ac_tool_prefix}clang; ac_word=$2
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
printf %s "checking for $ac_word... " >&6; }
if test ${ac_cv_prog_CC+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) if test -n "$CC"; then
  ac_cv_prog_CC="$CC" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  case $as_dir in #(((
    '') as_dir=./ ;;
    */) ;;
    *) as_dir=$as_dir/ ;;
  esac
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then
    ac_cv_prog_CC="${ac_tool_prefix}clang"
    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
IFS=$as_save_IFS

fi ;;
esac
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
printf "%s\n" "$CC" >&6; }
else
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
fi


fi
if test -z "$ac_cv_prog_CC"; then
  ac_ct_CC=$CC
  # Extract the first word of "clang", so it can be a program name with args.
set dummy clang; ac_word=$2
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
printf %s "checking for $ac_word... " >&6; }
if test ${ac_cv_prog_ac_ct_CC+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) if test -n "$ac_ct_CC"; then
  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  case $as_dir in #(((
    '') as_dir=./ ;;
    */) ;;
    *) as_dir=$as_dir/ ;;
  esac
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then
    ac_cv_prog_ac_ct_CC="clang"
    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
IFS=$as_save_IFS

fi ;;
esac
fi
ac_ct_CC=$ac_cv_prog_ac_ct_CC
if test -n "$ac_ct_CC"; then
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
printf "%s\n" "$ac_ct_CC" >&6; }
else
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
fi

  if test "x$ac_ct_CC" = x; then
    CC=""
  else
    case $cross_compiling:$ac_tool_warned in
yes:)
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
    CC=$ac_ct_CC
  fi
else
  CC="$ac_cv_prog_CC"
fi

fi


test -z "$CC" && { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5
printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;}
as_fn_error $? "no acceptable C compiler found in \$PATH
See 'config.log' for more details" "$LINENO" 5; }

# Provide some information about the compiler.
printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5
set X $ac_compile
ac_compiler=$2
for ac_option in --version -v -V -qversion -version; do
  { { ac_try="$ac_compiler $ac_option >&5"
case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
printf "%s\n" "$ac_try_echo"; } >&5
  (eval "$ac_compiler $ac_option >&5") 2>conftest.err
  ac_status=$?
  if test -s conftest.err; then
    sed '10a\
... rest of stderr output deleted ...
         10q' conftest.err >conftest.er1
    cat conftest.er1 >&5
  fi
  rm -f conftest.er1 conftest.err
  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; }
done

cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main (void)
{

  ;
  return 0;
}
_ACEOF
ac_clean_files_save=$ac_clean_files
ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out"
# Try to create an executable without -o first, disregard a.out.
# It will help us diagnose broken compilers, and finding out an intuition
# of exeext.
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5
printf %s "checking whether the C compiler works... " >&6; }
ac_link_default=`printf "%s\n" "$ac_link" | sed 's/ -o *conftest[^ ]*//'`

# The possible output files:
ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*"

ac_rmfiles=
for ac_file in $ac_files
do
  case $ac_file in
    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;
    * ) ac_rmfiles="$ac_rmfiles $ac_file";;
  esac
done
rm -f $ac_rmfiles

if { { ac_try="$ac_link_default"
case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
printf "%s\n" "$ac_try_echo"; } >&5
  (eval "$ac_link_default") 2>&5
  ac_status=$?
  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; }
then :
  # Autoconf-2.13 could set the ac_cv_exeext variable to 'no'.
# So ignore a value of 'no', otherwise this would lead to 'EXEEXT = no'
# in a Makefile.  We should not override ac_cv_exeext if it was cached,
# so that the user can short-circuit this test for compilers unknown to
# Autoconf.
for ac_file in $ac_files ''
do
  test -f "$ac_file" || continue
  case $ac_file in
    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj )
	;;
    [ab].out )
	# We found the default executable, but exeext='' is most
	# certainly right.
	break;;
    *.* )
	if test ${ac_cv_exeext+y} && test "$ac_cv_exeext" != no;
	then :; else
	   ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
	fi
	# We set ac_cv_exeext here because the later test for it is not
	# safe: cross compilers may not add the suffix if given an '-o'
	# argument, so we may need to know it at that point already.
	# Even if this section looks crufty: it has the advantage of
	# actually working.
	break;;
    * )
	break;;
  esac
done
test "$ac_cv_exeext" = no && ac_cv_exeext=

else case e in #(
  e) ac_file='' ;;
esac
fi
if test -z "$ac_file"
then :
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
printf "%s\n" "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5
printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;}
as_fn_error 77 "C compiler cannot create executables
See 'config.log' for more details" "$LINENO" 5; }
else case e in #(
  e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
printf "%s\n" "yes" >&6; } ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5
printf %s "checking for C compiler default output file name... " >&6; }
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5
printf "%s\n" "$ac_file" >&6; }
ac_exeext=$ac_cv_exeext

rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out
ac_clean_files=$ac_clean_files_save
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5
printf %s "checking for suffix of executables... " >&6; }
if { { ac_try="$ac_link"
case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
printf "%s\n" "$ac_try_echo"; } >&5
  (eval "$ac_link") 2>&5
  ac_status=$?
  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; }
then :
  # If both 'conftest.exe' and 'conftest' are 'present' (well, observable)
# catch 'conftest.exe'.  For instance with Cygwin, 'ls conftest' will
# work properly (i.e., refer to 'conftest.exe'), while it won't with
# 'rm'.
for ac_file in conftest.exe conftest conftest.*; do
  test -f "$ac_file" || continue
  case $ac_file in
    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;
    *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
	  break;;
    * ) break;;
  esac
done
else case e in #(
  e) { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5
printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;}
as_fn_error $? "cannot compute suffix of executables: cannot compile and link
See 'config.log' for more details" "$LINENO" 5; } ;;
esac
fi
rm -f conftest conftest$ac_cv_exeext
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5
printf "%s\n" "$ac_cv_exeext" >&6; }

rm -f conftest.$ac_ext
EXEEXT=$ac_cv_exeext
ac_exeext=$EXEEXT
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <stdio.h>
int
main (void)
{
FILE *f = fopen ("conftest.out", "w");
 if (!f)
  return 1;
 return ferror (f) || fclose (f) != 0;

  ;
  return 0;
}
_ACEOF
ac_clean_files="$ac_clean_files conftest.out"
# Check that the compiler produces executables we can run.  If not, either
# the compiler is broken, or we cross compile.
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5
printf %s "checking whether we are cross compiling... " >&6; }
if test "$cross_compiling" != yes; then
  { { ac_try="$ac_link"
case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
printf "%s\n" "$ac_try_echo"; } >&5
  (eval "$ac_link") 2>&5
  ac_status=$?
  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; }
  if { ac_try='./conftest$ac_cv_exeext'
  { { case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
printf "%s\n" "$ac_try_echo"; } >&5
  (eval "$ac_try") 2>&5
  ac_status=$?
  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; }; }; then
    cross_compiling=no
  else
    if test "$cross_compiling" = maybe; then
	cross_compiling=yes
    else
	{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5
printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;}
as_fn_error 77 "cannot run C compiled programs.
If you meant to cross compile, use '--host'.
See 'config.log' for more details" "$LINENO" 5; }
    fi
  fi
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5
printf "%s\n" "$cross_compiling" >&6; }

rm -f conftest.$ac_ext conftest$ac_cv_exeext \
  conftest.o conftest.obj conftest.out
ac_clean_files=$ac_clean_files_save
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5
printf %s "checking for suffix of object files... " >&6; }
if test ${ac_cv_objext+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main (void)
{

  ;
  return 0;
}
_ACEOF
rm -f conftest.o conftest.obj
if { { ac_try="$ac_compile"
case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
printf "%s\n" "$ac_try_echo"; } >&5
  (eval "$ac_compile") 2>&5
  ac_status=$?
  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; }
then :
  for ac_file in conftest.o conftest.obj conftest.*; do
  test -f "$ac_file" || continue;
  case $ac_file in
    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;;
    *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`
       break;;
  esac
done
else case e in #(
  e) printf "%s\n" "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5
printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;}
as_fn_error $? "cannot compute suffix of object files: cannot compile
See 'config.log' for more details" "$LINENO" 5; } ;;
esac
fi
rm -f conftest.$ac_cv_objext conftest.$ac_ext ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5
printf "%s\n" "$ac_cv_objext" >&6; }
OBJEXT=$ac_cv_objext
ac_objext=$OBJEXT
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the compiler supports GNU C" >&5
printf %s "checking whether the compiler supports GNU C... " >&6; }
if test ${ac_cv_c_compiler_gnu+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main (void)
{
#ifndef __GNUC__
       choke me
#endif

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
  ac_compiler_gnu=yes
else case e in #(
  e) ac_compiler_gnu=no ;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
ac_cv_c_compiler_gnu=$ac_compiler_gnu
 ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5
printf "%s\n" "$ac_cv_c_compiler_gnu" >&6; }
ac_compiler_gnu=$ac_cv_c_compiler_gnu

if test $ac_compiler_gnu = yes; then
  GCC=yes
else
  GCC=
fi
ac_test_CFLAGS=${CFLAGS+y}
ac_save_CFLAGS=$CFLAGS
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5
printf %s "checking whether $CC accepts -g... " >&6; }
if test ${ac_cv_prog_cc_g+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) ac_save_c_werror_flag=$ac_c_werror_flag
   ac_c_werror_flag=yes
   ac_cv_prog_cc_g=no
   CFLAGS="-g"
   cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
  ac_cv_prog_cc_g=yes
else case e in #(
  e) CFLAGS=""
      cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :

else case e in #(
  e) ac_c_werror_flag=$ac_save_c_werror_flag
	 CFLAGS="-g"
	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
  ac_cv_prog_cc_g=yes
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
   ac_c_werror_flag=$ac_save_c_werror_flag ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5
printf "%s\n" "$ac_cv_prog_cc_g" >&6; }
if test $ac_test_CFLAGS; then
  CFLAGS=$ac_save_CFLAGS
elif test $ac_cv_prog_cc_g = yes; then
  if test "$GCC" = yes; then
    CFLAGS="-g -O2"
  else
    CFLAGS="-g"
  fi
else
  if test "$GCC" = yes; then
    CFLAGS="-O2"
  else
    CFLAGS=
  fi
fi
ac_prog_cc_stdc=no
if test x$ac_prog_cc_stdc = xno
then :
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C11 features" >&5
printf %s "checking for $CC option to enable C11 features... " >&6; }
if test ${ac_cv_prog_cc_c11+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) ac_cv_prog_cc_c11=no
ac_save_CC=$CC
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$ac_c_conftest_c11_program
_ACEOF
for ac_arg in '' -std=gnu11
do
  CC="$ac_save_CC $ac_arg"
  if ac_fn_c_try_compile "$LINENO"
then :
  ac_cv_prog_cc_c11=$ac_arg
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam
  test "x$ac_cv_prog_cc_c11" != "xno" && break
done
rm -f conftest.$ac_ext
CC=$ac_save_CC ;;
esac
fi

if test "x$ac_cv_prog_cc_c11" = xno
then :
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5
printf "%s\n" "unsupported" >&6; }
else case e in #(
  e) if test "x$ac_cv_prog_cc_c11" = x
then :
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5
printf "%s\n" "none needed" >&6; }
else case e in #(
  e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5
printf "%s\n" "$ac_cv_prog_cc_c11" >&6; }
     CC="$CC $ac_cv_prog_cc_c11" ;;
esac
fi
  ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11
  ac_prog_cc_stdc=c11 ;;
esac
fi
fi
if test x$ac_prog_cc_stdc = xno
then :
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C99 features" >&5
printf %s "checking for $CC option to enable C99 features... " >&6; }
if test ${ac_cv_prog_cc_c99+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) ac_cv_prog_cc_c99=no
ac_save_CC=$CC
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$ac_c_conftest_c99_program
_ACEOF
for ac_arg in '' -std=gnu99 -std=c99 -c99 -qlanglvl=extc1x -qlanglvl=extc99 -AC99 -D_STDC_C99=
do
  CC="$ac_save_CC $ac_arg"
  if ac_fn_c_try_compile "$LINENO"
then :
  ac_cv_prog_cc_c99=$ac_arg
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam
  test "x$ac_cv_prog_cc_c99" != "xno" && break
done
rm -f conftest.$ac_ext
CC=$ac_save_CC ;;
esac
fi

if test "x$ac_cv_prog_cc_c99" = xno
then :
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5
printf "%s\n" "unsupported" >&6; }
else case e in #(
  e) if test "x$ac_cv_prog_cc_c99" = x
then :
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5
printf "%s\n" "none needed" >&6; }
else case e in #(
  e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5
printf "%s\n" "$ac_cv_prog_cc_c99" >&6; }
     CC="$CC $ac_cv_prog_cc_c99" ;;
esac
fi
  ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99
  ac_prog_cc_stdc=c99 ;;
esac
fi
fi
if test x$ac_prog_cc_stdc = xno
then :
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C89 features" >&5
printf %s "checking for $CC option to enable C89 features... " >&6; }
if test ${ac_cv_prog_cc_c89+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) ac_cv_prog_cc_c89=no
ac_save_CC=$CC
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$ac_c_conftest_c89_program
_ACEOF
for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
do
  CC="$ac_save_CC $ac_arg"
  if ac_fn_c_try_compile "$LINENO"
then :
  ac_cv_prog_cc_c89=$ac_arg
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam
  test "x$ac_cv_prog_cc_c89" != "xno" && break
done
rm -f conftest.$ac_ext
CC=$ac_save_CC ;;
esac
fi

if test "x$ac_cv_prog_cc_c89" = xno
then :
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5
printf "%s\n" "unsupported" >&6; }
else case e in #(
  e) if test "x$ac_cv_prog_cc_c89" = x
then :
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5
printf "%s\n" "none needed" >&6; }
else case e in #(
  e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5
printf "%s\n" "$ac_cv_prog_cc_c89" >&6; }
     CC="$CC $ac_cv_prog_cc_c89" ;;
esac
fi
  ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89
  ac_prog_cc_stdc=c89 ;;
esac
fi
fi

ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu


{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for inline" >&5
printf %s "checking for inline... " >&6; }
if test ${ac_cv_c_inline+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) ac_cv_c_inline=no
for ac_kw in inline __inline__ __inline; do
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#ifndef __cplusplus
typedef int foo_t;
static $ac_kw foo_t static_foo (void) {return 0; }
$ac_kw foo_t foo (void) {return 0; }
#endif

_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
  ac_cv_c_inline=$ac_kw
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
  test "$ac_cv_c_inline" != no && break
done
 ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_inline" >&5
printf "%s\n" "$ac_cv_c_inline" >&6; }

case $ac_cv_c_inline in
  inline | yes) ;;
  *)
    case $ac_cv_c_inline in
      no) ac_val=;;
      *) ac_val=$ac_cv_c_inline;;
    esac
    cat >>confdefs.h <<_ACEOF
#ifndef __cplusplus
#define inline $ac_val
#endif
_ACEOF
    ;;
esac


if test -n "$ac_tool_prefix"; then
  # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args.
set dummy ${ac_tool_prefix}ar; ac_word=$2
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
printf %s "checking for $ac_word... " >&6; }
if test ${ac_cv_prog_AR+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) if test -n "$AR"; then
  ac_cv_prog_AR="$AR" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  case $as_dir in #(((
    '') as_dir=./ ;;
    */) ;;
    *) as_dir=$as_dir/ ;;
  esac
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then
    ac_cv_prog_AR="${ac_tool_prefix}ar"
    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
IFS=$as_save_IFS

fi ;;
esac
fi
AR=$ac_cv_prog_AR
if test -n "$AR"; then
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $AR" >&5
printf "%s\n" "$AR" >&6; }
else
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
fi


fi
if test -z "$ac_cv_prog_AR"; then
  ac_ct_AR=$AR
  # Extract the first word of "ar", so it can be a program name with args.
set dummy ar; ac_word=$2
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
printf %s "checking for $ac_word... " >&6; }
if test ${ac_cv_prog_ac_ct_AR+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) if test -n "$ac_ct_AR"; then
  ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  case $as_dir in #(((
    '') as_dir=./ ;;
    */) ;;
    *) as_dir=$as_dir/ ;;
  esac
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then
    ac_cv_prog_ac_ct_AR="ar"
    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
IFS=$as_save_IFS

fi ;;
esac
fi
ac_ct_AR=$ac_cv_prog_ac_ct_AR
if test -n "$ac_ct_AR"; then
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5
printf "%s\n" "$ac_ct_AR" >&6; }
else
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
fi

  if test "x$ac_ct_AR" = x; then
    AR=""
  else
    case $cross_compiling:$ac_tool_warned in
yes:)
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
    AR=$ac_ct_AR
  fi
else
  AR="$ac_cv_prog_AR"
fi

if test -n "$ac_tool_prefix"; then
  # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args.
set dummy ${ac_tool_prefix}ranlib; ac_word=$2
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
printf %s "checking for $ac_word... " >&6; }
if test ${ac_cv_prog_RANLIB+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) if test -n "$RANLIB"; then
  ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  case $as_dir in #(((
    '') as_dir=./ ;;
    */) ;;
    *) as_dir=$as_dir/ ;;
  esac
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then
    ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib"
    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
IFS=$as_save_IFS

fi ;;
esac
fi
RANLIB=$ac_cv_prog_RANLIB
if test -n "$RANLIB"; then
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5
printf "%s\n" "$RANLIB" >&6; }
else
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
fi


fi
if test -z "$ac_cv_prog_RANLIB"; then
  ac_ct_RANLIB=$RANLIB
  # Extract the first word of "ranlib", so it can be a program name with args.
set dummy ranlib; ac_word=$2
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
printf %s "checking for $ac_word... " >&6; }
if test ${ac_cv_prog_ac_ct_RANLIB+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) if test -n "$ac_ct_RANLIB"; then
  ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  case $as_dir in #(((
    '') as_dir=./ ;;
    */) ;;
    *) as_dir=$as_dir/ ;;
  esac
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then
    ac_cv_prog_ac_ct_RANLIB="ranlib"
    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
IFS=$as_save_IFS

fi ;;
esac
fi
ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB
if test -n "$ac_ct_RANLIB"; then
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5
printf "%s\n" "$ac_ct_RANLIB" >&6; }
else
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
fi

  if test "x$ac_ct_RANLIB" = x; then
    RANLIB=""
  else
    case $cross_compiling:$ac_tool_warned in
yes:)
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
    RANLIB=$ac_ct_RANLIB
  fi
else
  RANLIB="$ac_cv_prog_RANLIB"
fi

if test -n "$ac_tool_prefix"; then
  # Extract the first word of "${ac_tool_prefix}windres", so it can be a program name with args.
set dummy ${ac_tool_prefix}windres; ac_word=$2
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
printf %s "checking for $ac_word... " >&6; }
if test ${ac_cv_prog_RC+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) if test -n "$RC"; then
  ac_cv_prog_RC="$RC" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  case $as_dir in #(((
    '') as_dir=./ ;;
    */) ;;
    *) as_dir=$as_dir/ ;;
  esac
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then
    ac_cv_prog_RC="${ac_tool_prefix}windres"
    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
IFS=$as_save_IFS

fi ;;
esac
fi
RC=$ac_cv_prog_RC
if test -n "$RC"; then
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $RC" >&5
printf "%s\n" "$RC" >&6; }
else
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
fi


fi
if test -z "$ac_cv_prog_RC"; then
  ac_ct_RC=$RC
  # Extract the first word of "windres", so it can be a program name with args.
set dummy windres; ac_word=$2
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
printf %s "checking for $ac_word... " >&6; }
if test ${ac_cv_prog_ac_ct_RC+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) if test -n "$ac_ct_RC"; then
  ac_cv_prog_ac_ct_RC="$ac_ct_RC" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  case $as_dir in #(((
    '') as_dir=./ ;;
    */) ;;
    *) as_dir=$as_dir/ ;;
  esac
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then
    ac_cv_prog_ac_ct_RC="windres"
    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
IFS=$as_save_IFS

fi ;;
esac
fi
ac_ct_RC=$ac_cv_prog_ac_ct_RC
if test -n "$ac_ct_RC"; then
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RC" >&5
printf "%s\n" "$ac_ct_RC" >&6; }
else
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
fi

  if test "x$ac_ct_RC" = x; then
    RC=""
  else
    case $cross_compiling:$ac_tool_warned in
yes:)
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
    RC=$ac_ct_RC
  fi
else
  RC="$ac_cv_prog_RC"
fi


#--------------------------------------------------------------------
# Checks to see if the make program sets the $MAKE variable.
#--------------------------------------------------------------------

{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5
printf %s "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; }
set x ${MAKE-make}
ac_make=`printf "%s\n" "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'`
if eval test \${ac_cv_prog_make_${ac_make}_set+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) cat >conftest.make <<\_ACEOF
SHELL = /bin/sh
all:
	@echo '@@@%%%=$(MAKE)=@@@%%%'
_ACEOF
# GNU make sometimes prints "make[1]: Entering ...", which would confuse us.
case `${MAKE-make} -f conftest.make 2>/dev/null` in
  *@@@%%%=?*=@@@%%%*)
    eval ac_cv_prog_make_${ac_make}_set=yes;;
  *)
    eval ac_cv_prog_make_${ac_make}_set=no;;
esac
rm -f conftest.make ;;
esac
fi
if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
printf "%s\n" "yes" >&6; }
  SET_MAKE=
else
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
  SET_MAKE="MAKE=${MAKE-make}"
fi


#--------------------------------------------------------------------
# Determines the correct binary file extension (.o, .obj, .exe etc.)
#--------------------------------------------------------------------




#------------------------------------------------------------------------
# Embedded configuration information, encoding to use for the values, TIP #59
#------------------------------------------------------------------------



# Check whether --with-encoding was given.
if test ${with_encoding+y}
then :
  withval=$with_encoding; with_tcencoding=${withval}
fi


    if test x"${with_tcencoding}" != x ; then
	printf "%s\n" "#define TCL_CFGVAL_ENCODING \"${with_tcencoding}\"" >>confdefs.h

    else
	printf "%s\n" "#define TCL_CFGVAL_ENCODING \"utf-8\"" >>confdefs.h

    fi


#--------------------------------------------------------------------
# The statements below define a collection of symbols related to
# building libtcl as a shared library instead of a static library.
#--------------------------------------------------------------------


    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking how to build libraries" >&5
printf %s "checking how to build libraries... " >&6; }
    # Check whether --enable-shared was given.
if test ${enable_shared+y}
then :
  enableval=$enable_shared; tcl_ok=$enableval
else case e in #(
  e) tcl_ok=yes ;;
esac
fi

    if test "$tcl_ok" = "yes" ; then
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: shared" >&5
printf "%s\n" "shared" >&6; }
	SHARED_BUILD=1
    else
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: static" >&5
printf "%s\n" "static" >&6; }
	SHARED_BUILD=0

printf "%s\n" "#define STATIC_BUILD 1" >>confdefs.h

    fi



#--------------------------------------------------------------------
# The statements below define a collection of compile flags.  This
# macro depends on the value of SHARED_BUILD, and should be called
# after SC_ENABLE_SHARED checks the configure switches.
#--------------------------------------------------------------------

ac_header= ac_cache=
for ac_item in $ac_header_c_list
do
  if test $ac_cache; then
    ac_fn_c_check_header_compile "$LINENO" $ac_header ac_cv_header_$ac_cache "$ac_includes_default"
    if eval test \"x\$ac_cv_header_$ac_cache\" = xyes; then
      printf "%s\n" "#define $ac_item 1" >> confdefs.h
    fi
    ac_header= ac_cache=
  elif test $ac_header; then
    ac_cache=$ac_item
  else
    ac_header=$ac_item
  fi
done








if test $ac_cv_header_stdlib_h = yes && test $ac_cv_header_string_h = yes
then :

printf "%s\n" "#define STDC_HEADERS 1" >>confdefs.h

fi


    # Step 0: Enable 64 bit support?

    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if 64bit support is requested" >&5
printf %s "checking if 64bit support is requested... " >&6; }
    # Check whether --enable-64bit was given.
if test ${enable_64bit+y}
then :
  enableval=$enable_64bit; do64bit=$enableval
else case e in #(
  e) do64bit=no ;;
esac
fi

    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $do64bit" >&5
printf "%s\n" "$do64bit" >&6; }

    # Set some defaults (may get changed below)
    EXTRA_CFLAGS=""

printf "%s\n" "#define MODULE_SCOPE extern" >>confdefs.h


    # Extract the first word of "cygpath", so it can be a program name with args.
set dummy cygpath; ac_word=$2
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
printf %s "checking for $ac_word... " >&6; }
if test ${ac_cv_prog_CYGPATH+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) if test -n "$CYGPATH"; then
  ac_cv_prog_CYGPATH="$CYGPATH" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  case $as_dir in #(((
    '') as_dir=./ ;;
    */) ;;
    *) as_dir=$as_dir/ ;;
  esac
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then
    ac_cv_prog_CYGPATH="cygpath -m"
    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
IFS=$as_save_IFS

  test -z "$ac_cv_prog_CYGPATH" && ac_cv_prog_CYGPATH="echo"
fi ;;
esac
fi
CYGPATH=$ac_cv_prog_CYGPATH
if test -n "$CYGPATH"; then
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CYGPATH" >&5
printf "%s\n" "$CYGPATH" >&6; }
else
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
fi


    # Extract the first word of "wine", so it can be a program name with args.
set dummy wine; ac_word=$2
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
printf %s "checking for $ac_word... " >&6; }
if test ${ac_cv_prog_WINE+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) if test -n "$WINE"; then
  ac_cv_prog_WINE="$WINE" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  case $as_dir in #(((
    '') as_dir=./ ;;
    */) ;;
    *) as_dir=$as_dir/ ;;
  esac
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then
    ac_cv_prog_WINE="wine"
    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
IFS=$as_save_IFS

fi ;;
esac
fi
WINE=$ac_cv_prog_WINE
if test -n "$WINE"; then
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $WINE" >&5
printf "%s\n" "$WINE" >&6; }
else
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
fi



    SHLIB_SUFFIX=".dll"

    # MACHINE is IX86 for LINK, but this is used by the manifest,
    # which requires x86|amd64|arm64|ia64.
    MACHINE="X86"

    if test "$GCC" = "yes"; then

      { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for cross-compile version of gcc" >&5
printf %s "checking for cross-compile version of gcc... " >&6; }
if test ${ac_cv_cross+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

	    #ifndef _WIN32
		#error cross-compiler
	    #endif

int
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
  ac_cv_cross=no
else case e in #(
  e) ac_cv_cross=yes ;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
       ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cross" >&5
printf "%s\n" "$ac_cv_cross" >&6; }

      if test "$ac_cv_cross" = "yes"; then
	case "$do64bit" in
	    amd64|x64|yes)
		CC="x86_64-w64-mingw32-${CC}"
		LD="x86_64-w64-mingw32-ld"
		AR="x86_64-w64-mingw32-ar"
		RANLIB="x86_64-w64-mingw32-ranlib"
		RC="x86_64-w64-mingw32-windres"
	    ;;
	    arm64|aarch64)
		CC="aarch64-w64-mingw32-${CC}"
		LD="aarch64-w64-mingw32-ld"
		AR="aarch64-w64-mingw32-ar"
		RANLIB="aarch64-w64-mingw32-ranlib"
		RC="aarch64-w64-mingw32-windres"
	    ;;
	    *)
		CC="i686-w64-mingw32-${CC}"
		LD="i686-w64-mingw32-ld"
		AR="i686-w64-mingw32-ar"
		RANLIB="i686-w64-mingw32-ranlib"
		RC="i686-w64-mingw32-windres"
	    ;;
	esac
      fi
    fi

    # Check for a bug in gcc's windres that causes the
    # compile to fail when a Windows native path is
    # passed into windres. The mingw toolchain requires
    # Windows native paths while Cygwin should work
    # with both. Avoid the bug by passing a POSIX
    # path when using the Cygwin toolchain.

    if test "$GCC" = "yes" && test "$CYGPATH" != "echo" ; then
	conftest=/tmp/conftest.rc
	echo "STRINGTABLE BEGIN" > $conftest
	echo "101 \"name\"" >> $conftest
	echo "END" >> $conftest

	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for Windows native path bug in windres" >&5
printf %s "checking for Windows native path bug in windres... " >&6; }
	cyg_conftest=`$CYGPATH $conftest`
	if { ac_try='$RC -o conftest.res.o $cyg_conftest'
  { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_try\""; } >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; }; } ; then
	    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
	else
	    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
printf "%s\n" "yes" >&6; }
	    CYGPATH=echo
	fi
	conftest=
	cyg_conftest=
    fi

    if test "$CYGPATH" = "echo"; then
	DEPARG='"$<"'
    else
	DEPARG='"$(shell $(CYGPATH) $<)"'
    fi

    # set various compiler flags depending on whether we are using gcc or cl

    if test "${GCC}" = "yes" ; then
	extra_cflags="-pipe"
	extra_ldflags="-pipe -static-libgcc"
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for mingw32 version of gcc" >&5
printf %s "checking for mingw32 version of gcc... " >&6; }
if test ${ac_cv_win32+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

		#ifdef _WIN32
		    #error win32
		#endif

int
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
  ac_cv_win32=no
else case e in #(
  e) ac_cv_win32=yes ;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
	 ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_win32" >&5
printf "%s\n" "$ac_cv_win32" >&6; }
	if test "$ac_cv_win32" != "yes"; then
	    as_fn_error $? "${CC} cannot produce win32 executables." "$LINENO" 5
	fi
	if test "$do64bit" != "arm64"; then
	    extra_cflags="$extra_cflags -DHAVE_CPUID=1"
	fi

	hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain"
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for working -municode linker flag" >&5
printf %s "checking for working -municode linker flag... " >&6; }
if test ${ac_cv_municode+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e)
# ac_fn_c_try_link LINENO
# -----------------------
# Try to link conftest.$ac_ext, and return whether this succeeded.
ac_fn_c_try_link ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
  rm -f conftest.$ac_objext conftest.beam conftest$ac_exeext
  if { { ac_try="$ac_link"
case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
printf "%s\n" "$ac_try_echo"; } >&5
  (eval "$ac_link") 2>conftest.err
  ac_status=$?
  if test -s conftest.err; then
    grep -v '^ *+' conftest.err >conftest.er1
    cat conftest.er1 >&5
    mv -f conftest.er1 conftest.err
  fi
  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; } && {
	 test -z "$ac_c_werror_flag" ||
	 test ! -s conftest.err
       } && test -s conftest$ac_exeext && {
	 test "$cross_compiling" = yes ||
	 test -x conftest$ac_exeext
       }
then :
  ac_retval=0
else case e in #(
  e) printf "%s\n" "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

	ac_retval=1 ;;
esac
fi
  # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information
  # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would
  # interfere with the next link command; also delete a directory that is
  # left behind by Apple's compiler.  We do this before executing the actions.
  rm -rf conftest.dSYM conftest_ipa8_conftest.oo
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
  as_fn_set_status $ac_retval

} # ac_fn_c_try_link
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

	#include <windows.h>
	int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;}

int
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"
then :
  ac_cv_municode=yes
else case e in #(
  e) ac_cv_municode=no ;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    conftest$ac_exeext conftest.$ac_ext
	 ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_municode" >&5
printf "%s\n" "$ac_cv_municode" >&6; }
	CFLAGS=$hold_cflags
	if test "$ac_cv_municode" = "yes" ; then
	    extra_ldflags="$extra_ldflags -municode"
	else
	    extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS"
	fi
	hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -fno-lto"
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for working -fno-lto" >&5
printf %s "checking for working -fno-lto... " >&6; }
if test ${ac_cv_nolto+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
  ac_cv_nolto=yes
else case e in #(
  e) ac_cv_nolto=no ;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
	 ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_nolto" >&5
printf "%s\n" "$ac_cv_nolto" >&6; }
	CFLAGS=$hold_cflags
	if test "$ac_cv_nolto" = "yes" ; then
	    CFLAGS_NOLTO="-fno-lto"
	else
	    CFLAGS_NOLTO=""
	fi
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if the compiler understands -finput-charset" >&5
printf %s "checking if the compiler understands -finput-charset... " >&6; }
if test ${tcl_cv_cc_input_charset+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e)
	    hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -finput-charset=UTF-8"
	    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_cc_input_charset=yes
else case e in #(
  e) tcl_cv_cc_input_charset=no ;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
	    CFLAGS=$hold_cflags ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_input_charset" >&5
printf "%s\n" "$tcl_cv_cc_input_charset" >&6; }
	if test $tcl_cv_cc_input_charset = yes; then
	    extra_cflags="$extra_cflags -finput-charset=UTF-8"
	fi
    fi

    hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Wl,--enable-auto-image-base"
    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for working --enable-auto-image-base" >&5
printf %s "checking for working --enable-auto-image-base... " >&6; }
if test ${ac_cv_enable_auto_image_base+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
  ac_cv_enable_auto_image_base=yes
else case e in #(
  e) ac_cv_enable_auto_image_base=no ;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
     ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_enable_auto_image_base" >&5
printf "%s\n" "$ac_cv_enable_auto_image_base" >&6; }
    CFLAGS=$hold_cflags
    if test "$ac_cv_enable_auto_image_base" = "yes" ; then
	extra_ldflags="$extra_ldflags -Wl,--enable-auto-image-base"
    fi

    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking compiler flags" >&5
printf %s "checking compiler flags... " >&6; }
    if test "${GCC}" = "yes" ; then
	SHLIB_LD=""
	SHLIB_LD_LIBS='${LIBS}'
	LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -luserenv -lws2_32"
	# mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't
	LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32 -lwinspool"
	STLIB_LD='${AR} cr'
	RC_OUT=-o
	RC_TYPE=
	RC_INCLUDE=--include
	RC_DEFINE=--define
	RES=res.o
	MAKE_LIB="\${STLIB_LD} \$@"
	MAKE_STUB_LIB="\${STLIB_LD} \$@"
	POST_MAKE_LIB="\${RANLIB} \$@"
	MAKE_EXE="\${CC} -o \$@"
	LIBPREFIX="lib"

	if test "${SHARED_BUILD}" = "0" ; then
	    # static
	    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: using static flags" >&5
printf "%s\n" "using static flags" >&6; }
	    runtime=
	    LIBRARIES="\${STATIC_LIBRARIES}"
	    EXESUFFIX="s.exe"
	else
	    # dynamic
	    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: using shared flags" >&5
printf "%s\n" "using shared flags" >&6; }

	    # ad-hoc check to see if CC supports -shared.
	    if "${CC}" -shared 2>&1 | egrep ': -shared not supported' >/dev/null; then
		as_fn_error $? "${CC} does not support the -shared option.
		You will need to upgrade to a newer version of the toolchain." "$LINENO" 5
	    fi

	    runtime=
	    # Add SHLIB_LD_LIBS to the Make rule, not here.

	    EXESUFFIX=".exe"
	    LIBRARIES="\${SHARED_LIBRARIES}"
	fi
	# Link with gcc since ld does not link to default libs like
	# -luser32 and -lmsvcrt by default.
	SHLIB_LD='${CC} -shared'
	SHLIB_LD_LIBS='${LIBS}'
	MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \$@ ${extra_ldflags} \
	    -Wl,--out-implib,\$(patsubst %.dll,lib%.dll.a,\$@)"
	# DLLSUFFIX is separate because it is the building block for
	# users of tclConfig.sh that may build shared or static.
	DLLSUFFIX=".dll"
	LIBSUFFIX=".a"
	LIBFLAGSUFFIX=""
	SHLIB_SUFFIX=.dll

	EXTRA_CFLAGS="${extra_cflags}"

	CFLAGS_DEBUG=-g
	CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
	CFLAGS_WARNING="-Wall -Wextra -Wshadow -Wundef -Wwrite-strings -Wpointer-arith"
	LDFLAGS_DEBUG=
	LDFLAGS_OPTIMIZE=

	case "${CC}" in
	    *++)
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wno-format"
		;;
	    *)
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wc++-compat -fextended-identifiers"
		;;
	esac

	# Specify the CC output file names based on the target name
	CC_OBJNAME="-o \$@"
	CC_EXENAME="-o \$@"

	# Specify linker flags depending on the type of app being
	# built -- Console vs. Window.
	#
	# ORIGINAL COMMENT:
	# We need to pass -e _WinMain@16 so that ld will use
	# WinMain() instead of main() as the entry point. We can't
	# use autoconf to check for this case since it would need
	# to run an executable and that does not work when
	# cross compiling. Remove this -e workaround once we
	# require a gcc that does not have this bug.
	#
	# MK NOTE: Tk should use a different mechanism. This causes
	# interesting problems, such as wish dying at startup.
	#LDFLAGS_WINDOW="-mwindows -e _WinMain@16 ${extra_ldflags}"
	LDFLAGS_CONSOLE="-mconsole ${extra_ldflags}"
	LDFLAGS_WINDOW="-mwindows ${extra_ldflags}"

	case "$do64bit" in
	    amd64|x64|yes)
		MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
		{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result:    Using 64-bit $MACHINE mode" >&5
printf "%s\n" "   Using 64-bit $MACHINE mode" >&6; }
		;;
	    arm64|aarch64)
		MACHINE="ARM64"
		{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result:    Using ARM64 $MACHINE mode" >&5
printf "%s\n" "   Using ARM64 $MACHINE mode" >&6; }
		;;
	    ia64)
		MACHINE="IA64"
		{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result:    Using IA64 $MACHINE mode" >&5
printf "%s\n" "   Using IA64 $MACHINE mode" >&6; }
		;;
	    *)
		cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

		    #ifndef _WIN64
			#error 32-bit
		    #endif

int
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_win_64bit=yes
else case e in #(
  e) tcl_win_64bit=no
		 ;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
		if test "$tcl_win_64bit" = "yes" ; then
		    do64bit=amd64
		    MACHINE="AMD64"
		    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result:    Using 64-bit $MACHINE mode" >&5
printf "%s\n" "   Using 64-bit $MACHINE mode" >&6; }
		fi
		;;
	esac
    else
	if test "${SHARED_BUILD}" = "0" ; then
	    # static
	    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: using static flags" >&5
printf "%s\n" "using static flags" >&6; }
	    runtime=-MT
	    LIBRARIES="\${STATIC_LIBRARIES}"
	    EXESUFFIX="s.exe"
	else
	    # dynamic
	    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: using shared flags" >&5
printf "%s\n" "using shared flags" >&6; }
	    runtime=-MD
	    # Add SHLIB_LD_LIBS to the Make rule, not here.
	    LIBRARIES="\${SHARED_LIBRARIES}"
	    EXESUFFIX=".exe"
	    case "x`echo \${VisualStudioVersion}`" in
		x1[4-9]*)
		    lflags="${lflags} -nodefaultlib:libucrt.lib"
		    ;;
		*)
		    ;;
	    esac
	fi
	MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\$@"
	# DLLSUFFIX is separate because it is the building block for
	# users of tclConfig.sh that may build shared or static.
	DLLSUFFIX=".dll"
	LIBSUFFIX=".lib"
	LIBFLAGSUFFIX=""

	if test "$do64bit" != "no" ; then
	    case "$do64bit" in
		amd64|x64|yes)
		    MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
		    ;;
		arm64|aarch64)
		    MACHINE="ARM64"
		    ;;
		ia64)
		    MACHINE="IA64"
		    ;;
	    esac
	    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result:    Using 64-bit $MACHINE mode" >&5
printf "%s\n" "   Using 64-bit $MACHINE mode" >&6; }
	fi

	LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib"

	case "x`echo \${VisualStudioVersion}`" in
		x1[4-9]*)
		    LIBS="$LIBS ucrt.lib"
		    ;;
		*)
		    ;;
	esac

	if test "$do64bit" != "no" ; then
	    RC="rc"
	    CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d"
	    CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}"
	    lflags="${lflags} -nologo -MACHINE:${MACHINE}"
	    LINKBIN="link"
	    # Avoid 'unresolved external symbol __security_cookie' errors.
	    # c.f. http://support.microsoft.com/?id=894573
	    LIBS="$LIBS bufferoverflowU.lib"
	else
	    RC="rc"
	    # -Od - no optimization
	    # -WX - warnings as errors
	    CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d"
	    # -O2 - create fast code (/Og /Oi /Ot /Oy /Ob2 /Gs /GF /Gy)
	    CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}"
	    lflags="${lflags} -nologo"
	    LINKBIN="link"
	fi

	LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib winspool.lib"

	SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}"
	SHLIB_LD_LIBS='${LIBS}'
	# link -lib only works when -lib is the first arg
	STLIB_LD="${LINKBIN} -lib ${lflags}"
	RC_OUT=-fo
	RC_TYPE=-r
	RC_INCLUDE=-i
	RC_DEFINE=-d
	RES=res
	MAKE_LIB="\${STLIB_LD} -out:\$@"
	MAKE_STUB_LIB="\${STLIB_LD} -nodefaultlib -out:\$@"
	POST_MAKE_LIB=
	MAKE_EXE="\${CC} -Fe\$@"
	LIBPREFIX=""

	CFLAGS_DEBUG="${CFLAGS_DEBUG} -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE"
	CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE"

	EXTRA_CFLAGS=""
	CFLAGS_WARNING="-W3"
	LDFLAGS_DEBUG="-debug"
	LDFLAGS_OPTIMIZE="-release"

	# Specify the CC output file names based on the target name
	CC_OBJNAME="-Fo\$@"
	CC_EXENAME="-Fe\"\$(shell \$(CYGPATH) '\$@')\""

	# Specify linker flags depending on the type of app being
	# built -- Console vs. Window.
	if test "${TARGETCPU}" != "X86"; then
	    LDFLAGS_CONSOLE="-link ${lflags}"
	    LDFLAGS_WINDOW=${LDFLAGS_CONSOLE}
	else
	    LDFLAGS_CONSOLE="-link -subsystem:console ${lflags}"
	    LDFLAGS_WINDOW="-link -subsystem:windows ${lflags}"
	fi
    fi

    if test "$do64bit" != "no" ; then
	printf "%s\n" "#define TCL_CFG_DO64BIT 1" >>confdefs.h

    fi

    if test "${GCC}" = "yes" ; then
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for SEH support in compiler" >&5
printf %s "checking for SEH support in compiler... " >&6; }
if test ${tcl_cv_seh+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) if test "$cross_compiling" = yes
then :
  tcl_cv_seh=no
else case e in #(
  e)
# ac_fn_c_try_run LINENO
# ----------------------
# Try to run conftest.$ac_ext, and return whether this succeeded. Assumes that
# executables *can* be run.
ac_fn_c_try_run ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
  if { { ac_try="$ac_link"
case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
printf "%s\n" "$ac_try_echo"; } >&5
  (eval "$ac_link") 2>&5
  ac_status=$?
  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; } && { ac_try='./conftest$ac_exeext'
  { { case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
printf "%s\n" "$ac_try_echo"; } >&5
  (eval "$ac_try") 2>&5
  ac_status=$?
  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; }; }
then :
  ac_retval=0
else case e in #(
  e) printf "%s\n" "$as_me: program exited with status $ac_status" >&5
       printf "%s\n" "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

       ac_retval=$ac_status ;;
esac
fi
  rm -rf conftest.dSYM conftest_ipa8_conftest.oo
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
  as_fn_set_status $ac_retval

} # ac_fn_c_try_run
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

	    #define WIN32_LEAN_AND_MEAN
	    #include <windows.h>
	    #undef WIN32_LEAN_AND_MEAN

	    int main(int argc, char** argv) {
		int a, b = 0;
		__try {
		    a = 666 / b;
		}
		__except (EXCEPTION_EXECUTE_HANDLER) {
		    return 0;
		}
		return 1;
	    }

_ACEOF
if ac_fn_c_try_run "$LINENO"
then :
  tcl_cv_seh=yes
else case e in #(
  e) tcl_cv_seh=no ;;
esac
fi
rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
  conftest.$ac_objext conftest.beam conftest.$ac_ext ;;
esac
fi

	 ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_seh" >&5
printf "%s\n" "$tcl_cv_seh" >&6; }
	if test "$tcl_cv_seh" = "no" ; then

printf "%s\n" "#define HAVE_NO_SEH 1" >>confdefs.h

	fi

	#
	# Check to see if the excpt.h include file provided contains the
	# definition for EXCEPTION_DISPOSITION; if not, which is the case
	# with Cygwin's version as of 2002-04-10, define it to be int,
	# sufficient for getting the current code to work.
	#
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for EXCEPTION_DISPOSITION support in include files" >&5
printf %s "checking for EXCEPTION_DISPOSITION support in include files... " >&6; }
if test ${tcl_cv_eh_disposition+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

#	    define WIN32_LEAN_AND_MEAN
#	    include <windows.h>
#	    undef WIN32_LEAN_AND_MEAN

int
main (void)
{

		EXCEPTION_DISPOSITION x;

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_eh_disposition=yes
else case e in #(
  e) tcl_cv_eh_disposition=no ;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
	 ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_eh_disposition" >&5
printf "%s\n" "$tcl_cv_eh_disposition" >&6; }
	if test "$tcl_cv_eh_disposition" = "no" ; then

printf "%s\n" "#define EXCEPTION_DISPOSITION int" >>confdefs.h

	fi

	ac_fn_c_check_header_compile "$LINENO" "stdbool.h" "ac_cv_header_stdbool_h" "$ac_includes_default"
if test "x$ac_cv_header_stdbool_h" = xyes
then :

printf "%s\n" "#define HAVE_STDBOOL_H 1" >>confdefs.h

fi


	# See if the compiler supports casting to a union type.
	# This is used to stop gcc from printing a compiler
	# warning when initializing a union member.

	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for cast to union support" >&5
printf %s "checking for cast to union support... " >&6; }
if test ${tcl_cv_cast_to_union+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main (void)
{

		  union foo { int i; double d; };
		  union foo f = (union foo) (int) 0;

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_cast_to_union=yes
else case e in #(
  e) tcl_cv_cast_to_union=no ;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
	 ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cast_to_union" >&5
printf "%s\n" "$tcl_cv_cast_to_union" >&6; }
	if test "$tcl_cv_cast_to_union" = "yes"; then

printf "%s\n" "#define HAVE_CAST_TO_UNION 1" >>confdefs.h

	fi
    fi

    # DL_LIBS is empty, but then we match the Unix version







# Cross-compiling
case ${host_alias} in
*mingw32*)
    TCL_EXE="tclsh"
    ;;
*)
    TCL_EXE="TCL_LIBRARY=\"\${LIBRARY_DIR}\"; export TCL_LIBRARY; ./\${TCLSH}"
    ;;
esac

#------------------------------------------------------------------------
#	Add stuff for zlib/libtommath; note that this is mostly done in the
#	makefile now as we just assume that the platform hasn't got usable
#   z.lib/tommath.lib
#------------------------------------------------------------------------

if test "${enable_shared+set}" = "set"
then :

  enableval="$enable_shared"
  tcl_ok=$enableval

else case e in #(
  e)
  tcl_ok=yes
 ;;
esac
fi
zlib_lib_name=zdll.lib
tommath_lib_name=tommath.lib
if test "$tcl_ok" = "yes"
then :

  ZLIB_DLL_FILE=\${ZLIB_DLL_FILE}

  TOMMATH_DLL_FILE=\${TOMMATH_DLL_FILE}


printf "%s\n" "#define TCL_WITH_EXTERNAL_TOMMATH 1" >>confdefs.h

  if test "$do64bit" != "no"
then :


printf "%s\n" "#define MP_64BIT 1" >>confdefs.h

    if test "$do64bit" = "arm64"
then :

      if test "$GCC" = "yes"
then :

        ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64-arm/libz.dll.a

        TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64-arm/libtommath.dll.a

        zlib_lib_name=libz.dll.a
        tommath_lib_name=libtommath.dll.a

else case e in #(
  e)
        ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64-arm/zdll.lib

        TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64-arm/tommath.lib

       ;;
esac
fi

else case e in #(
  e)
      if test "$GCC" = "yes"
then :

        ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64/libz.dll.a

        TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64/libtommath.dll.a

        zlib_lib_name=libz.dll.a
        tommath_lib_name=libtommath.dll.a

else case e in #(
  e)
        ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64/zdll.lib

        TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64/tommath.lib

       ;;
esac
fi
     ;;
esac
fi

else case e in #(
  e)
    ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win32/zdll.lib

    TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win32/tommath.lib

   ;;
esac
fi

else case e in #(
  e)

printf "%s\n" "#define TCL_WITH_INTERNAL_ZLIB 1" >>confdefs.h

  ZLIB_OBJS=\${ZLIB_OBJS}

  TOMMATH_OBJS=\${TOMMATH_OBJS}

 ;;
esac
fi

printf "%s\n" "#define HAVE_ZLIB 1" >>confdefs.h

TCL_ZLIB_LIB_NAME=$zlib_lib_name

TCL_TOMMATH_LIB_NAME=$tommath_lib_name

ac_fn_c_check_type "$LINENO" "intptr_t" "ac_cv_type_intptr_t" "
#include <stdint.h>

"
if test "x$ac_cv_type_intptr_t" = xyes
then :

printf "%s\n" "#define HAVE_INTPTR_T 1" >>confdefs.h


fi
ac_fn_c_check_type "$LINENO" "uintptr_t" "ac_cv_type_uintptr_t" "
#include <stdint.h>

"
if test "x$ac_cv_type_uintptr_t" = xyes
then :

printf "%s\n" "#define HAVE_UINTPTR_T 1" >>confdefs.h


fi


#--------------------------------------------------------------------
#	Zipfs support - Tip 430
#--------------------------------------------------------------------
# Check whether --enable-zipfs was given.
if test ${enable_zipfs+y}
then :
  enableval=$enable_zipfs; tcl_ok=$enableval
else case e in #(
  e) tcl_ok=yes ;;
esac
fi

if test "$tcl_ok" = "yes" ; then
    #
    # Find a native compiler
    #
    # Put a plausible default for CC_FOR_BUILD in Makefile.
if test -z "$CC_FOR_BUILD"; then
  if test "x$cross_compiling" = "xno"; then
    CC_FOR_BUILD='$(CC)'
  else
    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for gcc" >&5
printf %s "checking for gcc... " >&6; }
    if test ${ac_cv_path_cc+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e)
	search_path=`echo ${PATH} | sed -e 's/:/ /g'`
	for dir in $search_path ; do
	    for j in `ls -r $dir/gcc 2> /dev/null` \
		    `ls -r $dir/gcc 2> /dev/null` ; do
		if test x"$ac_cv_path_cc" = x ; then
		    if test -f "$j" ; then
			ac_cv_path_cc=$j
			break
		    fi
		fi
	    done
	done
     ;;
esac
fi

  fi
fi

# Also set EXEEXT_FOR_BUILD.
if test "x$cross_compiling" = "xno"; then
  EXEEXT_FOR_BUILD='$(EXEEXT)'
  OBJEXT_FOR_BUILD='$(OBJEXT)'
else
  OBJEXT_FOR_BUILD='.no'
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for build system executable suffix" >&5
printf %s "checking for build system executable suffix... " >&6; }
if test ${bfd_cv_build_exeext+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) rm -f conftest*
     echo 'int main () { return 0; }' > conftest.c
     bfd_cv_build_exeext=
     ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5
     for file in conftest.*; do
       case $file in
       *.c | *.o | *.obj | *.ilk | *.pdb) ;;
       *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;;
       esac
     done
     rm -f conftest*
     test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5
printf "%s\n" "$bfd_cv_build_exeext" >&6; }
  EXEEXT_FOR_BUILD=""
  test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext}
fi

    #
    # Find a native zip implementation
    #

    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for tclsh" >&5
printf %s "checking for tclsh... " >&6; }

    if test ${ac_cv_path_tclsh+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e)
	search_path=`echo ${PATH} | sed -e 's/:/ /g'`
	for dir in $search_path ; do
	    for j in `ls -r $dir/tclsh[8-9]*.exe 2> /dev/null` \
		    `ls -r $dir/tclsh* 2> /dev/null` ; do
		if test x"$ac_cv_path_tclsh" = x ; then
		    if test -f "$j" ; then
			ac_cv_path_tclsh=$j
			break
		    fi
		fi
	    done
	done
     ;;
esac
fi


    if test -f "$ac_cv_path_tclsh" ; then
	TCLSH_PROG="$ac_cv_path_tclsh"
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $TCLSH_PROG" >&5
printf "%s\n" "$TCLSH_PROG" >&6; }
    else
	# It is not an error if an installed version of Tcl can't be located.
	TCLSH_PROG=""
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: No tclsh found on PATH" >&5
printf "%s\n" "No tclsh found on PATH" >&6; }
    fi



    ZIP_PROG=""
    ZIP_PROG_OPTIONS=""
    ZIP_PROG_VFSSEARCH=""
    ZIP_INSTALL_OBJS=""

    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for zip" >&5
printf %s "checking for zip... " >&6; }
    if test ${ac_cv_path_zip+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e)
    search_path=`echo ${PATH} | sed -e 's/:/ /g'`
    for dir in $search_path ; do
	for j in `ls -r $dir/zip 2> /dev/null` \
	    `ls -r $dir/zip 2> /dev/null` ; do
	if test x"$ac_cv_path_zip" = x ; then
	    if test -f "$j" ; then
	    ac_cv_path_zip=$j
	    break
	    fi
	fi
	done
    done
     ;;
esac
fi

    if test -f "$ac_cv_path_zip" ; then
	ZIP_PROG="$ac_cv_path_zip"
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5
printf "%s\n" "$ZIP_PROG" >&6; }
	ZIP_PROG_OPTIONS="-rq"
	ZIP_PROG_VFSSEARCH="*"
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: Found INFO Zip in environment" >&5
printf "%s\n" "Found INFO Zip in environment" >&6; }
	# Use standard arguments for zip
    else
	# It is not an error if an installed version of Zip can't be located.
	# We can use the locally distributed minizip instead
	ZIP_PROG="./minizip${EXEEXT_FOR_BUILD}"
	ZIP_PROG_OPTIONS="-o -r"
	ZIP_PROG_VFSSEARCH="*"
	ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}"
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH building minizip" >&5
printf "%s\n" "No zip found on PATH building minizip" >&6; }
    fi





	ZIPFS_BUILD=1
	TCL_ZIP_FILE=libtcl${TCL_MAJOR_VERSION}.${TCL_MINOR_VERSION}${TCL_PATCH_LEVEL}.zip
else
	ZIPFS_BUILD=0
	TCL_ZIP_FILE=
fi
# Do checking message here to not mess up interleaved configure output
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for building with zipfs" >&5
printf %s "checking for building with zipfs... " >&6; }
if test "${ZIPFS_BUILD}" = 1; then
    if test "${SHARED_BUILD}" = 0; then
       ZIPFS_BUILD=2;

printf "%s\n" "#define ZIPFS_BUILD 2" >>confdefs.h

     else

printf "%s\n" "#define ZIPFS_BUILD 1" >>confdefs.h
\
    fi
    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
printf "%s\n" "yes" >&6; }
else
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
INSTALL_LIBRARIES=install-libraries
INSTALL_MSGS=install-msgs
fi






#--------------------------------------------------------------------
# Perform additinal compiler tests.
#--------------------------------------------------------------------

# See if declarations like FINDEX_INFO_LEVELS are
# missing from winbase.h. This is known to be
# a problem with VC++ 5.2.

{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for FINDEX_INFO_LEVELS in winbase.h" >&5
printf %s "checking for FINDEX_INFO_LEVELS in winbase.h... " >&6; }
if test ${tcl_cv_findex_enums+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN

int
main (void)
{

  FINDEX_INFO_LEVELS i;
  FINDEX_SEARCH_OPS j;

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_findex_enums=yes
else case e in #(
  e) tcl_cv_findex_enums=no ;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
 ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_findex_enums" >&5
printf "%s\n" "$tcl_cv_findex_enums" >&6; }
if test "$tcl_cv_findex_enums" = "no"; then

printf "%s\n" "#define HAVE_NO_FINDEX_ENUMS 1" >>confdefs.h

fi

# See if the compiler supports intrinsics.

{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for intrinsics support in compiler" >&5
printf %s "checking for intrinsics support in compiler... " >&6; }
if test ${tcl_cv_intrinsics+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
#include <intrin.h>

int
main (void)
{

  __cpuidex(0,0,0);

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"
then :
  tcl_cv_intrinsics=yes
else case e in #(
  e) tcl_cv_intrinsics=no ;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    conftest$ac_exeext conftest.$ac_ext
 ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_intrinsics" >&5
printf "%s\n" "$tcl_cv_intrinsics" >&6; }
if test "$tcl_cv_intrinsics" = "yes"; then

printf "%s\n" "#define HAVE_INTRIN_H 1" >>confdefs.h

fi

# See if the <wspiapi.h> header file is present

{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for wspiapi.h" >&5
printf %s "checking for wspiapi.h... " >&6; }
if test ${tcl_cv_wspiapi_h+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

#include <wspiapi.h>

int
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_wspiapi_h=yes
else case e in #(
  e) tcl_cv_wspiapi_h=no ;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
 ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_wspiapi_h" >&5
printf "%s\n" "$tcl_cv_wspiapi_h" >&6; }
if test "$tcl_cv_wspiapi_h" = "yes"; then

printf "%s\n" "#define HAVE_WSPIAPI_H 1" >>confdefs.h

fi

# See if declarations like FINDEX_INFO_LEVELS are
# missing from winbase.h. This is known to be
# a problem with VC++ 5.2.

{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for FINDEX_INFO_LEVELS in winbase.h" >&5
printf %s "checking for FINDEX_INFO_LEVELS in winbase.h... " >&6; }
if test ${tcl_cv_findex_enums+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN

int
main (void)
{

  FINDEX_INFO_LEVELS i;
  FINDEX_SEARCH_OPS j;

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_findex_enums=yes
else case e in #(
  e) tcl_cv_findex_enums=no ;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
 ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_findex_enums" >&5
printf "%s\n" "$tcl_cv_findex_enums" >&6; }
if test "$tcl_cv_findex_enums" = "no"; then

printf "%s\n" "#define HAVE_NO_FINDEX_ENUMS 1" >>confdefs.h

fi

#--------------------------------------------------------------------
# Set the default compiler switches based on the --enable-symbols
# option.  This macro depends on C flags, and should be called
# after SC_CONFIG_CFLAGS macro is called.
#--------------------------------------------------------------------


    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for build with symbols" >&5
printf %s "checking for build with symbols... " >&6; }
    # Check whether --enable-symbols was given.
if test ${enable_symbols+y}
then :
  enableval=$enable_symbols; tcl_ok=$enableval
else case e in #(
  e) tcl_ok=no ;;
esac
fi

# FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT.
    if test "$tcl_ok" = "no"; then
	CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
	LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'

printf "%s\n" "#define NDEBUG 1" >>confdefs.h

	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }

	printf "%s\n" "#define TCL_CFG_OPTIMIZED 1" >>confdefs.h

    else
	CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
	LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
	if test "$tcl_ok" = "yes"; then
	    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes (standard debugging)" >&5
printf "%s\n" "yes (standard debugging)" >&6; }
	fi
    fi



    if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then

printf "%s\n" "#define TCL_MEM_DEBUG 1" >>confdefs.h

    fi

    if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then

printf "%s\n" "#define TCL_COMPILE_DEBUG 1" >>confdefs.h


printf "%s\n" "#define TCL_COMPILE_STATS 1" >>confdefs.h

    fi

    if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then
	if test "$tcl_ok" = "all"; then
	    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: enabled symbols mem compile debugging" >&5
printf "%s\n" "enabled symbols mem compile debugging" >&6; }
	else
	    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: enabled $tcl_ok debugging" >&5
printf "%s\n" "enabled $tcl_ok debugging" >&6; }
	fi
    fi


#--------------------------------------------------------------------
# Embed the manifest if we can determine how
#--------------------------------------------------------------------

ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5
printf %s "checking how to run the C preprocessor... " >&6; }
# On Suns, sometimes $CPP names a directory.
if test -n "$CPP" && test -d "$CPP"; then
  CPP=
fi
if test -z "$CPP"; then
  if test ${ac_cv_prog_CPP+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e)     # Double quotes because $CC needs to be expanded
    for CPP in "$CC -E" "$CC -E -traditional-cpp" cpp /lib/cpp
    do
      ac_preproc_ok=false
for ac_c_preproc_warn_flag in '' yes
do
  # Use a header file that comes with gcc, so configuring glibc
  # with a fresh cross-compiler works.
  # On the NeXT, cc -E runs the code through the compiler's parser,
  # not just through cpp. "Syntax error" is here to catch this case.
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <limits.h>
		     Syntax error
_ACEOF
if ac_fn_c_try_cpp "$LINENO"
then :

else case e in #(
  e) # Broken: fails on valid input.
continue ;;
esac
fi
rm -f conftest.err conftest.i conftest.$ac_ext

  # OK, works on sane cases.  Now check whether nonexistent headers
  # can be detected and how.
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <ac_nonexistent.h>
_ACEOF
if ac_fn_c_try_cpp "$LINENO"
then :
  # Broken: success on invalid input.
continue
else case e in #(
  e) # Passes both tests.
ac_preproc_ok=:
break ;;
esac
fi
rm -f conftest.err conftest.i conftest.$ac_ext

done
# Because of 'break', _AC_PREPROC_IFELSE's cleaning code was skipped.
rm -f conftest.i conftest.err conftest.$ac_ext
if $ac_preproc_ok
then :
  break
fi

    done
    ac_cv_prog_CPP=$CPP
   ;;
esac
fi
  CPP=$ac_cv_prog_CPP
else
  ac_cv_prog_CPP=$CPP
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5
printf "%s\n" "$CPP" >&6; }
ac_preproc_ok=false
for ac_c_preproc_warn_flag in '' yes
do
  # Use a header file that comes with gcc, so configuring glibc
  # with a fresh cross-compiler works.
  # On the NeXT, cc -E runs the code through the compiler's parser,
  # not just through cpp. "Syntax error" is here to catch this case.
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <limits.h>
		     Syntax error
_ACEOF
if ac_fn_c_try_cpp "$LINENO"
then :

else case e in #(
  e) # Broken: fails on valid input.
continue ;;
esac
fi
rm -f conftest.err conftest.i conftest.$ac_ext

  # OK, works on sane cases.  Now check whether nonexistent headers
  # can be detected and how.
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <ac_nonexistent.h>
_ACEOF
if ac_fn_c_try_cpp "$LINENO"
then :
  # Broken: success on invalid input.
continue
else case e in #(
  e) # Passes both tests.
ac_preproc_ok=:
break ;;
esac
fi
rm -f conftest.err conftest.i conftest.$ac_ext

done
# Because of 'break', _AC_PREPROC_IFELSE's cleaning code was skipped.
rm -f conftest.i conftest.err conftest.$ac_ext
if $ac_preproc_ok
then :

else case e in #(
  e) { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5
printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;}
as_fn_error $? "C preprocessor \"$CPP\" fails sanity check
See 'config.log' for more details" "$LINENO" 5; } ;;
esac
fi

ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu


{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for egrep -e" >&5
printf %s "checking for egrep -e... " >&6; }
if test ${ac_cv_path_EGREP_TRADITIONAL+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) if test -z "$EGREP_TRADITIONAL"; then
  ac_path_EGREP_TRADITIONAL_found=false
  # Loop through the user's path and test for each of PROGNAME-LIST
  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
do
  IFS=$as_save_IFS
  case $as_dir in #(((
    '') as_dir=./ ;;
    */) ;;
    *) as_dir=$as_dir/ ;;
  esac
    for ac_prog in grep ggrep
   do
    for ac_exec_ext in '' $ac_executable_extensions; do
      ac_path_EGREP_TRADITIONAL="$as_dir$ac_prog$ac_exec_ext"
      as_fn_executable_p "$ac_path_EGREP_TRADITIONAL" || continue
# Check for GNU ac_path_EGREP_TRADITIONAL and select it if it is found.
  # Check for GNU $ac_path_EGREP_TRADITIONAL
case `"$ac_path_EGREP_TRADITIONAL" --version 2>&1` in #(
*GNU*)
  ac_cv_path_EGREP_TRADITIONAL="$ac_path_EGREP_TRADITIONAL" ac_path_EGREP_TRADITIONAL_found=:;;
#(
*)
  ac_count=0
  printf %s 0123456789 >"conftest.in"
  while :
  do
    cat "conftest.in" "conftest.in" >"conftest.tmp"
    mv "conftest.tmp" "conftest.in"
    cp "conftest.in" "conftest.nl"
    printf "%s\n" 'EGREP_TRADITIONAL' >> "conftest.nl"
    "$ac_path_EGREP_TRADITIONAL" -E 'EGR(EP|AC)_TRADITIONAL$' < "conftest.nl" >"conftest.out" 2>/dev/null || break
    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
    as_fn_arith $ac_count + 1 && ac_count=$as_val
    if test $ac_count -gt ${ac_path_EGREP_TRADITIONAL_max-0}; then
      # Best one so far, save it but keep looking for a better one
      ac_cv_path_EGREP_TRADITIONAL="$ac_path_EGREP_TRADITIONAL"
      ac_path_EGREP_TRADITIONAL_max=$ac_count
    fi
    # 10*(2^10) chars as input seems more than enough
    test $ac_count -gt 10 && break
  done
  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
esac

      $ac_path_EGREP_TRADITIONAL_found && break 3
    done
  done
  done
IFS=$as_save_IFS
  if test -z "$ac_cv_path_EGREP_TRADITIONAL"; then
    :
  fi
else
  ac_cv_path_EGREP_TRADITIONAL=$EGREP_TRADITIONAL
fi

    if test "$ac_cv_path_EGREP_TRADITIONAL"
then :
  ac_cv_path_EGREP_TRADITIONAL="$ac_cv_path_EGREP_TRADITIONAL -E"
else case e in #(
  e) if test -z "$EGREP_TRADITIONAL"; then
  ac_path_EGREP_TRADITIONAL_found=false
  # Loop through the user's path and test for each of PROGNAME-LIST
  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
do
  IFS=$as_save_IFS
  case $as_dir in #(((
    '') as_dir=./ ;;
    */) ;;
    *) as_dir=$as_dir/ ;;
  esac
    for ac_prog in egrep
   do
    for ac_exec_ext in '' $ac_executable_extensions; do
      ac_path_EGREP_TRADITIONAL="$as_dir$ac_prog$ac_exec_ext"
      as_fn_executable_p "$ac_path_EGREP_TRADITIONAL" || continue
# Check for GNU ac_path_EGREP_TRADITIONAL and select it if it is found.
  # Check for GNU $ac_path_EGREP_TRADITIONAL
case `"$ac_path_EGREP_TRADITIONAL" --version 2>&1` in #(
*GNU*)
  ac_cv_path_EGREP_TRADITIONAL="$ac_path_EGREP_TRADITIONAL" ac_path_EGREP_TRADITIONAL_found=:;;
#(
*)
  ac_count=0
  printf %s 0123456789 >"conftest.in"
  while :
  do
    cat "conftest.in" "conftest.in" >"conftest.tmp"
    mv "conftest.tmp" "conftest.in"
    cp "conftest.in" "conftest.nl"
    printf "%s\n" 'EGREP_TRADITIONAL' >> "conftest.nl"
    "$ac_path_EGREP_TRADITIONAL" 'EGR(EP|AC)_TRADITIONAL$' < "conftest.nl" >"conftest.out" 2>/dev/null || break
    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
    as_fn_arith $ac_count + 1 && ac_count=$as_val
    if test $ac_count -gt ${ac_path_EGREP_TRADITIONAL_max-0}; then
      # Best one so far, save it but keep looking for a better one
      ac_cv_path_EGREP_TRADITIONAL="$ac_path_EGREP_TRADITIONAL"
      ac_path_EGREP_TRADITIONAL_max=$ac_count
    fi
    # 10*(2^10) chars as input seems more than enough
    test $ac_count -gt 10 && break
  done
  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
esac

      $ac_path_EGREP_TRADITIONAL_found && break 3
    done
  done
  done
IFS=$as_save_IFS
  if test -z "$ac_cv_path_EGREP_TRADITIONAL"; then
    as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
  fi
else
  ac_cv_path_EGREP_TRADITIONAL=$EGREP_TRADITIONAL
fi
 ;;
esac
fi ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP_TRADITIONAL" >&5
printf "%s\n" "$ac_cv_path_EGREP_TRADITIONAL" >&6; }
 EGREP_TRADITIONAL=$ac_cv_path_EGREP_TRADITIONAL


    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether to embed manifest" >&5
printf %s "checking whether to embed manifest... " >&6; }
    # Check whether --enable-embedded-manifest was given.
if test ${enable_embedded_manifest+y}
then :
  enableval=$enable_embedded_manifest; embed_ok=$enableval
else case e in #(
  e) embed_ok=yes ;;
esac
fi


    VC_MANIFEST_EMBED_DLL=
    VC_MANIFEST_EMBED_EXE=
    result=no
    if test "$embed_ok" = "yes" -a "${SHARED_BUILD}" = "1" \
       -a "$GCC" != "yes" ; then
	# Add the magic to embed the manifest into the dll/exe
	cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

#if defined(_MSC_VER) && _MSC_VER >= 1400
print("manifest needed")
#endif

_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
  $EGREP_TRADITIONAL "manifest needed" >/dev/null 2>&1
then :

	# Could do a CHECK_PROG for mt, but should always be with MSVC8+
	# Could add 'if test -f' check, but manifest should be created
	# in this compiler case
	# Add in a manifest argument that may be specified
	# XXX Needs improvement so that the test for existence accounts
	# XXX for a provided (known) manifest
	VC_MANIFEST_EMBED_DLL="if test -f \$@.manifest ; then mt.exe -nologo -manifest \$@.manifest  -outputresource:\$@\;2 ; fi"
	VC_MANIFEST_EMBED_EXE="if test -f \$@.manifest ; then mt.exe -nologo -manifest \$@.manifest  -outputresource:\$@\;1 ; fi"
	result=yes
	if test "x" != x ; then
	    result="yes ()"
	fi

fi
rm -rf conftest*

    fi
    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $result" >&5
printf "%s\n" "$result" >&6; }




#------------------------------------------------------------------------
# tclConfig.sh refers to this by a different name
#------------------------------------------------------------------------

TCL_SHARED_BUILD=${SHARED_BUILD}

#--------------------------------------------------------------------
# Perform final evaluations of variables with possible substitutions.
#--------------------------------------------------------------------

eval "TCL_SRC_DIR=\"`cd $srcdir/..; $CYGPATH $(pwd)`\""

eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}"

eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${LIBSUFFIX}\""
eval "TCL_STUB_LIB_FLAG=\"-ltclstub${LIBFLAGSUFFIX}\""
eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_STUB_LIB_FLAG}\""
eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\""
eval "TCL_BUILD_STUB_LIB_PATH=\"`$CYGPATH $(pwd)`/${TCL_STUB_LIB_FILE}\""
eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\""

if test ${SHARED_BUILD} = 0 -o "$GCC" != "yes" ; then
 eval "TCL_LIB_FLAG=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\""
 eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\""
else
 eval "TCL_LIB_FLAG=\"-ltcl${VER}${FLAGSUFFIX}\""
 eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${DLLSUFFIX}.a\""
fi
eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_LIB_FLAG}\""
eval "TCL_LIB_SPEC=\"-L${libdir} ${TCL_LIB_FLAG}\""

# Install time header dir can be set via --includedir
eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""

TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}"
TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"

CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}
CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}

#--------------------------------------------------------------------
# Adjust the defines for how the resources are built depending
# on symbols and static vs. shared.
#--------------------------------------------------------------------

if test ${SHARED_BUILD} = 0 ; then
    RC_DEFINES="${RC_DEFINE} STATIC_BUILD"
else
    RC_DEFINES=""
fi

#--------------------------------------------------------------------
#	The statements below define the symbol TCL_PACKAGE_PATH, which
#	gives a list of directories that may contain packages.  The list
#	consists of one directory for machine-dependent binaries and
#	another for platform-independent scripts.
#--------------------------------------------------------------------

if test "$prefix/lib" != "$libdir"; then
    TCL_PACKAGE_PATH="${libdir};${prefix}\\lib"
else
    TCL_PACKAGE_PATH="${prefix}\\lib"
fi

# The tclsh.exe.manifest requires these
# TCL_WIN_VERSION is the 4 dotted pair Windows version format which needs
# the release level, and must account for interim release versioning
case "$TCL_PATCH_LEVEL" in
     *a*) TCL_RELEASE_LEVEL=0 ;;
     *b*) TCL_RELEASE_LEVEL=1 ;;
     *)   TCL_RELEASE_LEVEL=2 ;;
esac
TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d ab.`"

# X86|AMD64|ARM64|IA64 for manifest















# empty on win















# win/tcl.m4 doesn't set (CFLAGS)







# win/tcl.m4 doesn't set (LDFLAGS)































# win only















ac_config_files="$ac_config_files Makefile tclConfig.sh tclsh.exe.manifest"

cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
# tests run on this system so they can be shared between configure
# scripts and configure runs, see configure's option --config-cache.
# It is not useful on other systems.  If it contains results you don't
# want to keep, you may remove or edit it.
#
# config.status only pays attention to the cache file if you give it
# the --recheck option to rerun configure.
#
# 'ac_cv_env_foo' variables (set or unset) will be overridden when
# loading this file, other *unset* 'ac_cv_foo' will be assigned the
# following values.

_ACEOF

# The following way of writing the cache mishandles newlines in values,
# but we know of no workaround that is simple, portable, and efficient.
# So, we kill variables containing newlines.
# Ultrix sh set writes to stderr and can't be redirected directly,
# and sets the high bit in the cache file unless we assign to the vars.
(
  for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do
    eval ac_val=\$$ac_var
    case $ac_val in #(
    *${as_nl}*)
      case $ac_var in #(
      *_cv_*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
      esac
      case $ac_var in #(
      _ | IFS | as_nl) ;; #(
      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
      *) { eval $ac_var=; unset $ac_var;} ;;
      esac ;;
    esac
  done

  (set) 2>&1 |
    case $as_nl`(ac_space=' '; set) 2>&1` in #(
    *${as_nl}ac_space=\ *)
      # 'set' does not quote correctly, so add quotes: double-quote
      # substitution turns \\\\ into \\, and sed turns \\ into \.
      sed -n \
	"s/'/'\\\\''/g;
	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"
      ;; #(
    *)
      # 'set' quotes correctly as required by POSIX, so do not add quotes.
      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
      ;;
    esac |
    sort
) |
  sed '
     /^ac_cv_env_/b end
     t clear
     :clear
     s/^\([^=]*\)=\(.*[{}].*\)$/test ${\1+y} || &/
     t end
     s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
     :end' >>confcache
if diff "$cache_file" confcache >/dev/null 2>&1; then :; else
  if test -w "$cache_file"; then
    if test "x$cache_file" != "x/dev/null"; then
      { printf "%s\n" "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5
printf "%s\n" "$as_me: updating cache $cache_file" >&6;}
      if test ! -f "$cache_file" || test -h "$cache_file"; then
	cat confcache >"$cache_file"
      else
        case $cache_file in #(
        */* | ?:*)
	  mv -f confcache "$cache_file"$$ &&
	  mv -f "$cache_file"$$ "$cache_file" ;; #(
        *)
	  mv -f confcache "$cache_file" ;;
	esac
      fi
    fi
  else
    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5
printf "%s\n" "$as_me: not updating unwritable cache $cache_file" >&6;}
  fi
fi
rm -f confcache

test "x$prefix" = xNONE && prefix=$ac_default_prefix
# Let make expand exec_prefix.
test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'

# Transform confdefs.h into DEFS.
# Protect against shell expansion while executing Makefile rules.
# Protect against Makefile macro expansion.
#
# If the first sed substitution is executed (which looks for macros that
# take arguments), then branch to the quote section.  Otherwise,
# look for a macro that doesn't take arguments.
ac_script='
:mline
/\\$/{
 N
 s,\\\n,,
 b mline
}
t clear
:clear
s/^[	 ]*#[	 ]*define[	 ][	 ]*\([^	 (][^	 (]*([^)]*)\)[	 ]*\(.*\)/-D\1=\2/g
t quote
s/^[	 ]*#[	 ]*define[	 ][	 ]*\([^	 ][^	 ]*\)[	 ]*\(.*\)/-D\1=\2/g
t quote
b any
:quote
s/[][	 `~#$^&*(){}\\|;'\''"<>?]/\\&/g
s/\$/$$/g
H
:any
${
	g
	s/^\n//
	s/\n/ /g
	p
}
'
DEFS=`sed -n "$ac_script" confdefs.h`


ac_libobjs=
ac_ltlibobjs=
U=
for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue
  # 1. Remove the extension, and $U if already installed.
  ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'
  ac_i=`printf "%s\n" "$ac_i" | sed "$ac_script"`
  # 2. Prepend LIBOBJDIR.  When used with automake>=1.10 LIBOBJDIR
  #    will be set to the directory where LIBOBJS objects are built.
  as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext"
  as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo'
done
LIBOBJS=$ac_libobjs

LTLIBOBJS=$ac_ltlibobjs



: "${CONFIG_STATUS=./config.status}"
ac_write_fail=0
ac_clean_files_save=$ac_clean_files
ac_clean_files="$ac_clean_files $CONFIG_STATUS"
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5
printf "%s\n" "$as_me: creating $CONFIG_STATUS" >&6;}
as_write_fail=0
cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1
#! $SHELL
# Generated by $as_me.
# Run this file to recreate the current configuration.
# Compiler output produced by configure, useful for debugging
# configure, is in config.log if it exists.

debug=false
ac_cs_recheck=false
ac_cs_silent=false

SHELL=\${CONFIG_SHELL-$SHELL}
export SHELL
_ASEOF
cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1
## -------------------- ##
## M4sh Initialization. ##
## -------------------- ##

# Be more Bourne compatible
DUALCASE=1; export DUALCASE # for MKS sh
if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1
then :
  emulate sh
  NULLCMD=:
  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
  # is contrary to our usage.  Disable this feature.
  alias -g '${1+"$@"}'='"$@"'
  setopt NO_GLOB_SUBST
else case e in #(
  e) case `(set -o) 2>/dev/null` in #(
  *posix*) :
    set -o posix ;; #(
  *) :
     ;;
esac ;;
esac
fi



# Reset variables that may have inherited troublesome values from
# the environment.

# IFS needs to be set, to space, tab, and newline, in precisely that order.
# (If _AS_PATH_WALK were called with IFS unset, it would have the
# side effect of setting IFS to empty, thus disabling word splitting.)
# Quoting is to prevent editors from complaining about space-tab.
as_nl='
'
export as_nl
IFS=" ""	$as_nl"

PS1='$ '
PS2='> '
PS4='+ '

# Ensure predictable behavior from utilities with locale-dependent output.
LC_ALL=C
export LC_ALL
LANGUAGE=C
export LANGUAGE

# We cannot yet rely on "unset" to work, but we need these variables
# to be unset--not just set to an empty or harmless value--now, to
# avoid bugs in old shells (e.g. pre-3.0 UWIN ksh).  This construct
# also avoids known problems related to "unset" and subshell syntax
# in other old shells (e.g. bash 2.01 and pdksh 5.2.14).
for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH
do eval test \${$as_var+y} \
  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
done

# Ensure that fds 0, 1, and 2 are open.
if (exec 3>&0) 2>/dev/null; then :; else exec 0</dev/null; fi
if (exec 3>&1) 2>/dev/null; then :; else exec 1>/dev/null; fi
if (exec 3>&2)            ; then :; else exec 2>/dev/null; fi

# The user is always right.
if ${PATH_SEPARATOR+false} :; then
  PATH_SEPARATOR=:
  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
      PATH_SEPARATOR=';'
  }
fi


# Find who we are.  Look in the path if we contain no directory separator.
as_myself=
case $0 in #((
  *[\\/]* ) as_myself=$0 ;;
  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  case $as_dir in #(((
    '') as_dir=./ ;;
    */) ;;
    *) as_dir=$as_dir/ ;;
  esac
    test -r "$as_dir$0" && as_myself=$as_dir$0 && break
  done
IFS=$as_save_IFS

     ;;
esac
# We did not find ourselves, most probably we were run as 'sh COMMAND'
# in which case we are not to be found in the path.
if test "x$as_myself" = x; then
  as_myself=$0
fi
if test ! -f "$as_myself"; then
  printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
  exit 1
fi



# as_fn_error STATUS ERROR [LINENO LOG_FD]
# ----------------------------------------
# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
# script with STATUS, using 1 if that was 0.
as_fn_error ()
{
  as_status=$1; test $as_status -eq 0 && as_status=1
  if test "$4"; then
    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
    printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
  fi
  printf "%s\n" "$as_me: error: $2" >&2
  as_fn_exit $as_status
} # as_fn_error


# as_fn_set_status STATUS
# -----------------------
# Set $? to STATUS, without forking.
as_fn_set_status ()
{
  return $1
} # as_fn_set_status

# as_fn_exit STATUS
# -----------------
# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
as_fn_exit ()
{
  set +e
  as_fn_set_status $1
  exit $1
} # as_fn_exit

# as_fn_unset VAR
# ---------------
# Portably unset VAR.
as_fn_unset ()
{
  { eval $1=; unset $1;}
}
as_unset=as_fn_unset

# as_fn_append VAR VALUE
# ----------------------
# Append the text in VALUE to the end of the definition contained in VAR. Take
# advantage of any shell optimizations that allow amortized linear growth over
# repeated appends, instead of the typical quadratic growth present in naive
# implementations.
if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null
then :
  eval 'as_fn_append ()
  {
    eval $1+=\$2
  }'
else case e in #(
  e) as_fn_append ()
  {
    eval $1=\$$1\$2
  } ;;
esac
fi # as_fn_append

# as_fn_arith ARG...
# ------------------
# Perform arithmetic evaluation on the ARGs, and store the result in the
# global $as_val. Take advantage of shells that can avoid forks. The arguments
# must be portable across $(()) and expr.
if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null
then :
  eval 'as_fn_arith ()
  {
    as_val=$(( $* ))
  }'
else case e in #(
  e) as_fn_arith ()
  {
    as_val=`expr "$@" || test $? -eq 1`
  } ;;
esac
fi # as_fn_arith


if expr a : '\(a\)' >/dev/null 2>&1 &&
   test "X`expr 00001 : '.*\(...\)'`" = X001; then
  as_expr=expr
else
  as_expr=false
fi

if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
  as_basename=basename
else
  as_basename=false
fi

if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
  as_dirname=dirname
else
  as_dirname=false
fi

as_me=`$as_basename -- "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
	 X"$0" : 'X\(//\)$' \| \
	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
printf "%s\n" X/"$0" |
    sed '/^.*\/\([^/][^/]*\)\/*$/{
	    s//\1/
	    q
	  }
	  /^X\/\(\/\/\)$/{
	    s//\1/
	    q
	  }
	  /^X\/\(\/\).*/{
	    s//\1/
	    q
	  }
	  s/.*/./; q'`

# Avoid depending upon Character Ranges.
as_cr_letters='abcdefghijklmnopqrstuvwxyz'
as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
as_cr_Letters=$as_cr_letters$as_cr_LETTERS
as_cr_digits='0123456789'
as_cr_alnum=$as_cr_Letters$as_cr_digits


# Determine whether it's possible to make 'echo' print without a newline.
# These variables are no longer used directly by Autoconf, but are AC_SUBSTed
# for compatibility with existing Makefiles.
ECHO_C= ECHO_N= ECHO_T=
case `echo -n x` in #(((((
-n*)
  case `echo 'xy\c'` in
  *c*) ECHO_T='	';;	# ECHO_T is single tab character.
  xy)  ECHO_C='\c';;
  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null
       ECHO_T='	';;
  esac;;
*)
  ECHO_N='-n';;
esac

# For backward compatibility with old third-party macros, we provide
# the shell variables $as_echo and $as_echo_n.  New code should use
# AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively.
as_echo='printf %s\n'
as_echo_n='printf %s'

rm -f conf$$ conf$$.exe conf$$.file
if test -d conf$$.dir; then
  rm -f conf$$.dir/conf$$.file
else
  rm -f conf$$.dir
  mkdir conf$$.dir 2>/dev/null
fi
if (echo >conf$$.file) 2>/dev/null; then
  if ln -s conf$$.file conf$$ 2>/dev/null; then
    as_ln_s='ln -s'
    # ... but there are two gotchas:
    # 1) On MSYS, both 'ln -s file dir' and 'ln file dir' fail.
    # 2) DJGPP < 2.04 has no symlinks; 'ln -s' creates a wrapper executable.
    # In both cases, we have to default to 'cp -pR'.
    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
      as_ln_s='cp -pR'
  elif ln conf$$.file conf$$ 2>/dev/null; then
    as_ln_s=ln
  else
    as_ln_s='cp -pR'
  fi
else
  as_ln_s='cp -pR'
fi
rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
rmdir conf$$.dir 2>/dev/null


# as_fn_mkdir_p
# -------------
# Create "$as_dir" as a directory, including parents if necessary.
as_fn_mkdir_p ()
{

  case $as_dir in #(
  -*) as_dir=./$as_dir;;
  esac
  test -d "$as_dir" || eval $as_mkdir_p || {
    as_dirs=
    while :; do
      case $as_dir in #(
      *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
      *) as_qdir=$as_dir;;
      esac
      as_dirs="'$as_qdir' $as_dirs"
      as_dir=`$as_dirname -- "$as_dir" ||
$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
	 X"$as_dir" : 'X\(//\)[^/]' \| \
	 X"$as_dir" : 'X\(//\)$' \| \
	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
printf "%s\n" X"$as_dir" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)[^/].*/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\).*/{
	    s//\1/
	    q
	  }
	  s/.*/./; q'`
      test -d "$as_dir" && break
    done
    test -z "$as_dirs" || eval "mkdir $as_dirs"
  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"


} # as_fn_mkdir_p
if mkdir -p . 2>/dev/null; then
  as_mkdir_p='mkdir -p "$as_dir"'
else
  test -d ./-p && rmdir ./-p
  as_mkdir_p=false
fi


# as_fn_executable_p FILE
# -----------------------
# Test if FILE is an executable regular file.
as_fn_executable_p ()
{
  test -f "$1" && test -x "$1"
} # as_fn_executable_p
as_test_x='test -x'
as_executable_p=as_fn_executable_p

# Sed expression to map a string onto a valid CPP name.
as_sed_cpp="y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g"
as_tr_cpp="eval sed '$as_sed_cpp'" # deprecated

# Sed expression to map a string onto a valid variable name.
as_sed_sh="y%*+%pp%;s%[^_$as_cr_alnum]%_%g"
as_tr_sh="eval sed '$as_sed_sh'" # deprecated


exec 6>&1
## ----------------------------------- ##
## Main body of $CONFIG_STATUS script. ##
## ----------------------------------- ##
_ASEOF
test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# Save the log message, to keep $0 and so on meaningful, and to
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
This file was extended by tcl $as_me 9.0, which was
generated by GNU Autoconf 2.72.  Invocation command line was

  CONFIG_FILES    = $CONFIG_FILES
  CONFIG_HEADERS  = $CONFIG_HEADERS
  CONFIG_LINKS    = $CONFIG_LINKS
  CONFIG_COMMANDS = $CONFIG_COMMANDS
  $ $0 $@

on `(hostname || uname -n) 2>/dev/null | sed 1q`
"

_ACEOF

case $ac_config_files in *"
"*) set x $ac_config_files; shift; ac_config_files=$*;;
esac



cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
# Files that config.status was made for.
config_files="$ac_config_files"

_ACEOF

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
ac_cs_usage="\
'$as_me' instantiates files and other configuration actions
from templates according to the current configuration.  Unless the files
and actions are specified as TAGs, all are instantiated by default.

Usage: $0 [OPTION]... [TAG]...

  -h, --help       print this help, then exit
  -V, --version    print version number and configuration settings, then exit
      --config     print configuration, then exit
  -q, --quiet, --silent
                   do not print progress messages
  -d, --debug      don't remove temporary files
      --recheck    update $as_me by reconfiguring in the same conditions
      --file=FILE[:TEMPLATE]
                   instantiate the configuration file FILE

Configuration files:
$config_files

Report bugs to the package provider."

_ACEOF
ac_cs_config=`printf "%s\n" "$ac_configure_args" | sed "$ac_safe_unquote"`
ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\''/g"`
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config='$ac_cs_config_escaped'
ac_cs_version="\\
tcl config.status 9.0
configured by $0, generated by GNU Autoconf 2.72,
  with options \\"\$ac_cs_config\\"

Copyright (C) 2023 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."

ac_pwd='$ac_pwd'
srcdir='$srcdir'
test -n "\$AWK" || AWK=awk
_ACEOF

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# The default lists apply if the user does not specify any file.
ac_need_defaults=:
while test $# != 0
do
  case $1 in
  --*=?*)
    ac_option=`expr "X$1" : 'X\([^=]*\)='`
    ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`
    ac_shift=:
    ;;
  --*=)
    ac_option=`expr "X$1" : 'X\([^=]*\)='`
    ac_optarg=
    ac_shift=:
    ;;
  *)
    ac_option=$1
    ac_optarg=$2
    ac_shift=shift
    ;;
  esac

  case $ac_option in
  # Handling of the options.
  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
    ac_cs_recheck=: ;;
  --version | --versio | --versi | --vers | --ver | --ve | --v | -V )
    printf "%s\n" "$ac_cs_version"; exit ;;
  --config | --confi | --conf | --con | --co | --c )
    printf "%s\n" "$ac_cs_config"; exit ;;
  --debug | --debu | --deb | --de | --d | -d )
    debug=: ;;
  --file | --fil | --fi | --f )
    $ac_shift
    case $ac_optarg in
    *\'*) ac_optarg=`printf "%s\n" "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;
    '') as_fn_error $? "missing file argument" ;;
    esac
    as_fn_append CONFIG_FILES " '$ac_optarg'"
    ac_need_defaults=false;;
  --he | --h |  --help | --hel | -h )
    printf "%s\n" "$ac_cs_usage"; exit ;;
  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
  | -silent | --silent | --silen | --sile | --sil | --si | --s)
    ac_cs_silent=: ;;

  # This is an error.
  -*) as_fn_error $? "unrecognized option: '$1'
Try '$0 --help' for more information." ;;

  *) as_fn_append ac_config_targets " $1"
     ac_need_defaults=false ;;

  esac
  shift
done

ac_configure_extra_args=

if $ac_cs_silent; then
  exec 6>/dev/null
  ac_configure_extra_args="$ac_configure_extra_args --silent"
fi

_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
if \$ac_cs_recheck; then
  set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
  shift
  \printf "%s\n" "running CONFIG_SHELL=$SHELL \$*" >&6
  CONFIG_SHELL='$SHELL'
  export CONFIG_SHELL
  exec "\$@"
fi

_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
exec 5>>config.log
{
  echo
  sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
## Running $as_me. ##
_ASBOX
  printf "%s\n" "$ac_log"
} >&5

_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
_ACEOF

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1

# Handling of arguments.
for ac_config_target in $ac_config_targets
do
  case $ac_config_target in
    "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;;
    "tclConfig.sh") CONFIG_FILES="$CONFIG_FILES tclConfig.sh" ;;
    "tclsh.exe.manifest") CONFIG_FILES="$CONFIG_FILES tclsh.exe.manifest" ;;

  *) as_fn_error $? "invalid argument: '$ac_config_target'" "$LINENO" 5;;
  esac
done


# If the user did not use the arguments to specify the items to instantiate,
# then the envvar interface is used.  Set only those that are not.
# We use the long form for the default assignment because of an extremely
# bizarre bug on SunOS 4.1.3.
if $ac_need_defaults; then
  test ${CONFIG_FILES+y} || CONFIG_FILES=$config_files
fi

# Have a temporary directory for convenience.  Make it in the build tree
# simply because there is no reason against having it here, and in addition,
# creating and moving files from /tmp can sometimes cause problems.
# Hook for its removal unless debugging.
# Note that there is a small window in which the directory will not be cleaned:
# after its creation but before its name has been assigned to '$tmp'.
$debug ||
{
  tmp= ac_tmp=
  trap 'exit_status=$?
  : "${ac_tmp:=$tmp}"
  { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status
' 0
  trap 'as_fn_exit 1' 1 2 13 15
}
# Create a (secure) tmp directory for tmp files.

{
  tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&
  test -d "$tmp"
}  ||
{
  tmp=./conf$$-$RANDOM
  (umask 077 && mkdir "$tmp")
} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5
ac_tmp=$tmp

# Set up the scripts for CONFIG_FILES section.
# No need to generate them if there are no CONFIG_FILES.
# This happens for instance with './config.status config.h'.
if test -n "$CONFIG_FILES"; then


ac_cr=`echo X | tr X '\015'`
# On cygwin, bash can eat \r inside `` if the user requested igncr.
# But we know of no other shell where ac_cr would be empty at this
# point, so we can use a bashism as a fallback.
if test "x$ac_cr" = x; then
  eval ac_cr=\$\'\\r\'
fi
ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null`
if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then
  ac_cs_awk_cr='\\r'
else
  ac_cs_awk_cr=$ac_cr
fi

echo 'BEGIN {' >"$ac_tmp/subs1.awk" &&
_ACEOF


{
  echo "cat >conf$$subs.awk <<_ACEOF" &&
  echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' &&
  echo "_ACEOF"
} >conf$$subs.sh ||
  as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'`
ac_delim='%!_!# '
for ac_last_try in false false false false false :; do
  . ./conf$$subs.sh ||
    as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5

  ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X`
  if test $ac_delim_n = $ac_delim_num; then
    break
  elif $ac_last_try; then
    as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
  else
    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "
  fi
done
rm -f conf$$subs.sh

cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK &&
_ACEOF
sed -n '
h
s/^/S["/; s/!.*/"]=/
p
g
s/^[^!]*!//
:repl
t repl
s/'"$ac_delim"'$//
t delim
:nl
h
s/\(.\{148\}\)..*/\1/
t more1
s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/
p
n
b repl
:more1
s/["\\]/\\&/g; s/^/"/; s/$/"\\/
p
g
s/.\{148\}//
t nl
:delim
h
s/\(.\{148\}\)..*/\1/
t more2
s/["\\]/\\&/g; s/^/"/; s/$/"/
p
b
:more2
s/["\\]/\\&/g; s/^/"/; s/$/"\\/
p
g
s/.\{148\}//
t delim
' <conf$$subs.awk | sed '
/^[^""]/{
  N
  s/\n//
}
' >>$CONFIG_STATUS || ac_write_fail=1
rm -f conf$$subs.awk
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
_ACAWK
cat >>"\$ac_tmp/subs1.awk" <<_ACAWK &&
  for (key in S) S_is_set[key] = 1
  FS = ""

}
{
  line = $ 0
  nfields = split(line, field, "@")
  substed = 0
  len = length(field[1])
  for (i = 2; i < nfields; i++) {
    key = field[i]
    keylen = length(key)
    if (S_is_set[key]) {
      value = S[key]
      line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3)
      len += length(value) + length(field[++i])
      substed = 1
    } else
      len += 1 + keylen
  }

  print line
}

_ACAWK
_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then
  sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g"
else
  cat
fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \
  || as_fn_error $? "could not setup config files machinery" "$LINENO" 5
_ACEOF

# VPATH may cause trouble with some makes, so we remove sole $(srcdir),
# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and
# trailing colons and then remove the whole line if VPATH becomes empty
# (actually we leave an empty line to preserve line numbers).
if test "x$srcdir" = x.; then
  ac_vpsub='/^[	 ]*VPATH[	 ]*=[	 ]*/{
h
s///
s/^/:/
s/[	 ]*$/:/
s/:\$(srcdir):/:/g
s/:\${srcdir}:/:/g
s/:@srcdir@:/:/g
s/^:*//
s/:*$//
x
s/\(=[	 ]*\).*/\1/
G
s/\n//
s/^[^=]*=[	 ]*$//
}'
fi

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
fi # test -n "$CONFIG_FILES"


eval set X "  :F $CONFIG_FILES      "
shift
for ac_tag
do
  case $ac_tag in
  :[FHLC]) ac_mode=$ac_tag; continue;;
  esac
  case $ac_mode$ac_tag in
  :[FHL]*:*);;
  :L* | :C*:*) as_fn_error $? "invalid tag '$ac_tag'" "$LINENO" 5;;
  :[FH]-) ac_tag=-:-;;
  :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;
  esac
  ac_save_IFS=$IFS
  IFS=:
  set x $ac_tag
  IFS=$ac_save_IFS
  shift
  ac_file=$1
  shift

  case $ac_mode in
  :L) ac_source=$1;;
  :[FH])
    ac_file_inputs=
    for ac_f
    do
      case $ac_f in
      -) ac_f="$ac_tmp/stdin";;
      *) # Look for the file first in the build tree, then in the source tree
	 # (if the path is not absolute).  The absolute path cannot be DOS-style,
	 # because $ac_f cannot contain ':'.
	 test -f "$ac_f" ||
	   case $ac_f in
	   [\\/$]*) false;;
	   *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;
	   esac ||
	   as_fn_error 1 "cannot find input file: '$ac_f'" "$LINENO" 5;;
      esac
      case $ac_f in *\'*) ac_f=`printf "%s\n" "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac
      as_fn_append ac_file_inputs " '$ac_f'"
    done

    # Let's still pretend it is 'configure' which instantiates (i.e., don't
    # use $as_me), people would be surprised to read:
    #    /* config.h.  Generated by config.status.  */
    configure_input='Generated from '`
	  printf "%s\n" "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'
	`' by configure.'
    if test x"$ac_file" != x-; then
      configure_input="$ac_file.  $configure_input"
      { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5
printf "%s\n" "$as_me: creating $ac_file" >&6;}
    fi
    # Neutralize special characters interpreted by sed in replacement strings.
    case $configure_input in #(
    *\&* | *\|* | *\\* )
       ac_sed_conf_input=`printf "%s\n" "$configure_input" |
       sed 's/[\\\\&|]/\\\\&/g'`;; #(
    *) ac_sed_conf_input=$configure_input;;
    esac

    case $ac_tag in
    *:-:* | *:-) cat >"$ac_tmp/stdin" \
      || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;;
    esac
    ;;
  esac

  ac_dir=`$as_dirname -- "$ac_file" ||
$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
	 X"$ac_file" : 'X\(//\)[^/]' \| \
	 X"$ac_file" : 'X\(//\)$' \| \
	 X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||
printf "%s\n" X"$ac_file" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)[^/].*/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\).*/{
	    s//\1/
	    q
	  }
	  s/.*/./; q'`
  as_dir="$ac_dir"; as_fn_mkdir_p
  ac_builddir=.

case "$ac_dir" in
.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
*)
  ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'`
  # A ".." for each directory in $ac_dir_suffix.
  ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
  case $ac_top_builddir_sub in
  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;
  esac ;;
esac
ac_abs_top_builddir=$ac_pwd
ac_abs_builddir=$ac_pwd$ac_dir_suffix
# for backward compatibility:
ac_top_builddir=$ac_top_build_prefix

case $srcdir in
  .)  # We are building in place.
    ac_srcdir=.
    ac_top_srcdir=$ac_top_builddir_sub
    ac_abs_top_srcdir=$ac_pwd ;;
  [\\/]* | ?:[\\/]* )  # Absolute name.
    ac_srcdir=$srcdir$ac_dir_suffix;
    ac_top_srcdir=$srcdir
    ac_abs_top_srcdir=$srcdir ;;
  *) # Relative name.
    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
    ac_top_srcdir=$ac_top_build_prefix$srcdir
    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
esac
ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix


  case $ac_mode in
  :F)
  #
  # CONFIG_FILE
  #

_ACEOF

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# If the template does not know about datarootdir, expand it.
# FIXME: This hack should be removed a few years after 2.60.
ac_datarootdir_hack=; ac_datarootdir_seen=
ac_sed_dataroot='
/datarootdir/ {
  p
  q
}
/@datadir@/p
/@docdir@/p
/@infodir@/p
/@localedir@/p
/@mandir@/p'
case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in
*datarootdir*) ac_datarootdir_seen=yes;;
*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5
printf "%s\n" "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}
_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
  ac_datarootdir_hack='
  s&@datadir@&$datadir&g
  s&@docdir@&$docdir&g
  s&@infodir@&$infodir&g
  s&@localedir@&$localedir&g
  s&@mandir@&$mandir&g
  s&\\\${datarootdir}&$datarootdir&g' ;;
esac
_ACEOF

# Neutralize VPATH when '$srcdir' = '.'.
# Shell code in configure.ac might set extrasub.
# FIXME: do we really want to maintain this feature?
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_sed_extra="$ac_vpsub
$extrasub
_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
:t
/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
s|@configure_input@|$ac_sed_conf_input|;t t
s&@top_builddir@&$ac_top_builddir_sub&;t t
s&@top_build_prefix@&$ac_top_build_prefix&;t t
s&@srcdir@&$ac_srcdir&;t t
s&@abs_srcdir@&$ac_abs_srcdir&;t t
s&@top_srcdir@&$ac_top_srcdir&;t t
s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t
s&@builddir@&$ac_builddir&;t t
s&@abs_builddir@&$ac_abs_builddir&;t t
s&@abs_top_builddir@&$ac_abs_top_builddir&;t t
$ac_datarootdir_hack
"
eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \
  >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5

test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&
  { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } &&
  { ac_out=`sed -n '/^[	 ]*datarootdir[	 ]*:*=/p' \
      "$ac_tmp/out"`; test -z "$ac_out"; } &&
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable 'datarootdir'
which seems to be undefined.  Please make sure it is defined" >&5
printf "%s\n" "$as_me: WARNING: $ac_file contains a reference to the variable 'datarootdir'
which seems to be undefined.  Please make sure it is defined" >&2;}

  rm -f "$ac_tmp/stdin"
  case $ac_file in
  -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";;
  *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";;
  esac \
  || as_fn_error $? "could not create $ac_file" "$LINENO" 5
 ;;



  esac

done # for ac_tag


as_fn_exit 0
_ACEOF
ac_clean_files=$ac_clean_files_save

test $ac_write_fail = 0 ||
  as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5


# configure is writing to config.log, and then calls config.status.
# config.status does its own redirection, appending to config.log.
# Unfortunately, on DOS this fails, as config.log is still kept open
# by configure, so config.status won't be able to write to it; its
# output is simply discarded.  So we exec the FD to /dev/null,
# effectively closing config.log, so it can be properly (re)opened and
# appended to by config.status.  When coming back to configure, we
# need to make the FD available again.
if test "$no_create" != yes; then
  ac_cs_success=:
  ac_config_status_args=
  test "$silent" = yes &&
    ac_config_status_args="$ac_config_status_args --quiet"
  exec 5>/dev/null
  $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false
  exec 5>>config.log
  # Use ||, not &&, to avoid exiting from the if with $? = 1, which
  # would make configure fail if this is the last instruction.
  $ac_cs_success || as_fn_exit 1
fi
if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5
printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}
fi



Changes to win/configure.ac.
1








2
3
4
5
6
7
8
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

+
+
+
+
+
+
+
+







#! /bin/bash -norc

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This file is an input file used by the GNU "autoconf" program to
# generate the file "configure", which is run during Tcl installation
# to configure the system for the local environment.

AC_INIT([tcl],[9.0])
AC_CONFIG_SRCDIR([../generic/tcl.h])
AC_PREREQ([2.69])
Changes to win/makefile.vc.














1
2
3
4
5
6
7
8
9
10
11
12
13
14

15
16
17
18
19
20
21
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-
-

+







# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions.
# Copyright (c) 2001-2005 ActiveState Corporation.
# Copyright (c) 2001-2004 David Gravereaux.
# Copyright (c) 2003-2008 Pat Thoyts.
# Copyright (c) 2017 Ashok P. Nadkarni

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#------------------------------------------------------------- -*- makefile -*-
#
#	Microsoft Visual C++ makefile for building Tcl with nmake
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions.
# Copyright (c) 2001-2005 ActiveState Corporation.
# Copyright (c) 2001-2004 David Gravereaux.
# Copyright (c) 2003-2008 Pat Thoyts.
# Copyright (c) 2017 Ashok P. Nadkarni
#------------------------------------------------------------------------------


# General usage:
#   nmake [-nologo] -f makefile.vc [TARGET|MACRODEF [TARGET|MACRODEF] [...]]
#
# For MACRODEF, see TIP 477 (https://core.tcl-lang.org/tips/doc/main/tip/477.md)
# or examine Sections 7-9 in rules.vc.
#
227
228
229
230
231
232
233

234
235
236
237
238
239
240
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250







+







TCLSHOBJS = \
	$(TMP_DIR)\tclAppInit.obj \
	$(TMP_DIR)\tclsh.res

TCLTESTOBJS = \
	$(TMP_DIR)\tclTest.obj \
	$(TMP_DIR)\tclTestObj.obj \
	$(TMP_DIR)\tclTestObjInterface.obj \
	$(TMP_DIR)\tclTestProcBodyObj.obj \
	$(TMP_DIR)\tclThreadTest.obj \
	$(TMP_DIR)\tclWinTest.obj \
	$(TMP_DIR)\tclTestABSList.obj \
!if !$(STATIC_BUILD)
	$(OUT_DIR)\tommath.lib \
!endif
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
260
261
262
263
264
265
266

267
268
269
270
271
272
273







-







	$(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 \
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
325
326
327
328
329
330
331

332
333
334
335
336
337
338







-







	$(TMP_DIR)\tclProc.obj \
	$(TMP_DIR)\tclProcess.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/nmakehlp.c.
1
2
3
4
5
6
7
8
9
10
11

















12
13
14
15
16
17
18
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

-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * ----------------------------------------------------------------------------
 * nmakehlp.c --
 *
 *	This is used to fix limitations within nmake and the environment.
 *
 * Copyright (c) 2002 David Gravereaux.
 * Copyright (c) 2006 Pat Thoyts
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * ----------------------------------------------------------------------------
 * nmakehlp.c --
 *
 *	This is used to fix limitations within nmake and the environment.
 *
 * ----------------------------------------------------------------------------
 */

#define _CRT_SECURE_NO_DEPRECATE
#include <windows.h>
#ifdef _MSC_VER
#pragma comment (lib, "user32.lib")
Changes to win/rules.vc.














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
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+











-
+
-
-
+
-
-
-
-







# Copyright (c) 2001-2003 David Gravereaux.
# Copyright (c) 2003-2008 Patrick Thoyts
# Copyright (c) 2017      Ashok P. Nadkarni
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#------------------------------------------------------------- -*- makefile -*-
# rules.vc --
#
# Part of the nmake based build system for Tcl and its extensions.
# This file does all the hard work in terms of parsing build options,
# compiler switches, defining common targets and macros. The Tcl makefile
# directly includes this. Extensions include it via "rules-ext.vc".
#
# See TIP 477 (https://core.tcl-lang.org/tips/doc/main/tip/477.md) for
# detailed documentation.
#
# See the file "license.terms" for information on usage and redistribution
#------------------------------------------------------------------------------
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# Copyright (c) 2001-2003 David Gravereaux.
# Copyright (c) 2003-2008 Patrick Thoyts
# Copyright (c) 2017      Ashok P. Nadkarni
#------------------------------------------------------------------------------

!ifndef _RULES_VC
_RULES_VC = 1

# The following macros define the version of the rules.vc nmake build system
# For modifications that are not backward-compatible, you *must* change
# the major version.
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
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







-
-
-












-
-
-
-
-
-
-
-
-
-
-
-







!if [nmakehlp -f $(OPTS) "nomsvcrt"]
!message *** Doing nomsvcrt
MSVCRT		= 0
!else
!if [nmakehlp -f $(OPTS) "msvcrt"]
!message *** Doing msvcrt
!else
!if $(TCL_MAJOR_VERSION) == 8 && $(TCL_MINOR_VERSION) < 7 && $(STATIC_BUILD)
MSVCRT		= 0
!endif
!endif
!endif # [nmakehlp -f $(OPTS) "nomsvcrt"]

!if [nmakehlp -f $(OPTS) "staticpkg"] && $(STATIC_BUILD)
!message *** Doing staticpkg
TCL_USE_STATIC_PACKAGES	= 1
!endif

!if [nmakehlp -f $(OPTS) "nothreads"]
!message *** Compile explicitly for non-threaded tcl
TCL_THREADS = 0
USE_THREAD_ALLOC= 0
!endif

!if [nmakehlp -f $(OPTS) "tcl8"]
!message *** Build for Tcl8
TCL_BUILD_FOR = 8
!endif

!if $(TCL_MAJOR_VERSION) == 8
!if [nmakehlp -f $(OPTS) "time64bit"]
!message *** Force 64-bit time_t
_USE_64BIT_TIME_T = 1
!endif
!endif

# Yes, it's weird that the "symbols" option controls DEBUG and
# the "pdbs" option controls SYMBOLS. That's historical.
!if [nmakehlp -f $(OPTS) "symbols"]
!message *** Doing symbols
DEBUG		= 1
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
995
996
997
998
999
1000
1001



1002

1003
1004
1005
1006
1007
1008

1009
1010
1011
1012
1013
1014
1015







-
-
-

-






-








!endif

####################################################################
# 9. Parse the CHECKS macro to configure additional compiler checks
# The following macros are set by this section:
# WARNINGS - compiler switches that control the warnings level
# TCL_NO_DEPRECATED - 1 -> disable support for deprecated functions
#                     0 -> enable deprecated functions

# Defaults - Permit deprecated functions and warning level 3
TCL_NO_DEPRECATED	    = 0
WARNINGS		    = -W3

!if "$(CHECKS)" != "" && ![nmakehlp -f "$(CHECKS)" "none"]

!if [nmakehlp -f $(CHECKS) "nodep"]
!message *** Doing nodep check
TCL_NO_DEPRECATED	    = 1
!endif

!if [nmakehlp -f $(CHECKS) "fullwarn"]
!message *** Doing full warnings check
WARNINGS		    = -W4
!if [nmakehlp -l -warn:3 $(LINKER_TESTFLAGS)]
LINKERFLAGS		    = $(LINKERFLAGS) -warn:3
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
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







-
-
-

-















-
-
-

-



















-
-
-

-















-
-
-

-



















-
-
-
-


-







TCLSHNAME       = $(PROJECT)sh$(VERSION)$(SUFX).exe
TCLSH		= $(OUT_DIR)\$(TCLSHNAME)
TCLIMPLIB	= $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
TCLLIBNAME	= $(PROJECT)$(VERSION)$(SUFX).$(EXT)
TCLLIB		= $(OUT_DIR)\$(TCLLIBNAME)
TCLSCRIPTZIP    = $(OUT_DIR)\$(TCL_ZIP_FILE)

!if $(TCL_MAJOR_VERSION) == 8
TCLSTUBLIBNAME	= $(STUBPREFIX)$(VERSION).lib
!else
TCLSTUBLIBNAME	= $(STUBPREFIX).lib
!endif
TCLSTUBLIB	= $(OUT_DIR)\$(TCLSTUBLIBNAME)
TCL_INCLUDES    = -I"$(WIN_DIR)" -I"$(GENERICDIR)"

!else # !$(DOING_TCL)

!if $(TCLINSTALL) # Building against an installed Tcl

# When building extensions, we need to locate tclsh. Depending on version
# of Tcl we are building against, this may or may not have a "t" suffix.
# Try various possibilities in turn.
TCLSH		= $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX:t=).exe
!if !exist("$(TCLSH)")
TCLSH           = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX:t=).exe
!endif

!if $(TCL_MAJOR_VERSION) == 8
TCLSTUBLIB	= $(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib
!else
TCLSTUBLIB	= $(_TCLDIR)\lib\tclstub.lib
!endif
TCLIMPLIB	= $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:t=).lib
# When building extensions, may be linking against Tcl that does not add
# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
!if !exist("$(TCLIMPLIB)")
TCLIMPLIB	= $(_TCLDIR)\lib\tcl$(TCL_VERSION)t$(SUFX:t=).lib
!endif
TCL_LIBRARY	= $(_TCLDIR)\lib
TCLREGLIB	= $(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib
TCLDDELIB	= $(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib
TCLSCRIPTZIP	= $(_TCLDIR)\lib\$(TCL_ZIP_FILE)
TCLTOOLSDIR	= \must\have\tcl\sources\to\build\this\target
TCL_INCLUDES    = -I"$(_TCLDIR)\include"

!else # Building against Tcl sources

TCLSH		= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX:t=).exe
!if !exist($(TCLSH))
TCLSH		= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX:t=).exe
!endif
!if $(TCL_MAJOR_VERSION) == 8
TCLSTUBLIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib
!else
TCLSTUBLIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub.lib
!endif
TCLIMPLIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:t=).lib
# When building extensions, may be linking against Tcl that does not add
# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
!if !exist("$(TCLIMPLIB)")
TCLIMPLIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)t$(SUFX:t=).lib
!endif
TCL_LIBRARY	= $(_TCLDIR)\library
TCLREGLIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib
TCLDDELIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib
TCLSCRIPTZIP	= $(_TCLDIR)\win\$(BUILDDIRTOP)\$(TCL_ZIP_FILE)
TCLTOOLSDIR	= $(_TCLDIR)\tools
TCL_INCLUDES	= -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"

!endif # TCLINSTALL

!if !$(STATIC_BUILD) && "$(TCL_BUILD_FOR)" == "8"
tcllibs = "$(TCLSTUBLIB)"
!else
tcllibs = "$(TCLSTUBLIB)" "$(TCLIMPLIB)"
!endif

!endif # $(DOING_TCL)

# We need a tclsh that will run on the host machine as part of the build.
# IX86 runs on all architectures.
!ifndef TCLSH_NATIVE
!if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "$(NATIVE_ARCH)"
TCLSH_NATIVE	= $(TCLSH)
!else
!error You must explicitly set TCLSH_NATIVE for cross-compilation
!endif
!endif

# Do the same for Tk and Tk extensions that require the Tk libraries
!if $(DOING_TK) || $(NEED_TK)
WISHNAMEPREFIX = wish
WISHNAME = $(WISHNAMEPREFIX)$(TK_VERSION)$(SUFX).exe
TKLIBNAME8	= tk$(TK_VERSION)$(SUFX).$(EXT)
TKLIBNAME9	= tcl9tk$(TK_VERSION)$(SUFX).$(EXT)
!if $(TCL_MAJOR_VERSION) == 8 || "$(TCL_BUILD_FOR)" == "8"
TKLIBNAME	= tk$(TK_VERSION)$(SUFX).$(EXT)
TKIMPLIBNAME	= tk$(TK_VERSION)$(SUFX).lib
!else
TKLIBNAME	= tcl9tk$(TK_VERSION)$(SUFX).$(EXT)
TKIMPLIBNAME	= tcl9tk$(TK_VERSION)$(SUFX).lib
!endif
!if $(TK_MAJOR_VERSION) == 8
TKSTUBLIBNAME	= tkstub$(TK_VERSION).lib
!else
TKSTUBLIBNAME	= tkstub.lib
!endif

!if $(DOING_TK)
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
1259
1260
1261
1262
1263
1264
1265



1266

1267
1268



1269

1270
1271
1272
1273
1274
1275
1276







-
-
-

-


-
-
-

-







!endif # $(DOING_TK)
!endif # $(DOING_TK) || $(NEED_TK)

# Various output paths
PRJIMPLIB	= $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
PRJLIBNAME8	= $(PROJECT)$(VERSION)$(SUFX).$(EXT)
PRJLIBNAME9	= tcl9$(PROJECT)$(VERSION)$(SUFX).$(EXT)
!if $(TCL_MAJOR_VERSION) == 8 || "$(TCL_BUILD_FOR)" == "8"
PRJLIBNAME	= $(PRJLIBNAME8)
!else
PRJLIBNAME	= $(PRJLIBNAME9)
!endif
PRJLIB		= $(OUT_DIR)\$(PRJLIBNAME)

!if $(TCL_MAJOR_VERSION) == 8
PRJSTUBLIBNAME	= $(STUBPREFIX)$(VERSION).lib
!else
PRJSTUBLIBNAME	= $(STUBPREFIX).lib
!endif
PRJSTUBLIB	= $(OUT_DIR)\$(PRJSTUBLIBNAME)

# If extension parent makefile has not defined a resource definition file,
# we will generate one from standard template.
!if !$(DOING_TCL) && !$(DOING_TK) && !$(STATIC_BUILD)
!ifdef RCFILE
RESFILE = $(TMP_DIR)\$(RCFILE:.rc=.res)
1407
1408
1409
1410
1411
1412
1413
1414
1415

1416
1417
1418
1419
1420
1421
1422
1423
1367
1368
1369
1370
1371
1372
1373


1374

1375
1376
1377
1378
1379
1380
1381







-
-
+
-







OPTDEFINES	= $(OPTDEFINES) /DSTATIC_BUILD
!elseif $(TCL_VERSION) > 86
OPTDEFINES	= $(OPTDEFINES) /DTCL_WITH_EXTERNAL_TOMMATH
!if "$(MACHINE)" == "AMD64" || "$(MACHINE)" == "ARM64"
OPTDEFINES	= $(OPTDEFINES) /DMP_64BIT
!endif
!endif
!if $(TCL_NO_DEPRECATED)
OPTDEFINES	= $(OPTDEFINES) /DTCL_NO_DEPRECATED
OPTDEFINES	= $(OPTDEFINES)
!endif

!if $(USE_STUBS)
# Note we do not define USE_TCL_STUBS even when building tk since some
# test targets in tk do not use stubs
!if !$(DOING_TCL)
USE_STUBS_DEFS  = /DUSE_TCL_STUBS /DUSE_TCLOO_STUBS
!if $(NEED_TK)
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1396
1397
1398
1399
1400
1401
1402









1403
1404
1405
1406
1407
1408
1409







-
-
-
-
-
-
-
-
-







!if "$(MACHINE)" == "AMD64" || "$(MACHINE)" == "ARM64"
OPTDEFINES	= $(OPTDEFINES) /DTCL_CFG_DO64BIT
!endif
!if $(VCVERSION) < 1300
OPTDEFINES	= $(OPTDEFINES) /DNO_STRTOI64=1
!endif

!if $(TCL_MAJOR_VERSION) == 8
!if "$(_USE_64BIT_TIME_T)" == "1"
OPTDEFINES	= $(OPTDEFINES) /D_USE_64BIT_TIME_T=1
!endif
!endif
!if "$(TCL_BUILD_FOR)" == "8"
OPTDEFINES	= $(OPTDEFINES) /DTCL_MAJOR_VERSION=8
!endif

# Like the TEA system only set this non empty for non-Tk extensions
# Note: some extensions use PACKAGE_NAME and others use PACKAGE_TCLNAME
# so we pass both
!if !$(DOING_TCL) && !$(DOING_TK)
PKGNAMEFLAGS = /DPACKAGE_NAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \
	/DPACKAGE_TCLNAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \
	/DPACKAGE_VERSION="\"$(DOTVERSION)\"" \
Changes to win/tcl.m4.







1
2
3
4
5
6
7
1
2
3
4
5
6
7
8
9
10
11
12
13
14
+
+
+
+
+
+
+







# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# See the file "COPYING" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#------------------------------------------------------------------------
# SC_PATH_TCLCONFIG --
#
#	Locate the tclConfig.sh file and perform a sanity check on
#	the Tcl compile flags
#
# Arguments:
Changes to win/tclAppInit.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
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

-
-
-
-
-
-
-








-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+







/*
 * tclAppInit.c --
 *
 *	Provides a default version of the main program and Tcl_AppInit
 *	procedure for tclsh and other Tcl-based applications (without Tk).
 *	Note that this program must be built in Win32 console mode to work
 *	properly.
 *
 * Copyright (c) 1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tcl.h"
#if TCL_MAJOR_VERSION < 9
#  if defined(USE_TCL_STUBS)
#	error "Don't build with USE_TCL_STUBS!"
#  endif
#  if TCL_MINOR_VERSION < 7
#   define Tcl_LibraryInitProc Tcl_PackageInitProc
/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclAppInit.c --
#   define Tcl_StaticLibrary Tcl_StaticPackage
#  endif
#endif
 *
 *	Provides a default version of the main program and Tcl_AppInit
 *	procedure for tclsh and other Tcl-based applications (without Tk).
 *	Note that this program must be built in Win32 console mode to work
 *	properly.
 */

#include "tcl.h"

#ifdef TCL_TEST
extern Tcl_LibraryInitProc Tcltest_Init;
extern Tcl_LibraryInitProc Tcltest_SafeInit;
#endif /* TCL_TEST */

#if defined(STATIC_BUILD)
132
133
134
135
136
137
138
139

140
141
142
143
144
145
146
134
135
136
137
138
139
140

141
142
143
144
145
146
147
148







-
+







	if (*p == '\\') {
	    *p = '/';
	}
    }

#ifdef TCL_LOCAL_MAIN_HOOK
    TCL_LOCAL_MAIN_HOOK(&argc, &argv);
#elif (TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6) && (!defined(_WIN32) || defined(UNICODE))
#elif (!defined(_WIN32) || defined(UNICODE))
    /* New in Tcl 8.7. This doesn't work on Windows without UNICODE */
    TclZipfs_AppHook(&argc, &argv);
#endif

    Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
    return 0;			/* Needed only to prevent compiler warning. */
}
Changes to win/tclWin32Dll.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
















14
15
16
17
18
19
20
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

-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclWin32Dll.c --
 *
 *	This file contains the DLL entry point and other low-level bit bashing
 *	code that needs inline assembly.
 *
 * Copyright © 1995-1996 Sun Microsystems, Inc.
 * Copyright © 1998-2000 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclWin32Dll.c --
 *
 *	This file contains the DLL entry point and other low-level bit bashing
 *	code that needs inline assembly.
 */

#include "tclWinInt.h"
#if defined(HAVE_INTRIN_H)
#   include <intrin.h>
#endif

/*
 * The following variables keep track of information about this DLL on a
428
429
430
431
432
433
434
435
436


437
438
439
440
441
442
443
439
440
441
442
443
444
445


446
447
448
449
450
451
452
453
454







-
-
+
+







 *	instruction in the four integers designated by 'regsPtr'
 *
 *----------------------------------------------------------------------
 */

int
TclWinCPUID(
    int index,		/* Which CPUID value to retrieve. */
    int *regsPtr)	/* Registers after the CPUID. */
    int index,			/* Which CPUID value to retrieve. */
    int *regsPtr)		/* Registers after the CPUID. */
{
    int status = TCL_ERROR;

#if defined(HAVE_INTRIN_H) && defined(_WIN64) && defined(HAVE_CPUID)

    __cpuid((int *)regsPtr, index);
    status = TCL_OK;
Changes to win/tclWinChan.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclWinChan.c
 *
 *	Channel drivers for Windows channels based on files, command pipes and
 *	TCP sockets.
 *
 * Copyright © 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclWinChan.c
 *
 *	Channel drivers for Windows channels based on files, command pipes and
 *	TCP sockets.
 */

#include "tclWinInt.h"
#include "tclIO.h"

/*
 * State flags used in the info structures below.
 */

76
77
78
79
80
81
82
83

84
85
86
87
88
89
90
87
88
89
90
91
92
93

94
95
96
97
98
99
100
101







-
+







static void		FileChannelExitHandler(void *clientData);
static void		FileCheckProc(void *clientData, int flags);
static int		FileCloseProc(void *instanceData,
			    Tcl_Interp *interp, int flags);
static int		FileEventProc(Tcl_Event *evPtr, int flags);
static int		FileGetHandleProc(void *instanceData,
			    int direction, void **handlePtr);
static int		FileGetOptionProc(void *instanceData,
static int		FileGetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static ThreadSpecificData *FileInit(void);
static int		FileInputProc(void *instanceData, char *buf,
			    int toRead, int *errorCode);
static int		FileOutputProc(void *instanceData,
			    const char *buf, int toWrite, int *errorCode);
380
381
382
383
384
385
386
387

388
389
390
391
392
393
394
391
392
393
394
395
396
397

398
399
400
401
402
403
404
405







-
+







 *	Sets the device into blocking or non-blocking mode.
 *
 *----------------------------------------------------------------------
 */

static int
FileBlockProc(
    void *instanceData,	/* Instance data for channel. */
    void *instanceData,		/* Instance data for channel. */
    int mode)			/* TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    FileInfo *infoPtr = (FileInfo *)instanceData;

    /*
     * Files on Windows can not be switched between blocking and nonblocking,
419
420
421
422
423
424
425
426

427
428
429
430
431
432
433
430
431
432
433
434
435
436

437
438
439
440
441
442
443
444







-
+







 *	Closes the physical channel
 *
 *----------------------------------------------------------------------
 */

static int
FileCloseProc(
    void *instanceData,	/* Pointer to FileInfo structure. */
    void *instanceData,		/* Pointer to FileInfo structure. */
    TCL_UNUSED(Tcl_Interp *),
    int flags)
{
    FileInfo *fileInfoPtr = (FileInfo *)instanceData;
    FileInfo *infoPtr;
    ThreadSpecificData *tsdPtr;
    int errorCode = 0;
469
470
471
472
473
474
475
476

477
478
479
480
481
482
483
480
481
482
483
484
485
486

487
488
489
490
491
492
493
494







-
+







	    /*
	     * This channel exists on the thread local list. It should have
	     * been removed by an earlier Threadaction call, but do that now
	     * since just deallocating fileInfoPtr would leave an deallocated
	     * pointer on the thread local list.
	     */

	    FileThreadActionProc(fileInfoPtr,TCL_CHANNEL_THREAD_REMOVE);
	    FileThreadActionProc(fileInfoPtr, TCL_CHANNEL_THREAD_REMOVE);
	    break;
	}
    }
    Tcl_Free(fileInfoPtr);
    return errorCode;
}

497
498
499
500
501
502
503
504

505
506
507
508
509
510
511
508
509
510
511
512
513
514

515
516
517
518
519
520
521
522







-
+







 *	operations.
 *
 *----------------------------------------------------------------------
 */

static long long
FileWideSeekProc(
    void *instanceData,	/* File state. */
    void *instanceData,		/* File state. */
    long long offset,		/* Offset to seek to. */
    int mode,			/* Relative to where should we seek? */
    int *errorCodePtr)		/* To store error code. */
{
    FileInfo *infoPtr = (FileInfo *)instanceData;
    DWORD moveMethod;
    LONG newPos, newPosHigh;
549
550
551
552
553
554
555
556

557
558
559
560
561
562
563
560
561
562
563
564
565
566

567
568
569
570
571
572
573
574







-
+







 *	Truncates the file, may move file pointers too.
 *
 *----------------------------------------------------------------------
 */

static int
FileTruncateProc(
    void *instanceData,	/* File state. */
    void *instanceData,		/* File state. */
    long long length)		/* Length to truncate at. */
{
    FileInfo *infoPtr = (FileInfo *)instanceData;
    LONG newPos, newPosHigh, oldPos, oldPosHigh;

    /*
     * Save where we were...
625
626
627
628
629
630
631
632

633
634
635
636
637
638
639
636
637
638
639
640
641
642

643
644
645
646
647
648
649
650







-
+







 *	Reads input from the actual channel.
 *
 *----------------------------------------------------------------------
 */

static int
FileInputProc(
    void *instanceData,	/* File state. */
    void *instanceData,		/* File state. */
    char *buf,			/* Where to store data read. */
    int bufSize,		/* Num bytes available in buffer. */
    int *errorCode)		/* Where to store error code. */
{
    FileInfo *infoPtr = (FileInfo *)instanceData;
    DWORD bytesRead;

680
681
682
683
684
685
686
687

688
689
690
691
692
693
694
691
692
693
694
695
696
697

698
699
700
701
702
703
704
705







-
+







 *	Writes output on the actual channel.
 *
 *----------------------------------------------------------------------
 */

static int
FileOutputProc(
    void *instanceData,	/* File state. */
    void *instanceData,		/* File state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCode)		/* Where to store error code. */
{
    FileInfo *infoPtr = (FileInfo *)instanceData;
    DWORD bytesWritten;

727
728
729
730
731
732
733
734

735
736
737
738
739
740
741
738
739
740
741
742
743
744

745
746
747
748
749
750
751
752







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
FileWatchProc(
    void *instanceData,	/* File state. */
    void *instanceData,		/* File state. */
    int mask)			/* What events to watch for; OR-ed combination
				 * of TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    FileInfo *infoPtr = (FileInfo *)instanceData;
    Tcl_Time blockTime = { 0, 0 };

766
767
768
769
770
771
772
773

774
775

776
777
778
779
780
781
782
777
778
779
780
781
782
783

784
785

786
787
788
789
790
791
792
793







-
+

-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
FileGetHandleProc(
    void *instanceData,	/* The file state. */
    void *instanceData,		/* The file state. */
    int direction,		/* TCL_READABLE or TCL_WRITABLE */
    void **handlePtr)	/* Where to store the handle.  */
    void **handlePtr)		/* Where to store the handle.  */
{
    FileInfo *infoPtr = (FileInfo *)instanceData;

    if (!TEST_FLAG(direction, infoPtr->validMask)) {
	return TCL_ERROR;
    }

901
902
903
904
905
906
907
908

909
910
911
912
913
914
915
912
913
914
915
916
917
918

919
920
921
922
923
924
925
926







-
+







#undef STORE_ELEM

    return dictObj;
}

static int
FileGetOptionProc(
    void *instanceData,	/* The file state. */
    void *instanceData,		/* The file state. */
    Tcl_Interp *interp,		/* For error reporting. */
    const char *optionName,	/* What option to read, or NULL for all. */
    Tcl_DString *dsPtr)		/* Where to write the value read. */
{
    FileInfo *infoPtr = (FileInfo *)instanceData;
    int valid = 0;		/* Flag if valid option parsed. */
    int len;
941
942
943
944
945
946
947
948

949
950
951
952
953
954
955
952
953
954
955
956
957
958

959
960
961
962
963
964
965
966







-
+








	/*
	 * Transfer dictionary to the DString. Note that we don't do this as
	 * an element as this is an option that can't be retrieved with a
	 * general probe.
	 */

	dictContents = TclGetStringFromObj(dictObj, &dictLength);
	dictContents = Tcl_GetStringFromObj(dictObj, &dictLength);
	Tcl_DStringAppend(dsPtr, dictContents, dictLength);
	Tcl_DecrRefCount(dictObj);
	return TCL_OK;
    }

    if (valid) {
	return TCL_OK;
1199
1200
1201
1202
1203
1204
1205
1206

1207
1208
1209
1210
1211
1212
1213
1210
1211
1212
1213
1214
1215
1216

1217
1218
1219
1220
1221
1222
1223
1224







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_MakeFileChannel(
    void *rawHandle,	/* OS level handle */
    void *rawHandle,		/* OS level handle */
    int mode)			/* OR'ed combination of TCL_READABLE and
				 * TCL_WRITABLE to indicate file mode. */
{
#if defined(HAVE_NO_SEH) && !defined(_WIN64) && !defined(__clang__)
    TCLEXCEPTION_REGISTRATION registration;
#endif
    char channelName[16 + TCL_INTEGER_SPACE];
1447
1448
1449
1450
1451
1452
1453
1454
1455


1456
1457
1458
1459
1460
1461
1462
1458
1459
1460
1461
1462
1463
1464


1465
1466
1467
1468
1469
1470
1471
1472
1473







-
-
+
+







	return (Tcl_Channel) NULL;
    }

    /*
     * Set up the normal channel options for stdio handles.
     */

    if (Tcl_SetChannelOption(NULL,channel,"-translation","auto")!=TCL_OK ||
	    Tcl_SetChannelOption(NULL,channel,"-buffering",bufMode)!=TCL_OK) {
    if (Tcl_SetChannelOption(NULL, channel, "-translation", "auto")!=TCL_OK ||
	    Tcl_SetChannelOption(NULL, channel, "-buffering", bufMode)!=TCL_OK) {
	Tcl_CloseEx(NULL, channel, 0);
	return (Tcl_Channel) NULL;
    }
    return channel;
}

/*
1668
1669
1670
1671
1672
1673
1674
1675

1676
1677
1678
1679
1680
1681
1682
1679
1680
1681
1682
1683
1684
1685

1686
1687
1688
1689
1690
1691
1692
1693







-
+







	    }
	}
    }

    return type;
}

 /*
/*
 *----------------------------------------------------------------------
 *
 * NativeIsComPort --
 *
 *	Determines if a path refers to a Windows serial port.  A simple and
 *	efficient solution is to use a "name hint" to detect COM ports by
 *	their filename instead of resorting to a syscall to detect serialness
Changes to win/tclWinConsole.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclWinConsole.c --
 *
 *	This file implements the Windows-specific console functions, and the
 *	"console" channel driver. Windows 7 or later required.
 *
 * Copyright © 2022 Ashok P. Nadkarni
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclWinConsole.c --
 *
 *	This file implements the Windows-specific console functions, and the
 *	"console" channel driver. Windows 7 or later required.
 */

#ifdef TCL_CONSOLE_DEBUG
#undef NDEBUG /* Enable asserts */
#endif

#include "tclWinInt.h"
#include <assert.h>
#include <ctype.h>
90
91
92
93
94
95
96
97
98
99
100




101
102
103
104
105
106
107
101
102
103
104
105
106
107




108
109
110
111
112
113
114
115
116
117
118







-
-
-
-
+
+
+
+







#endif

/*
 * Ring buffer for storing data. Actual data is from bufPtr[start]:bufPtr[size-1]
 * and bufPtr[0]:bufPtr[length - (size-start)].
 */
typedef struct RingBuffer {
    char *bufPtr;	/* Pointer to buffer storage */
    Tcl_Size capacity;	/* Size of the buffer in RingBufferChar */
    Tcl_Size start;	/* Start of the data within the buffer. */
    Tcl_Size length;	/* Number of RingBufferChar*/
    char *bufPtr;		/* Pointer to buffer storage */
    Tcl_Size capacity;		/* Size of the buffer in RingBufferChar */
    Tcl_Size start;		/* Start of the data within the buffer. */
    Tcl_Size length;		/* Number of RingBufferChar*/
} RingBuffer;
#define RingBufferLength(ringPtr_) ((ringPtr_)->length)
#define RingBufferHasFreeSpace(ringPtr_) ((ringPtr_)->length < (ringPtr_)->capacity)
#define RINGBUFFER_ASSERT(ringPtr_) assert(RingBufferCheck(ringPtr_))

/*
 * The Win32 console API does not support non-blocking I/O in any form. Thus
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
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







-
-
-
-
-
-
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+







 *
 * Note on reference counting - a ConsoleHandleInfo instance has multiple
 * references to it - one each from every channel that is attached to it
 * plus one from the console thread itself which also serves as the reference
 * from gConsoleHandleInfoList.
 */
typedef struct ConsoleHandleInfo {
    struct ConsoleHandleInfo *nextPtr; /* Process-global list of consoles */
    HANDLE console;       /* Console handle */
    HANDLE consoleThread; /* Handle to thread doing actual i/o on the console */
    SRWLOCK lock;	  /* Controls access to this structure.
			   * Cheaper than CRITICAL_SECTION but note does not
			   * support recursive locks or Try* style attempts.*/
    struct ConsoleHandleInfo *nextPtr;
				/* Process-global list of consoles */
    HANDLE console;		/* Console handle */
    HANDLE consoleThread;	/* Handle to thread doing actual i/o on the
				 * console */
    SRWLOCK lock;		/* Controls access to this structure.
				 * Cheaper than CRITICAL_SECTION but note does
				 * not support recursive locks or Try* style
				 * attempts.*/
    CONDITION_VARIABLE consoleThreadCV;/* For awakening console thread */
    CONDITION_VARIABLE interpThreadCV; /* For awakening interpthread(s) */
    RingBuffer buffer;	  /* Buffer for data transferred between console
			   * threads and Tcl threads. For input consoles,
			   * written by the console thread and read by Tcl
			   * threads. The converse for output threads */
    DWORD initMode;	  /* Initial console mode. */
    DWORD lastError;	  /* An error caused by the last background
			   * operation. Set to 0 if no error has been
			   * detected. */
    int numRefs;	  /* See comments above */
    int permissions;	  /* TCL_READABLE for input consoles, TCL_WRITABLE
			   * for output. Only one or the other can be set. */
    RingBuffer buffer;		/* Buffer for data transferred between console
				 * threads and Tcl threads. For input consoles,
				 * written by the console thread and read by Tcl
				 * threads. The converse for output threads */
    DWORD initMode;		/* Initial console mode. */
    DWORD lastError;		/* An error caused by the last background
				 * operation. Set to 0 if no error has been
				 * detected. */
    int numRefs;		/* See comments above */
    int permissions;		/* TCL_READABLE for input consoles, TCL_WRITABLE
				 * for output. Only one or the other can be set. */
    int flags;
#define CONSOLE_DATA_AWAITED 0x0001 /* An interpreter is awaiting data */
} ConsoleHandleInfo;

/*
 * This structure describes per-instance data for a console based channel.
 *
179
180
181
182
183
184
185
186

187
188
189
190
191
192
193
193
194
195
196
197
198
199

200
201
202
203
204
205
206
207







-
+







    HANDLE handle;		/* Console handle */
    Tcl_ThreadId threadId;	/* Id of owning thread */
    struct ConsoleChannelInfo *nextWatchingChannelPtr;
				/* Pointer to next channel watching events. */
    Tcl_Channel channel;	/* Pointer to channel structure. */
    DWORD initMode;		/* Initial console mode. */
    int numRefs;		/* See comments above */
    int permissions;            /* OR'ed combination of TCL_READABLE,
    int permissions;		/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
				 * which operations are valid on the file. */
    int watchMask;		/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
				 * which events should be reported. */
    int flags;			/* State flags */
#define CONSOLE_EVENT_QUEUED 0x0001 /* Notification event already queued */
750
751
752
753
754
755
756
757
758


759
760
761
762
763
764
765
764
765
766
767
768
769
770


771
772
773
774
775
776
777
778
779







-
-
+
+







/*
 *----------------------------------------------------------------------
 *
 * ConsoleSetupProc --
 *
 *	This procedure is invoked before Tcl_DoOneEvent blocks waiting for an
 *	event. It walks the channel list and if any input channel has data
 *      available or output channel has space for data, sets the event loop
 *      blocking time to 0 so that it will poll immediately.
 *	available or output channel has space for data, sets the event loop
 *	blocking time to 0 so that it will poll immediately.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Adjusts the block time if needed.
 *
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
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







-
-
+
+




-
+
+

















-
-
-
-
-
-
+
+
+
+
+
+
+
+







 *    A console reader or writer thread is started. The returned structure
 *    is placed on the active console handler list gConsoleHandleInfoList.
 *
 *------------------------------------------------------------------------
 */
static ConsoleHandleInfo *
AllocateConsoleHandleInfo(
    HANDLE consoleHandle,
    int permissions)   /* TCL_READABLE or TCL_WRITABLE */
    HANDLE consoleHandle,	/* Actual handle to console. */
    int permissions)		/* TCL_READABLE or TCL_WRITABLE */
{
    ConsoleHandleInfo *handleInfoPtr;
    DWORD consoleMode;

    handleInfoPtr = (ConsoleHandleInfo *)Tcl_Alloc(sizeof(*handleInfoPtr));
    handleInfoPtr = (ConsoleHandleInfo *) Tcl_Alloc(sizeof(*handleInfoPtr));
    memset(handleInfoPtr, 0, sizeof(*handleInfoPtr));
    memset(handleInfoPtr, 0, sizeof(*handleInfoPtr));
    handleInfoPtr->console = consoleHandle;
    InitializeSRWLock(&handleInfoPtr->lock);
    InitializeConditionVariable(&handleInfoPtr->consoleThreadCV);
    InitializeConditionVariable(&handleInfoPtr->interpThreadCV);
    RingBufferInit(&handleInfoPtr->buffer, CONSOLE_BUFFER_SIZE);
    handleInfoPtr->lastError = 0;
    handleInfoPtr->permissions = permissions;
    handleInfoPtr->numRefs = 1; /* See function header */
    if (permissions == TCL_READABLE) {
	GetConsoleMode(consoleHandle, &handleInfoPtr->initMode);
	consoleMode = handleInfoPtr->initMode;
	consoleMode &= ~(ENABLE_WINDOW_INPUT | ENABLE_MOUSE_INPUT);
	consoleMode |= ENABLE_LINE_INPUT;
	SetConsoleMode(consoleHandle, consoleMode);
    }
    handleInfoPtr->consoleThread = CreateThread(
	NULL, /* default security descriptor */
	2*CONSOLE_BUFFER_SIZE, /* Stack size - gets rounded up to granularity */
	permissions == TCL_READABLE ? ConsoleReaderThread : ConsoleWriterThread,
	handleInfoPtr, /* Pass to thread */
	0,             /* Flags - no special cases */
	NULL);         /* Don't care about thread id */
	    NULL,		/* default security descriptor */
	    2 * CONSOLE_BUFFER_SIZE, /* Stack size, rounded up to granularity */
	    permissions == TCL_READABLE
		    ? ConsoleReaderThread
		    : ConsoleWriterThread,
	    handleInfoPtr,	/* Pass to thread */
	    0,			/* Flags - no special cases */
	    NULL);		/* Don't care about thread id */
    if (handleInfoPtr->consoleThread == NULL) {
	/* Note - SRWLock and condition variables do not need finalization */
	RingBufferClear(&handleInfoPtr->buffer);
	Tcl_Free(handleInfoPtr);
	return NULL;
    }

2254
2255
2256
2257
2258
2259
2260
2261

2262
2263
2264
2265
2266
2267
2268
2271
2272
2273
2274
2275
2276
2277

2278
2279
2280
2281
2282
2283
2284
2285







-
+







 *	May modify an option on a console. Sets Error message if needed (by
 *	calling Tcl_BadChannelOption).
 *
 *----------------------------------------------------------------------
 */
static int
ConsoleSetOptionProc(
    void *instanceData,	/* File state. */
    void *instanceData,		/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Which option to set? */
    const char *value)		/* New value for option. */
{
    ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;
    int len = strlen(optionName);
    int vlen = strlen(value);
2343
2344
2345
2346
2347
2348
2349
2350

2351
2352
2353
2354
2355
2356
2357
2360
2361
2362
2363
2364
2365
2366

2367
2368
2369
2370
2371
2372
2373
2374







-
+







 *	(by calling Tcl_BadChannelOption).
 *
 *----------------------------------------------------------------------
 */

static int
ConsoleGetOptionProc(
    void *instanceData,	/* File state. */
    void *instanceData,		/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Option to get. */
    Tcl_DString *dsPtr)		/* Where to store value(s). */
{
    ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;
    int valid = 0;		/* Flag if valid option parsed. */
    unsigned int len;
Changes to win/tclWinDde.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclWinDde.c --
 *
 *	This file provides functions that implement the "send" command,
 *	allowing commands to be passed from interpreter to interpreter.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclWinDde.c --
 *
 *	This file provides functions that implement the "send" command,
 *	allowing commands to be passed from interpreter to interpreter.
 */

#undef STATIC_BUILD
#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include "tclInt.h"
#include <dde.h>
#include <ddeml.h>
88
89
90
91
92
93
94
95
96




97
98
99
100
101
102
103
99
100
101
102
103
104
105


106
107
108
109
110
111
112
113
114
115
116







-
-
+
+
+
+







#define DDE_FLAG_BINARY 2
#define DDE_FLAG_FORCE 4

TCL_DECLARE_MUTEX(ddeMutex)

#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7)
# if TCL_UTF_MAX > 3
#   define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c)
#   define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c)
#   define Tcl_WCharToUtfDString(a, b, c) \
	Tcl_WinTCharToUtf((TCHAR *)(a), (b) * sizeof(WCHAR), c)
#   define Tcl_UtfToWCharDString(a, b, c) \
	(WCHAR *)Tcl_WinUtfToTChar(a, b, c)
# else
#   define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString
#   define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString
# endif
#ifndef Tcl_Size
#   define Tcl_Size int
#endif
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
147
148
149
150
151
152
153





154
155
156
157
158
159
160







-
-
-
-
-







			    Tcl_Obj *const objv[]);

#ifdef __cplusplus
extern "C" {
#endif
DLLEXPORT int		Dde_Init(Tcl_Interp *interp);
DLLEXPORT int		Dde_SafeInit(Tcl_Interp *interp);
#if TCL_MAJOR_VERSION < 9
/* With those additional entries, "load tcldde14.dll" works without 3th argument */
DLLEXPORT int		Tcldde_Init(Tcl_Interp *interp);
DLLEXPORT int		Tcldde_SafeInit(Tcl_Interp *interp);
#endif
#ifdef __cplusplus
}
#endif

/*
 *----------------------------------------------------------------------
 *
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
179
180
181
182
183
184
185








186
187
188
189
190
191
192







-
-
-
-
-
-
-
-







	return TCL_ERROR;
    }

    Tcl_CreateObjCommand2(interp, "dde", DdeObjCmd, NULL, NULL);
    Tcl_CreateExitHandler(DdeExitProc, NULL);
    return Tcl_PkgProvideEx(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION, NULL);
}
#if TCL_MAJOR_VERSION < 9
int
Tcldde_Init(
    Tcl_Interp *interp)
{
    return Dde_Init(interp);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Dde_SafeInit --
 *
 *	This function initializes the dde command within a safe interp
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
206
207
208
209
210
211
212








213
214
215
216
217
218
219







-
-
-
-
-
-
-
-







{
    int result = Dde_Init(interp);
    if (result == TCL_OK) {
	Tcl_HideCommand(interp, "dde", "dde");
    }
    return result;
}
#if TCL_MAJOR_VERSION < 9
int
Tcldde_SafeInit(
    Tcl_Interp *interp)
{
    return Dde_SafeInit(interp);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Initialize --
 *
 *	Initialize the global DDE instance.
306
307
308
309
310
311
312
313

314
315
316

317
318
319
320
321
322
323
298
299
300
301
302
303
304

305
306
307

308
309
310
311
312
313
314
315







-
+


-
+







 *
 *----------------------------------------------------------------------
 */

static const WCHAR *
DdeSetServerName(
    Tcl_Interp *interp,
    const WCHAR *name, /* The name that will be used to refer to the
    const WCHAR *name,		/* The name that will be used to refer to the
				 * interpreter in later "send" commands. Must
				 * be globally unique. */
    int flags,		/* DDE_FLAG_FORCE or 0 */
    int flags,			/* DDE_FLAG_FORCE or 0 */
    Tcl_Obj *handlerPtr)	/* Name of the optional proc/command to handle
				 * incoming Dde eval's */
{
    int suffix;
    RegisteredInterp *riPtr, *prevPtr;
    Tcl_DString dString;
    const WCHAR *actualName;
511
512
513
514
515
516
517
518

519
520
521
522
523
524
525
503
504
505
506
507
508
509

510
511
512
513
514
515
516
517







-
+







 *	The interpreter given by riPtr is unregistered.
 *
 *----------------------------------------------------------------------
 */

static void
DeleteProc(
    void *clientData)	/* The interp we are deleting. */
    void *clientData)		/* The interp we are deleting. */
{
    RegisteredInterp *riPtr = (RegisteredInterp *) clientData;
    RegisteredInterp *searchPtr, *prevPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    for (searchPtr = tsdPtr->interpListPtr, prevPtr = NULL;
	    (searchPtr != NULL) && (searchPtr != riPtr);
1299
1300
1301
1302
1303
1304
1305
1306

1307
1308

1309
1310
1311
1312
1313
1314
1315
1291
1292
1293
1294
1295
1296
1297

1298
1299

1300
1301
1302
1303
1304
1305
1306
1307







-
+

-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DdeObjCmd(
    void *dummy,	/* Not used. */
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* The interp we are sending from */
    Tcl_Size objc,			/* Number of arguments */
    Tcl_Size objc,		/* Number of arguments */
    Tcl_Obj *const *objv)	/* The arguments */
{
    static const char *const ddeCommands[] = {
	"servername", "execute", "poke", "request", "services", "eval", NULL};
    enum DdeSubcommands {
	DDE_SERVERNAME, DDE_EXECUTE, DDE_POKE, DDE_REQUEST, DDE_SERVICES,
	DDE_EVAL
Changes to win/tclWinError.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclWinError.c --
 *
 *	This file contains code for converting from Win32 errors to errno
 *	errors.
 *
 * Copyright © 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclWinError.c --
 *
 *	This file contains code for converting from Win32 errors to errno
 *	errors.
 */

#include "tclInt.h"
/*
 * The following table contains the mapping from Win32 errors to errno errors.
 */

static const unsigned char errorTable[] = {
    0,
Changes to win/tclWinFCmd.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclWinFCmd.c
 *
 *	This file implements the Windows specific portion of file manipulation
 *	subcommands of the "file" command.
 *
 * Copyright © 1996-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclWinFCmd.c
 *
 *	This file implements the Windows specific portion of file manipulation
 *	subcommands of the "file" command.
 */

#include "tclWinInt.h"

/*
 * The following constants specify the type of callback when
 * TraverseWinTree() calls the traverseProc()
 */

900
901
902
903
904
905
906
907
908


909
910
911
912
913
914
915
911
912
913
914
915
916
917


918
919
920
921
922
923
924
925
926







-
-
+
+







    Tcl_Obj **errorPtr)
{
    Tcl_DString ds;
    Tcl_DString srcString, dstString;
    Tcl_Obj *normSrcPtr, *normDestPtr;
    int ret;

    normSrcPtr = Tcl_FSGetNormalizedPath(NULL,srcPathPtr);
    normDestPtr = Tcl_FSGetNormalizedPath(NULL,destPathPtr);
    normSrcPtr = Tcl_FSGetNormalizedPath(NULL, srcPathPtr);
    normDestPtr = Tcl_FSGetNormalizedPath(NULL, destPathPtr);
    if ((normSrcPtr == NULL) || (normDestPtr == NULL)) {
	return TCL_ERROR;
    }

    Tcl_DStringInit(&srcString);
    Tcl_DStringInit(&dstString);
    Tcl_UtfToWCharDString(TclGetString(normSrcPtr), TCL_INDEX_NONE, &srcString);
1529
1530
1531
1532
1533
1534
1535
1536

1537
1538
1539
1540
1541
1542
1543
1540
1541
1542
1543
1544
1545
1546

1547
1548
1549
1550
1551
1552
1553
1554







-
+







	 * root volumes (drives) formatted as NTFS are declared hidden when
	 * they are not (and cannot be).
	 *
	 * We test for, and fix that case, here.
	 */

	Tcl_Size len;
	const char *str = TclGetStringFromObj(fileName, &len);
	const char *str = Tcl_GetStringFromObj(fileName, &len);

	if (len < 4) {
	    if (len == 0) {
		/*
		 * Not sure if this is possible, but we pass it on anyway.
		 */
	    } else if (len == 1 && (str[0] == '/' || str[0] == '\\')) {
1617
1618
1619
1620
1621
1622
1623
1624

1625
1626
1627
1628
1629
1630
1631
1628
1629
1630
1631
1632
1633
1634

1635
1636
1637
1638
1639
1640
1641
1642







-
+








    for (i = 0; i < pathc; i++) {
	Tcl_Obj *elt;
	char *pathv;

	Tcl_ListObjIndex(NULL, splitPath, i, &elt);

	pathv = TclGetStringFromObj(elt, &length);
	pathv = Tcl_GetStringFromObj(elt, &length);
	if ((pathv[0] == '/') || ((length == 3) && (pathv[1] == ':'))
		|| (strcmp(pathv, ".") == 0) || (strcmp(pathv, "..") == 0)) {
	    /*
	     * Handle "/", "//machine/export", "c:/", "." or ".." by just
	     * copying the string literally.  Uppercase the drive letter, just
	     * because it looks better under Windows to do so.
	     */
1653
1654
1655
1656
1657
1658
1659
1660

1661
1662
1663
1664
1665
1666
1667
1664
1665
1666
1667
1668
1669
1670

1671
1672
1673
1674
1675
1676
1677
1678







-
+







	    Tcl_IncrRefCount(tempPath);

	    /*
	     * We'd like to call Tcl_FSGetNativePath(tempPath) but that is
	     * likely to lead to infinite loops.
	     */

	    tempString = TclGetStringFromObj(tempPath, &length);
	    tempString = Tcl_GetStringFromObj(tempPath, &length);
	    Tcl_DStringInit(&ds);
	    nativeName = Tcl_UtfToWCharDString(tempString, length, &ds);
	    Tcl_DecrRefCount(tempPath);
	    handle = FindFirstFileW(nativeName, &data);
	    if (handle == INVALID_HANDLE_VALUE) {
		/*
		 * FindFirstFileW() doesn't like root directories. We would
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
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







-
+




-
+

















-
+








    /*
     * Build the path in writable memory from the user-supplied pieces and
     * some defaults. First, the parent temporary directory.
     */

    if (dirObj) {
	TclGetString(dirObj);
	Tcl_GetString(dirObj);
	if (dirObj->length < 1) {
	    goto useSystemTemp;
	}
	Tcl_DStringInit(&base);
	Tcl_UtfToWCharDString(TclGetString(dirObj), TCL_INDEX_NONE, &base);
	Tcl_UtfToWCharDString(Tcl_GetString(dirObj), TCL_INDEX_NONE, &base);
	if (dirObj->bytes[dirObj->length - 1] != '\\') {
	    Tcl_UtfToWCharDString("\\", TCL_INDEX_NONE, &base);
	}
    } else {
    useSystemTemp:
	Tcl_DStringInit(&base);
	Tcl_DStringAppend(&base, (char *) tempBuf, len * sizeof(WCHAR));
    }

    /*
     * Next, the base of the directory name.
     */

#define DEFAULT_TEMP_DIR_PREFIX	"tcl"
#define SUFFIX_LENGTH	8

    if (basenameObj) {
	Tcl_UtfToWCharDString(TclGetString(basenameObj), TCL_INDEX_NONE, &base);
	Tcl_UtfToWCharDString(Tcl_GetString(basenameObj), TCL_INDEX_NONE, &base);
    } else {
	Tcl_UtfToWCharDString(DEFAULT_TEMP_DIR_PREFIX, TCL_INDEX_NONE, &base);
    }
    Tcl_UtfToWCharDString("_", TCL_INDEX_NONE, &base);

    /*
     * Now we keep on trying random suffixes until we get one that works
Changes to win/tclWinFile.c.
















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-







/*
 * Copyright © 1995-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclWinFile.c --
 *
 *	This file contains temporary wrappers around UNIX file handling
 *	functions. These wrappers map the UNIX functions to Win32 HANDLE-style
 *	files, which can be manipulated through the Win32 console redirection
 *	interfaces.
 *
 * Copyright © 1995-1998 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 "tclWinInt.h"
#include "tclFileSystem.h"
#include <winioctl.h>
#include <shlobj.h>
#include <lm.h>		        /* For TclpGetUserHome(). */
493
494
495
496
497
498
499
500


501
502
503
504
505
506
507
504
505
506
507
508
509
510

511
512
513
514
515
516
517
518
519







-
+
+







    memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER));
    reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT;
    hFile = CreateFileW(linkOrigPath, GENERIC_WRITE, 0, NULL, OPEN_EXISTING,
	    FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL);

    if (hFile != INVALID_HANDLE_VALUE) {
	if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer,
		REPARSE_MOUNTPOINT_HEADER_SIZE,NULL,0,&returnedLength,NULL)) {
		REPARSE_MOUNTPOINT_HEADER_SIZE, NULL, 0, &returnedLength,
		NULL)) {
	    /*
	     * Error setting junction.
	     */

	    Tcl_WinConvertError(GetLastError());
	    CloseHandle(hFile);
	} else {
579
580
581
582
583
584
585
586

587
588
589
590
591
592
593
591
592
593
594
595
596
597

598
599
600
601
602
603
604
605







-
+







	offset = 0;
	if (reparseBuffer->MountPointReparseBuffer.PathBuffer[0] == '\\') {
	    /*
	     * Check whether this is a mounted volume.
	     */

	    if (wcsncmp(reparseBuffer->MountPointReparseBuffer.PathBuffer,
		    L"\\??\\Volume{",11) == 0) {
		    L"\\??\\Volume{", 11) == 0) {
		char drive;

		/*
		 * There is some confusion between \??\ and \\?\ which we have
		 * to fix here. It doesn't seem very well documented.
		 */

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
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







-
+
















-
+






-
+














-
-
-
+
+
+







			reparseBuffer->MountPointReparseBuffer.PathBuffer);
		if (drive != -1) {
		    char driveSpec[3] = {
			'\0', ':', '\0'
		    };

		    driveSpec[0] = drive;
		    retVal = Tcl_NewStringObj(driveSpec,2);
		    retVal = Tcl_NewStringObj(driveSpec, 2);
		    Tcl_IncrRefCount(retVal);
		    return retVal;
		}

		/*
		 * This is actually a mounted drive, which doesn't exists as a
		 * DOS drive letter. This means the path isn't actually a
		 * link, although we partially treat it like one ('file type'
		 * will return 'link'), but then the link will actually just
		 * be treated like an ordinary directory. I don't believe any
		 * serious inconsistency will arise from this, but it is
		 * something to be aware of.
		 */

		goto invalidError;
	    } else if (wcsncmp(reparseBuffer->MountPointReparseBuffer
		    .PathBuffer, L"\\\\?\\",4) == 0) {
		    .PathBuffer, L"\\\\?\\", 4) == 0) {
		/*
		 * Strip off the prefix.
		 */

		offset = 4;
	    } else if (wcsncmp(reparseBuffer->MountPointReparseBuffer
		    .PathBuffer, L"\\??\\",4) == 0) {
		    .PathBuffer, L"\\??\\", 4) == 0) {
		/*
		 * Strip off the prefix.
		 */

		offset = 4;
	    }
	}

	Tcl_DStringInit(&ds);
	Tcl_WCharToUtfDString(
		reparseBuffer->MountPointReparseBuffer.PathBuffer,
		reparseBuffer->MountPointReparseBuffer
		.SubstituteNameLength>>1, &ds);

	copy = Tcl_DStringValue(&ds)+offset;
	len = Tcl_DStringLength(&ds)-offset;
	retVal = Tcl_NewStringObj(copy,len);
	copy = Tcl_DStringValue(&ds) + offset;
	len = Tcl_DStringLength(&ds) - offset;
	retVal = Tcl_NewStringObj(copy, len);
	Tcl_IncrRefCount(retVal);
	Tcl_DStringFree(&ds);
	return retVal;
    }

  invalidError:
    Tcl_SetErrno(EINVAL);
918
919
920
921
922
923
924
925

926
927
928
929
930
931
932
930
931
932
933
934
935
936

937
938
939
940
941
942
943
944







-
+







	    /*
	     * Match a single file directly.
	     */

	    DWORD attr;
	    WIN32_FILE_ATTRIBUTE_DATA data;
	    Tcl_Size len = 0;
	    const char *str = TclGetStringFromObj(norm, &len);
	    const char *str = Tcl_GetStringFromObj(norm, &len);

	    native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);

	    if (GetFileAttributesExW(native,
		    GetFileExInfoStandard, &data) != TRUE) {
		return TCL_OK;
	    }
978
979
980
981
982
983
984
985

986
987
988
989
990
991
992
990
991
992
993
994
995
996

997
998
999
1000
1001
1002
1003
1004







-
+








	/*
	 * Build up the directory name for searching, including a trailing
	 * directory separator.
	 */

	Tcl_DStringInit(&dsOrig);
	dirName = TclGetStringFromObj(fileNamePtr, &dirLength);
	dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
	Tcl_DStringAppend(&dsOrig, dirName, dirLength);

	lastChar = dirName[dirLength -1];
	if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) {
	    TclDStringAppendLiteral(&dsOrig, "/");
	    dirLength++;
	}
1745
1746
1747
1748
1749
1750
1751
1752
1753


1754
1755
1756
1757
1758
1759
1760
1757
1758
1759
1760
1761
1762
1763


1764
1765
1766
1767
1768
1769
1770
1771
1772







-
-
+
+







	 * restrictions.  Since the ACL tests are more likely wrong than
	 * right, skip them.  Moreover, the unix owner access permissions are
	 * usually mapped to the Windows attributes, so if the user is the
	 * file owner then the attrib checks above are correct (as far as they
	 * go).
	 */

	if(!GetSecurityDescriptorOwner(sdPtr,&pSid,&SidDefaulted) ||
	   memcmp(GetSidIdentifierAuthority(pSid),&samba_unmapped,
	if(!GetSecurityDescriptorOwner(sdPtr, &pSid, &SidDefaulted) ||
	   memcmp(GetSidIdentifierAuthority(pSid), &samba_unmapped,
		  sizeof(SID_IDENTIFIER_AUTHORITY))==0) {
	    HeapFree(GetProcessHeap(), 0, sdPtr);
	    return 0; /* Attrib tests say access allowed. */
	}

	/*
	 * Perform security impersonation of the user and open the resulting
1889
1890
1891
1892
1893
1894
1895
1896

1897
1898
1899
1900
1901
1902
1903
1901
1902
1903
1904
1905
1906
1907

1908
1909
1910
1911
1912
1913
1914
1915







-
+







 *	See chdir() documentation.
 *
 *----------------------------------------------------------------------
 */

int
TclpObjChdir(
    Tcl_Obj *pathPtr)	/* Path to new working directory. */
    Tcl_Obj *pathPtr)		/* Path to new working directory. */
{
    int result;
    const WCHAR *nativePath;

    nativePath = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);

    if (!nativePath) {
2049
2050
2051
2052
2053
2054
2055
2056

2057
2058
2059
2060
2061
2062
2063
2061
2062
2063
2064
2065
2066
2067

2068
2069
2070
2071
2072
2073
2074
2075







-
+







	    FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
	    NULL, OPEN_EXISTING,
	    FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OPEN_REPARSE_POINT, NULL);

    if (fileHandle != INVALID_HANDLE_VALUE) {
	BY_HANDLE_FILE_INFORMATION data;

	if (GetFileInformationByHandle(fileHandle,&data) != TRUE) {
	if (GetFileInformationByHandle(fileHandle, &data) != TRUE) {
	    fileType = GetFileType(fileHandle);
	    CloseHandle(fileHandle);
	    if (fileType != FILE_TYPE_CHAR && fileType != FILE_TYPE_DISK) {
		Tcl_SetErrno(ENOENT);
		return -1;
	    }

2516
2517
2518
2519
2520
2521
2522
2523

2524
2525

2526
2527
2528
2529
2530
2531
2532
2528
2529
2530
2531
2532
2533
2534

2535
2536

2537
2538
2539
2540
2541
2542
2543
2544







-
+

-
+







 *
 *---------------------------------------------------------------------------
 */

int
TclpObjNormalizePath(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Obj *pathPtr,	        /* An unshared object containing the path to
    Tcl_Obj *pathPtr,		/* An unshared object containing the path to
				 * normalize */
    int nextCheckpoint)	        /* offset to start at in pathPtr */
    int nextCheckpoint)		/* offset to start at in pathPtr */
{
    char *lastValidPathEnd = NULL;
    Tcl_DString dsNorm;		/* This will hold the normalized string. */
    char *path, *currentPathEndPosition;
    Tcl_Obj *temp = NULL;
    int isDrive = 1;
    Tcl_DString ds;		/* Some workspace. */
2795
2796
2797
2798
2799
2800
2801
2802

2803
2804
2805
2806
2807
2808
2809
2807
2808
2809
2810
2811
2812
2813

2814
2815
2816
2817
2818
2819
2820
2821







-
+








	    Tcl_Obj *tmpPathPtr;
	    Tcl_Size len;

	    tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
		    nextCheckpoint);
	    Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, TCL_INDEX_NONE);
	    path = TclGetStringFromObj(tmpPathPtr, &len);
	    path = Tcl_GetStringFromObj(tmpPathPtr, &len);
	    Tcl_SetStringObj(pathPtr, path, len);
	    Tcl_DecrRefCount(tmpPathPtr);
	} else {
	    /*
	     * End of string was reached above.
	     */

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
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







-
+













-
+







	/*
	 * Path of form /foo/bar which is a path in the root directory of the
	 * current volume.
	 */

	const char *drive = TclGetString(useThisCwd);

	absolutePath = Tcl_NewStringObj(drive,2);
	absolutePath = Tcl_NewStringObj(drive, 2);
	Tcl_AppendToObj(absolutePath, path, TCL_INDEX_NONE);
	Tcl_IncrRefCount(absolutePath);

	/*
	 * We have a refCount on the cwd.
	 */
    } else {
	/*
	 * Path of form C:foo/bar, but this only makes sense if the cwd is
	 * also on drive C.
	 */

	Tcl_Size cwdLen;
	const char *drive = TclGetStringFromObj(useThisCwd, &cwdLen);
	const char *drive = Tcl_GetStringFromObj(useThisCwd, &cwdLen);
	char drive_cur = path[0];

	if (drive_cur >= 'a') {
	    drive_cur -= ('a' - 'A');
	}
	if (drive[0] == drive_cur) {
	    absolutePath = Tcl_DuplicateObj(useThisCwd);
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
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







-
+


-
+















-
+







    /*
     * Certain native path representations on Windows have this special prefix
     * to indicate that they are to be treated specially. For example
     * extremely long paths, or symlinks.
     */

    if (*copy == '\\') {
	if (0 == strncmp(copy,"\\??\\",4)) {
	if (0 == strncmp(copy, "\\??\\", 4)) {
	    copy += 4;
	    len -= 4;
	} else if (0 == strncmp(copy,"\\\\?\\",4)) {
	} else if (0 == strncmp(copy, "\\\\?\\", 4)) {
	    copy += 4;
	    len -= 4;
	}
    }

    /*
     * Ensure we are using forward slashes only.
     */

    for (p = copy; *p != '\0'; p++) {
	if (*p == '\\') {
	    *p = '/';
	}
    }

    objPtr = Tcl_NewStringObj(copy,len);
    objPtr = Tcl_NewStringObj(copy, len);
    Tcl_DStringFree(&ds);

    return objPtr;
}

/*
 *---------------------------------------------------------------------------
3053
3054
3055
3056
3057
3058
3059
3060

3061
3062
3063
3064
3065
3066
3067
3065
3066
3067
3068
3069
3070
3071

3072
3073
3074
3075
3076
3077
3078
3079







-
+







	 * validPathPtr returned from Tcl_FSGetNormalizedPath is owned by Tcl,
	 * so incr refCount here
	 */

	Tcl_IncrRefCount(validPathPtr);
    }

    str = TclGetStringFromObj(validPathPtr, &len);
    str = Tcl_GetStringFromObj(validPathPtr, &len);

    if (strlen(str) != (size_t)len) {
	/*
	 * String contains NUL-bytes. This is invalid.
	 */

	goto done;
3253
3254
3255
3256
3257
3258
3259
3260
3261


3262
3263
3264
3265
3266
3267
3268
3265
3266
3267
3268
3269
3270
3271


3272
3273
3274
3275
3276
3277
3278
3279
3280







-
-
+
+








/*
 *---------------------------------------------------------------------------
 *
 * TclWinFileOwned --
 *
 *	Returns 1 if the specified file exists and is owned by the current
 *      user and 0 otherwise. Like the Unix case, the check is made using
 *      the real process SID, not the effective (impersonation) one.
 *	user and 0 otherwise. Like the Unix case, the check is made using
 *	the real process SID, not the effective (impersonation) one.
 *
 *---------------------------------------------------------------------------
 */

int
TclWinFileOwned(
    Tcl_Obj *pathPtr)		/* File whose ownership is to be checked */
3312
3313
3314
3315
3316
3317
3318
3319

3320
3321
3322
3323
3324
3325

3326
3327
3328
3329
3330
3331
3332
3333
3334
3324
3325
3326
3327
3328
3329
3330

3331
3332
3333
3334
3335
3336

3337
3338
3339
3340
3341
3342
3343
3344
3345
3346







-
+





-
+









    }

    /*
     * Free allocations and be done.
     */

    if (secd) {
	LocalFree(secd);            /* Also frees ownerSid */
	LocalFree(secd);	/* Also frees ownerSid */
    }
    if (buf) {
	Tcl_Free(buf);
    }

    return (owned != 0);        /* Convert non-0 to 1 */
    return (owned != 0);	/* Convert non-0 to 1 */
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to win/tclWinInit.c.
1
2
3
4
5
6
7
8
9
10
11
12
13















14
15
16
17
18
19
20
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

-
-
-
-








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclWinInit.c --
 *
 *	Contains the Windows-specific interpreter initialization functions.
 *
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 * Copyright © 1998-1999 Scriptics Corporation.
 * All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclWinInit.c --
 *
 *	Contains the Windows-specific interpreter initialization functions.
 */

#include "tclWinInt.h"
#include <winnt.h>
#include <winbase.h>
#include <lmcons.h>

/*
 * GetUserNameW() is found in advapi32.dll
163
164
165
166
167
168
169
170

171
172
173
174
175
176
177
174
175
176
177
178
179
180

181
182
183
184
185
186
187
188







-
+







     * Look for the library in its source checkout location.
     */

    Tcl_ListObjAppendElement(NULL, pathPtr,
	    TclGetProcessGlobalValue(&sourceLibraryDir));

    *encodingPtr = NULL;
    bytes = TclGetStringFromObj(pathPtr, &length);
    bytes = Tcl_GetStringFromObj(pathPtr, &length);
    *lengthPtr = length++;
    *valuePtr = (char *)Tcl_Alloc(length);
    memcpy(*valuePtr, bytes, length);
    Tcl_DecrRefCount(pathPtr);
}

/*
538
539
540
541
542
543
544
545

546
547
548
549
550
551
552
549
550
551
552
553
554
555

556
557
558
559
560
561
562
563







-
+







	    TCL_GLOBAL_ONLY);
    Tcl_DStringFree(&ds);

    /*
     * Define what the platform PATH separator is. [TIP #315]
     */

    Tcl_SetVar2(interp, "tcl_platform","pathSeparator", ";", TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "tcl_platform", "pathSeparator", ";", TCL_GLOBAL_ONLY);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFindVariable --
 *
566
567
568
569
570
571
572
573

574
575
576
577
578
579
580
577
578
579
580
581
582
583

584
585
586
587
588
589
590
591







-
+







 *----------------------------------------------------------------------
 */

Tcl_Size
TclpFindVariable(
    const char *name,		/* Name of desired environment variable
				 * (UTF-8). */
    Tcl_Size *lengthPtr)		/* Used to return length of name (for
    Tcl_Size *lengthPtr)	/* Used to return length of name (for
				 * successful searches) or number of non-NULL
				 * entries in environ (for unsuccessful
				 * searches). */
{
    Tcl_Size i, length, result = TCL_INDEX_NONE;
    const WCHAR *env;
    const char *p1, *p2;
Changes to win/tclWinInt.h.
1
2
3
4
5
6
7
8
9
10
11















12
13
14
15
16
17
18
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

-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclWinInt.h --
 *
 *	Declarations of Windows-specific shared variables and procedures.
 *
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclWinInt.h --
 *
 *	Declarations of Windows-specific shared variables and procedures.
 */

#ifndef _TCLWININT
#define _TCLWININT

#include "tclInt.h"

#ifdef HAVE_NO_SEH
/*
47
48
49
50
51
52
53
54

55
56
57
58
59
60
61
58
59
60
61
62
63
64

65
66
67
68
69
70
71
72







-
+







			    char *channelName, int permissions);
MODULE_SCOPE HANDLE	TclWinSerialOpen(HANDLE handle, const WCHAR *name,
			    DWORD access);
MODULE_SCOPE int	TclWinSymLinkCopyDirectory(const WCHAR *LinkOriginal,
			    const WCHAR *LinkCopy);
MODULE_SCOPE int	TclWinSymLinkDelete(const WCHAR *LinkOriginal,
			    int linkOnly);
MODULE_SCOPE int        TclWinFileOwned(Tcl_Obj *);
MODULE_SCOPE int	TclWinFileOwned(Tcl_Obj *);
MODULE_SCOPE void	TclWinGenerateChannelName(char channelName[],
			    const char *channelTypeName, void *channelImpl);
MODULE_SCOPE const char*TclpGetUserName(Tcl_DString *bufferPtr);

/* Needed by tclWinFile.c and tclWinFCmd.c */
#ifndef FILE_ATTRIBUTE_REPARSE_POINT
#define FILE_ATTRIBUTE_REPARSE_POINT 0x00000400
Changes to win/tclWinLoad.c.
















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
-
-







/*
 * Copyright © 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclWinLoad.c --
 *
 *	This function provides a version of the TclLoadFile that works with
 *	the Windows "LoadLibrary" and "GetProcAddress" API for dynamic
 *	loading.
 *
 * Copyright © 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 "tclWinInt.h"

/*
 * Native name of the directory in the native filesystem where DLLs used in
 * this process are copied prior to loading, and mutex used to protect its
89
90
91
92
93
94
95
96

97
98
99
100
101
102
103
100
101
102
103
104
105
106

107
108
109
110
111
112
113
114







-
+







	 */

	Tcl_DString ds;

	/*
	 * Remember the first error on load attempt to be used if the
	 * second load attempt below also fails.
	*/
	 */
	firstError = (nativeName == NULL) ?
		ERROR_MOD_NOT_FOUND : GetLastError();

	Tcl_DStringInit(&ds);
	nativeName = Tcl_UtfToWCharDString(TclGetString(pathPtr), TCL_INDEX_NONE, &ds);
	hInstance = LoadLibraryExW(nativeName, NULL,
		LOAD_WITH_ALTERED_SEARCH_PATH);
Changes to win/tclWinNotify.c.
















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
-
-







/*
 * Copyright © 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclWinNotify.c --
 *
 *	This file contains Windows-specific procedures for the notifier, which
 *	is the lowest-level part of the Tcl event loop. This file works
 *	together with ../generic/tclNotify.c.
 *
 * Copyright © 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"

/*
 * The following static indicates whether this module has been initialized.
 */
144
145
146
147
148
149
150
151

152
153
154
155
156
157
158
155
156
157
158
159
160
161

162
163
164
165
166
167
168
169







-
+







 *	May dispose of the notifier window and class.
 *
 *----------------------------------------------------------------------
 */

void
TclpFinalizeNotifier(
    void *clientData)	/* Pointer to notifier data. */
    void *clientData)		/* Pointer to notifier data. */
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;

    /*
     * Only finalize the notifier if a notifier was installed in the current
     * thread; there is a route in which this is not guaranteed to be true
     * (when tclWin32Dll.c:DllMain() is called with the flag
214
215
216
217
218
219
220
221

222
223
224
225
226
227
228
225
226
227
228
229
230
231

232
233
234
235
236
237
238
239







-
+







 *	isn't already one pending.
 *
 *----------------------------------------------------------------------
 */

void
TclpAlertNotifier(
    void *clientData)	/* Pointer to thread data. */
    void *clientData)		/* Pointer to thread data. */
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;

    /*
     * Note that we do not need to lock around access to the hwnd because the
     * race condition has no effect since any race condition implies that the
     * notifier thread is already awake.
260
261
262
263
264
265
266
267

268
269
270
271
272
273
274
271
272
273
274
275
276
277

278
279
280
281
282
283
284
285







-
+







 *	Replaces any previous timer.
 *
 *----------------------------------------------------------------------
 */

void
TclpSetTimer(
    const Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
    const Tcl_Time *timePtr)	/* Maximum block time, or NULL. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    UINT timeout;

    /*
     * We only need to set up an interval timer if we're being called from an
     * external event loop. If we don't have a window handle then we just
366
367
368
369
370
371
372
373

374
375

376
377
378
379
380
381
382
377
378
379
380
381
382
383

384
385

386
387
388
389
390
391
392
393







-
+

-
+







 *----------------------------------------------------------------------
 */

int
TclAsyncNotifier(
    TCL_UNUSED(int),		/* Signal number. */
    TCL_UNUSED(Tcl_ThreadId),	/* Target thread. */
    TCL_UNUSED(void *),	/* Notifier data. */
    TCL_UNUSED(void *),		/* Notifier data. */
    TCL_UNUSED(int *),		/* Flag to mark. */
    TCL_UNUSED(int))			/* Value of mark. */
    TCL_UNUSED(int))		/* Value of mark. */
{
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
460
461
462
463
464
465
466
467

468
469
470
471
472
473
474
471
472
473
474
475
476
477

478
479
480
481
482
483
484
485







-
+







 *	Dispatches a message to a window procedure, which could do anything.
 *
 *----------------------------------------------------------------------
 */

int
TclpWaitForEvent(
    const Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
    const Tcl_Time *timePtr)	/* Maximum block time, or NULL. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    MSG msg;
    DWORD timeout, result;
    int status;

    /*
Changes to win/tclWinPanic.c.
1
2
3
4
5
6
7
8
9
10
11
12















13
14
15
16
17
18
19
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

-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclWinPanic.c --
 *
 *	Contains the Windows-specific command-line panic proc.
 *
 * Copyright © 2013 Jan Nijtmans.
 * All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclWinPanic.c --
 *
 *	Contains the Windows-specific command-line panic proc.
 */

#include "tclInt.h"
/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConsolePanic --
 *
 *	Display a message. If a debugger is present, present it directly to
Changes to win/tclWinPipe.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclWinPipe.c --
 *
 *	This file implements the Windows-specific exec pipeline functions, the
 *	"pipe" channel driver, and the "pid" Tcl command.
 *
 * Copyright © 1996-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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclWinPipe.c --
 *
 *	This file implements the Windows-specific exec pipeline functions, the
 *	"pipe" channel driver, and the "pid" Tcl command.
 */

#include "tclWinInt.h"

/*
 * The following variable is used to tell whether this module has been
 * initialized.
 */

912
913
914
915
916
917
918
919

920
921
922
923
924
925
926
923
924
925
926
927
928
929

930
931
932
933
934
935
936
937







-
+








int
TclpCreateProcess(
    Tcl_Interp *interp,		/* Interpreter in which to leave errors that
				 * occurred when creating the child process.
				 * Error messages from the child process
				 * itself are sent to errorFile. */
    size_t argc,			/* Number of arguments in following array. */
    size_t argc,		/* Number of arguments in following array. */
    const char **argv,		/* Array of argument strings. argv[0] contains
				 * the name of the executable converted to
				 * native format (using the
				 * Tcl_TranslateFileName call). Additional
				 * arguments have not been converted. */
    TclFile inputFile,		/* If non-NULL, gives the file to use as input
				 * for the child process. If inputFile file is
1536
1537
1538
1539
1540
1541
1542
1543

1544
1545
1546
1547
1548
1549
1550
1547
1548
1549
1550
1551
1552
1553

1554
1555
1556
1557
1558
1559
1560
1561







-
+







    return special;
}

static void
BuildCommandLine(
    const char *executable,	/* Full path of executable (including
				 * extension). Replacement for argv[0]. */
    size_t argc,			/* Number of arguments. */
    size_t argc,		/* Number of arguments. */
    const char **argv,		/* Argument strings in UTF. */
    Tcl_DString *linePtr)	/* Initialized Tcl_DString that receives the
				 * command line (WCHAR). */
{
    const char *arg, *start, *special, *bspos;
    int quote = 0;
    size_t i;
1953
1954
1955
1956
1957
1958
1959
1960

1961
1962
1963
1964
1965
1966
1967
1964
1965
1966
1967
1968
1969
1970

1971
1972
1973
1974
1975
1976
1977
1978







-
+







 *	Sets the device into blocking or non-blocking mode.
 *
 *----------------------------------------------------------------------
 */

static int
PipeBlockModeProc(
    void *instanceData,	/* Instance data for channel. */
    void *instanceData,		/* Instance data for channel. */
    int mode)			/* TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    PipeInfo *infoPtr = (PipeInfo *) instanceData;

    /*
     * Pipes on Windows can not be switched between blocking and nonblocking,
1992
1993
1994
1995
1996
1997
1998
1999

2000
2001
2002
2003
2004
2005
2006
2003
2004
2005
2006
2007
2008
2009

2010
2011
2012
2013
2014
2015
2016
2017







-
+







 *	Closes the physical channel.
 *
 *----------------------------------------------------------------------
 */

static int
PipeClose2Proc(
    void *instanceData,	/* Pointer to PipeInfo structure. */
    void *instanceData,		/* Pointer to PipeInfo structure. */
    Tcl_Interp *interp,		/* For error reporting. */
    int flags)			/* Flags that indicate which side to close. */
{
    PipeInfo *pipePtr = (PipeInfo *) instanceData;
    Tcl_Channel errChan;
    int errorCode, result;
    PipeInfo *infoPtr, **nextPtrPtr;
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2129
2130
2131
2132
2133
2134
2135

2136
2137
2138
2139
2140
2141
2142







-








	if (pipePtr->errorFile) {
	    WinFile *filePtr = (WinFile *) pipePtr->errorFile;

	    errChan = Tcl_MakeFileChannel((void *)filePtr->handle,
		    TCL_READABLE);
	    Tcl_Free(filePtr);
	    Tcl_SetChannelOption(NULL, errChan, "-profile", "replace");
	} else {
	    errChan = NULL;
	}

	result = TclCleanupChildren(interp, pipePtr->numPids,
		pipePtr->pidPtr, errChan);
    }
2163
2164
2165
2166
2167
2168
2169
2170

2171
2172
2173
2174
2175
2176
2177
2173
2174
2175
2176
2177
2178
2179

2180
2181
2182
2183
2184
2185
2186
2187







-
+







 *	Reads input from the actual channel.
 *
 *----------------------------------------------------------------------
 */

static int
PipeInputProc(
    void *instanceData,	/* Pipe state. */
    void *instanceData,		/* Pipe state. */
    char *buf,			/* Where to store data read. */
    int bufSize,		/* How much space is available in the
				 * buffer? */
    int *errorCode)		/* Where to store error code. */
{
    PipeInfo *infoPtr = (PipeInfo *) instanceData;
    WinFile *filePtr = (WinFile*) infoPtr->readFile;
2257
2258
2259
2260
2261
2262
2263
2264

2265
2266
2267
2268
2269
2270
2271
2267
2268
2269
2270
2271
2272
2273

2274
2275
2276
2277
2278
2279
2280
2281







-
+







 *	Writes output on the actual channel.
 *
 *----------------------------------------------------------------------
 */

static int
PipeOutputProc(
    void *instanceData,	/* Pipe state. */
    void *instanceData,		/* Pipe state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCode)		/* Where to store error code. */
{
    PipeInfo *infoPtr = (PipeInfo *) instanceData;
    WinFile *filePtr = (WinFile*) infoPtr->writeFile;
    DWORD bytesWritten, timeout;
2405
2406
2407
2408
2409
2410
2411
2412

2413
2414
2415
2416
2417
2418
2419
2415
2416
2417
2418
2419
2420
2421

2422
2423
2424
2425
2426
2427
2428
2429







-
+








    mask = 0;
    if ((infoPtr->watchMask & TCL_WRITABLE) &&
	    (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT)) {
	mask = TCL_WRITABLE;
    }

    if ((infoPtr->watchMask & TCL_READABLE) && (WaitForRead(infoPtr,0) >= 0)) {
    if ((infoPtr->watchMask & TCL_READABLE) && (WaitForRead(infoPtr, 0) >= 0)) {
	if (infoPtr->readFlags & PIPE_EOF) {
	    mask = TCL_READABLE;
	} else {
	    mask |= TCL_READABLE;
	}
    }

2439
2440
2441
2442
2443
2444
2445
2446

2447
2448
2449
2450
2451
2452
2453
2449
2450
2451
2452
2453
2454
2455

2456
2457
2458
2459
2460
2461
2462
2463







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
PipeWatchProc(
    void *instanceData,	/* Pipe state. */
    void *instanceData,		/* Pipe state. */
    int mask)			/* What events to watch for, OR-ed combination
				 * of TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    PipeInfo **nextPtrPtr, *ptr;
    PipeInfo *infoPtr = (PipeInfo *) instanceData;
    int oldMask = infoPtr->watchMask;
2501
2502
2503
2504
2505
2506
2507
2508

2509
2510

2511
2512
2513
2514
2515
2516
2517
2511
2512
2513
2514
2515
2516
2517

2518
2519

2520
2521
2522
2523
2524
2525
2526
2527







-
+

-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PipeGetHandleProc(
    void *instanceData,	/* The pipe state. */
    void *instanceData,		/* The pipe state. */
    int direction,		/* TCL_READABLE or TCL_WRITABLE */
    void **handlePtr)	/* Where to store the handle.  */
    void **handlePtr)		/* Where to store the handle.  */
{
    PipeInfo *infoPtr = (PipeInfo *) instanceData;
    WinFile *filePtr;

    if (direction == TCL_READABLE && infoPtr->readFile) {
	filePtr = (WinFile*) infoPtr->readFile;
	*handlePtr = (void *)filePtr->handle;
3216
3217
3218
3219
3220
3221
3222
3223

3224
3225
3226
3227
3228
3229
3230
3226
3227
3228
3229
3230
3231
3232

3233
3234
3235
3236
3237
3238
3239
3240







-
+







    namePtr = (char *) name;
    length = GetTempPathW(MAX_PATH, name);
    if (length == 0) {
	goto gotError;
    }
    namePtr += length * sizeof(WCHAR);
    if (basenameObj) {
	const char *string = TclGetStringFromObj(basenameObj, &length);
	const char *string = Tcl_GetStringFromObj(basenameObj, &length);

	Tcl_DStringInit(&buf);
	Tcl_UtfToWCharDString(string, length, &buf);
	memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf));
	namePtr += Tcl_DStringLength(&buf);
	Tcl_DStringFree(&buf);
    } else {
Changes to win/tclWinPort.h.
















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
-
-







/*
 * Copyright (c) 1994-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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclWinPort.h --
 *
 *	This header file handles porting issues that occur because of
 *	differences between Windows and Unix. It should be the only
 *	file that contains #ifdefs to handle different flavors of OS.
 *
 * Copyright (c) 1994-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.
 */

#ifndef _TCLWINPORT
#define _TCLWINPORT

#if !defined(_WIN64) && !defined(__MINGW_USE_VC2005_COMPAT)
/* See [Bug 3354324]: file mtime sets wrong time */
508
509
510
511
512
513
514
515
516
517
518
519
520






521
522
523
524
525
526
527
519
520
521
522
523
524
525






526
527
528
529
530
531
532
533
534
535
536
537
538







-
-
-
-
-
-
+
+
+
+
+
+







#endif

/*
 * The following defines wrap the system memory allocation routines for
 * use by tclAlloc.c.
 */

#define TclpSysAlloc(size)		((void*)HeapAlloc(GetProcessHeap(), \
					    0, size))
#define TclpSysFree(ptr)		(HeapFree(GetProcessHeap(), \
					    0, (HGLOBAL)ptr))
#define TclpSysRealloc(ptr, size)	((void*)HeapReAlloc(GetProcessHeap(), \
					    0, (LPVOID)ptr, size))
#define TclpSysAlloc(size) \
	((void*)HeapAlloc(GetProcessHeap(), 0, size))
#define TclpSysFree(ptr) \
	(HeapFree(GetProcessHeap(), 0, (HGLOBAL)ptr))
#define TclpSysRealloc(ptr, size) \
	((void*)HeapReAlloc(GetProcessHeap(), 0, (LPVOID)ptr, size))

/* This type is not defined in the Windows headers */
#define socklen_t       int

/*
 * The following macros have trivial definitions, allowing generic code to
 * address platform-specific issues.
Changes to win/tclWinReg.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14

















15
16
17
18
19
20
21
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

-
-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclWinReg.c --
 *
 *	This file contains the implementation of the "registry" Tcl built-in
 *	command. This command is built as a dynamically loadable extension in
 *	a separate DLL.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclWinReg.c --
 *
 *	This file contains the implementation of the "registry" Tcl built-in
 *	command. This command is built as a dynamically loadable extension in
 *	a separate DLL.
 */

#undef STATIC_BUILD
#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include "tclInt.h"
#ifdef _MSC_VER
#   pragma comment (lib, "advapi32.lib")
85
86
87
88
89
90
91
92
93




94
95
96
97
98
99
100
96
97
98
99
100
101
102


103
104
105
106
107
108
109
110
111
112
113







-
-
+
+
+
+







    "dword_big_endian", "link", "multi_sz", "resource_list", NULL
};

static DWORD lastType = REG_RESOURCE_LIST;

#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7)
# if TCL_UTF_MAX > 3
#   define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c)
#   define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c)
#   define Tcl_WCharToUtfDString(a, b, c) \
	Tcl_WinTCharToUtf((TCHAR *)(a), (b) * sizeof(WCHAR), c)
#   define Tcl_UtfToWCharDString(a, b, c) \
	(WCHAR *)Tcl_WinUtfToTChar(a, b, c)
# else
#   define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString
#   define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString
# endif
#ifndef Tcl_Size
#   define Tcl_Size int
#endif
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
155
156
157
158
159
160
161





162
163
164
165
166
167
168







-
-
-
-
-







			    Tcl_Obj *typeObj, REGSAM mode);

#ifdef __cplusplus
extern "C" {
#endif
DLLEXPORT int		Registry_Init(Tcl_Interp *interp);
DLLEXPORT int		Registry_Unload(Tcl_Interp *interp, int flags);
#if TCL_MAJOR_VERSION < 9
/* With those additional entries, "load tclregistry13.dll" works without 3th argument */
DLLEXPORT int		Tclregistry_Init(Tcl_Interp *interp);
DLLEXPORT int		Tclregistry_Unload(Tcl_Interp *interp, int flags);
#endif
#ifdef __cplusplus
}
#endif

/*
 *----------------------------------------------------------------------
 *
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
190
191
192
193
194
195
196








197
198
199
200
201
202
203







-
-
-
-
-
-
-
-







    }

    cmd = Tcl_CreateObjCommand2(interp, "registry", RegistryObjCmd,
	    interp, DeleteCmd);
    Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd);
    return Tcl_PkgProvideEx(interp, "registry", "1.3.7", NULL);
}
#if TCL_MAJOR_VERSION < 9
int
Tclregistry_Init(
    Tcl_Interp *interp)
{
    return Registry_Init(interp);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Registry_Unload --
 *
 *	This function removes the registry command.
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
236
237
238
239
240
241
242









243
244
245
246
247
248
249







-
-
-
-
-
-
-
-
-







    cmd = (Tcl_Command)Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL);
    if (cmd != NULL) {
	Tcl_DeleteCommandFromToken(interp, cmd);
    }

    return TCL_OK;
}
#if TCL_MAJOR_VERSION < 9
int
Tclregistry_Unload(
    Tcl_Interp *interp,
    int flags)
{
    return Registry_Unload(interp, flags);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * DeleteCmd --
 *
 *	Cleanup the interp command token so that unloading doesn't try to
290
291
292
293
294
295
296
297

298
299

300
301
302
303
304
305
306
281
282
283
284
285
286
287

288
289

290
291
292
293
294
295
296
297







-
+

-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
RegistryObjCmd(
    void *dummy,	/* Not used. */
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Size objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    Tcl_Size n = 1, argc;
    int index;
    REGSAM mode = 0;
    const char *errString = NULL;

932
933
934
935
936
937
938
939

940
941
942
943
944
945
946
923
924
925
926
927
928
929

930
931
932
933
934
935
936
937







-
+







    /*
     * Enumerate the values under the given subkey until we get an error,
     * indicating the end of the list. Note that we need to reset size after
     * each iteration because RegEnumValue smashes the old value.
     */

    size = MAX_KEY_LENGTH;
    while (RegEnumValueW(key,index, (WCHAR *)Tcl_DStringValue(&buffer),
    while (RegEnumValueW(key, index, (WCHAR *)Tcl_DStringValue(&buffer),
	    &size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) {
	Tcl_DStringInit(&ds);
	Tcl_WCharToUtfDString((const WCHAR *)Tcl_DStringValue(&buffer), size, &ds);
	name = Tcl_DStringValue(&ds);
	if (!pattern || Tcl_StringMatch(name, pattern)) {
	    result = Tcl_ListObjAppendElement(interp, resultPtr,
		    Tcl_NewStringObj(name, Tcl_DStringLength(&ds)));
1426
1427
1428
1429
1430
1431
1432
1433

1434
1435
1436
1437
1438
1439
1440
1417
1418
1419
1420
1421
1422
1423

1424
1425
1426
1427
1428
1429
1430
1431







-
+







 *
 *----------------------------------------------------------------------
 */

static int
BroadcastValue(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Size objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    LRESULT result;
    DWORD_PTR sendResult;
    int timeout = 3000;
    Tcl_Size len;
    const char *str;
Changes to win/tclWinSerial.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
















15
16
17
18
19
20
21
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

-
-
-
-
-








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclWinSerial.c --
 *
 *	This file implements the Windows-specific serial port functions, and
 *	the "serial" channel driver.
 *
 * Copyright © 1999 Scriptics Corp.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * Serial functionality implemented by Rolf.Schroedter@dlr.de
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclWinSerial.c --
 *
 *	This file implements the Windows-specific serial port functions, and
 *	the "serial" channel driver.
 */

#include "tclWinInt.h"

/*
 * The following variable is used to tell whether this module has been
 * initialized.
 */

850
851
852
853
854
855
856
857

858
859
860
861
862
863
864
861
862
863
864
865
866
867

868
869
870
871
872
873
874
875







-
+







 *	Reads input from the actual channel.
 *
 *----------------------------------------------------------------------
 */

static int
SerialInputProc(
    void *instanceData,	/* Serial state. */
    void *instanceData,		/* Serial state. */
    char *buf,			/* Where to store data read. */
    int bufSize,		/* How much space is available in the
				 * buffer? */
    int *errorCode)		/* Where to store error code. */
{
    SerialInfo *infoPtr = (SerialInfo *) instanceData;
    DWORD bytesRead = 0;
957
958
959
960
961
962
963
964

965
966
967
968
969
970
971
968
969
970
971
972
973
974

975
976
977
978
979
980
981
982







-
+







 *	Writes output on the actual channel.
 *
 *----------------------------------------------------------------------
 */

static int
SerialOutputProc(
    void *instanceData,	/* Serial state. */
    void *instanceData,		/* Serial state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCode)		/* Where to store error code. */
{
    SerialInfo *infoPtr = (SerialInfo *) instanceData;
    DWORD bytesWritten, timeout;

1187
1188
1189
1190
1191
1192
1193
1194

1195
1196
1197
1198
1199
1200
1201
1198
1199
1200
1201
1202
1203
1204

1205
1206
1207
1208
1209
1210
1211
1212







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
SerialWatchProc(
    void *instanceData,	/* Serial state. */
    void *instanceData,		/* Serial state. */
    int mask)			/* What events to watch for, OR-ed combination
				 * of TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    SerialInfo **nextPtrPtr, *ptr;
    SerialInfo *infoPtr = (SerialInfo *) instanceData;
    int oldMask = infoPtr->watchMask;
1244
1245
1246
1247
1248
1249
1250
1251

1252
1253

1254
1255
1256
1257
1258
1259
1260
1255
1256
1257
1258
1259
1260
1261

1262
1263

1264
1265
1266
1267
1268
1269
1270
1271







-
+

-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
SerialGetHandleProc(
    void *instanceData,	/* The serial state. */
    void *instanceData,		/* The serial state. */
    TCL_UNUSED(int) /*direction*/,
    void **handlePtr)	/* Where to store the handle. */
    void **handlePtr)		/* Where to store the handle. */
{
    SerialInfo *infoPtr = (SerialInfo *) instanceData;

    *handlePtr = (void *)infoPtr->handle;
    return TCL_OK;
}

1606
1607
1608
1609
1610
1611
1612
1613

1614
1615
1616
1617
1618
1619
1620
1617
1618
1619
1620
1621
1622
1623

1624
1625
1626
1627
1628
1629
1630
1631







-
+







 *	May modify an option on a device.
 *
 *----------------------------------------------------------------------
 */

static int
SerialSetOptionProc(
    void *instanceData,	/* File state. */
    void *instanceData,		/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Which option to set? */
    const char *value)		/* New value for option. */
{
    SerialInfo *infoPtr;
    DCB dcb;
    BOOL result, flag;
2030
2031
2032
2033
2034
2035
2036
2037

2038
2039
2040
2041
2042
2043
2044
2041
2042
2043
2044
2045
2046
2047

2048
2049
2050
2051
2052
2053
2054
2055







-
+







 *	reused at any time subsequent to the call.
 *
 *----------------------------------------------------------------------
 */

static int
SerialGetOptionProc(
    void *instanceData,	/* File state. */
    void *instanceData,		/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Option to get. */
    Tcl_DString *dsPtr)		/* Where to store value(s). */
{
    SerialInfo *infoPtr;
    DCB dcb;
    size_t len;
Changes to win/tclWinSock.c.
1
2
3
4
5
6
7
8
9
















10
11
12
13
14
15
16
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

-
-
-
-




+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclWinSock.c --
 *
 *	This file contains Windows-specific socket related code.
 *
 * Copyright © 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.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 *
 * tclWinSock.c --
 *
 *	This file contains Windows-specific socket related code.
 *
 * -----------------------------------------------------------------------
 * The order and naming of functions in this file should minimize
 * the file diff to tclUnixSock.c.
 * -----------------------------------------------------------------------
 *
 * General information on how this module works.
1284
1285
1286
1287
1288
1289
1290
1291

1292
1293
1294
1295
1296
1297
1298
1296
1297
1298
1299
1300
1301
1302

1303
1304
1305
1306
1307
1308
1309
1310







-
+







    TcpState *statePtr = (TcpState *)instanceData;
    char host[NI_MAXHOST], port[NI_MAXSERV];
    SOCKET sock;
    size_t len = 0;
    int reverseDNS = 0;
#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS"
#define HAVE_OPTION(option) \
	((len > 1) && (optionName[1] == option[1]) && \
	((len > 1) && (optionName[1] == option[1]) &&			\
	    (strncmp(optionName, option, len) == 0))

    /*
     * Go one step in async connect
     *
     * If any error is thrown save it as background error to report eventually
     * below.
2650
2651
2652
2653
2654
2655
2656
2657

2658
2659
2660
2661
2662
2663
2664
2662
2663
2664
2665
2666
2667
2668

2669
2670
2671
2672
2673
2674
2675
2676







-
+







    if (GOT_BITS(statePtr->readyEvents, FD_CONNECT)) {
	if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
	    /*
	     * Do one step and save eventual connect error
	     */

	    SetEvent(tsdPtr->socketListLock);
	    WaitForConnect(statePtr,NULL);
	    WaitForConnect(statePtr, NULL);
	} else {
	    /*
	     * No async connect reenter pending. Just clear event.
	     */

	    CLEAR_BITS(statePtr->readyEvents, FD_CONNECT);
	    SetEvent(tsdPtr->socketListLock);
Changes to win/tclWinTest.c.
1
2
3
4
5
6
7
8
9
10
















11
12
13
14
15
16
17
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

-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclWinTest.c --
 *
 *	Contains commands for platform specific tests on Windows.
 *
 * Copyright © 1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclWinTest.c --
 *
 *	Contains commands for platform specific tests on Windows.
 */


#undef BUILD_tcl
#undef STATIC_BUILD
#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include "tclInt.h"
Changes to win/tclWinThrd.c.
1
2
3
4
5
6
7
8
9
10
11
12
13















14
15
16
17
18
19
20
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

-
-
-
-








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclWinThread.c --
 *
 *	This file implements the Windows-specific thread operations.
 *
 * Copyright © 1998 Sun Microsystems, Inc.
 * Copyright © 1999 Scriptics Corporation
 * Copyright © 2008 George Peter Staplin
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclWinThread.c --
 *
 *	This file implements the Windows-specific thread operations.
 */

#include "tclWinInt.h"

/* Workaround for mingw versions which don't provide this in float.h */
#ifndef _MCW_EM
#   define	_MCW_EM		0x0008001F	/* Error masks */
#   define	_MCW_RC		0x00000300	/* Rounding */
#   define	_MCW_PC		0x00030000	/* Precision */
214
215
216
217
218
219
220
221
222


223
224
225
226
227
228
229
225
226
227
228
229
230
231


232
233
234
235
236
237
238
239
240







-
-
+
+







    winThreadPtr = (WinThread *)Tcl_Alloc(sizeof(WinThread));
    winThreadPtr->lpStartAddress = (LPTHREAD_START_ROUTINE) proc;
    winThreadPtr->lpParameter = clientData;
    winThreadPtr->fpControl = _controlfp(0, 0);

    EnterCriticalSection(&joinLock);

    *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and
                 * on WIN64 sizeof void* != sizeof unsigned */
    *idPtr = 0;		/* must initialize as Tcl_Thread is a pointer and
			 * on WIN64 sizeof void* != sizeof unsigned */

#if defined(_MSC_VER) || defined(__MSVCRT__)
    tHandle = (HANDLE) _beginthreadex(NULL, (unsigned)stackSize,
	    (Tcl_ThreadCreateProc*) TclWinThreadStart, winThreadPtr,
	    0, (unsigned *)idPtr);
#else
    tHandle = CreateThread(NULL, (DWORD)stackSize,
Changes to win/tclWinTime.c.
1
2
3
4
5
6
7
8
9
10
11
12
















13
14
15
16
17
18
19
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

-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclWinTime.c --
 *
 *	Contains Windows specific versions of Tcl functions that obtain time
 *	values from the operating system.
 *
 * Copyright © 1995-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * You may distribute and/or modify this program under the terms of the GNU
 * Affero General Public License as published by the Free Software Foundation,
 * either version 3 of the License, or (at your option) any later version.

 * See the file "COPYING" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * tclWinTime.c --
 *
 *	Contains Windows specific versions of Tcl functions that obtain time
 *	values from the operating system.
 */

#include "tclInt.h"

/*
 * Number of samples over which to estimate the performance counter.
 */

#define SAMPLES		64
Deleted win/x86_64-w64-mingw32-nmakehlp.exe.

cannot compute difference between binary files