Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch unchained Through [4b22e01905] Excluding Merge-Ins
This is equivalent to a diff from 01e0841329 to 4b22e01905
|
2024-08-25
| ||
| 05:19 | Merge [3dd21c516d66b836]: Spacing. check-in: 33c93d47f8 user: pooryorick tags: unchained, INCOMPATIBLE_LICENSE | |
| 05:18 | Merge [01e084132926fc0b]: GITHUB upload-artifact @3 -> @4. check-in: 4b22e01905 user: pooryorick tags: unchained, INCOMPATIBLE_LICENSE | |
| 05:17 | Merge [b976fb5ce277b6c5]: test suite debugging. check-in: c80417a2cd user: pooryorick tags: unchained, INCOMPATIBLE_LICENSE | |
|
2023-12-20
| ||
| 19:31 | Spacing check-in: 3dd21c516d user: jan.nijtmans tags: trunk, main | |
|
2023-12-19
| ||
| 10:00 | Merge 8.7 check-in: 01e0841329 user: jan.nijtmans tags: trunk, main | |
| 08:33 | GITHUB upload-artifact @3 -> @4 check-in: 6d9646d253 user: jan.nijtmans tags: core-8-branch | |
|
2023-12-18
| ||
| 14:59 | merge-mark check-in: 22662bd69a user: dgp tags: trunk, main | |
Changes to .github/workflows/linux-build.yml.
| ︙ | ︙ | |||
12 13 14 15 16 17 18 |
jobs:
gcc:
runs-on: ubuntu-22.04
strategy:
matrix:
cfgopt:
- ""
| < | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 |
jobs:
gcc:
runs-on: ubuntu-22.04
strategy:
matrix:
cfgopt:
- ""
- "--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 |
run:
shell: msys2 {0}
working-directory: win
strategy:
matrix:
cfgopt:
- ""
| < | 62 63 64 65 66 67 68 69 70 71 72 73 74 75 |
run:
shell: msys2 {0}
working-directory: win
strategy:
matrix:
cfgopt:
- ""
- "--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 .travis.yml.
| ︙ | ︙ | |||
22 23 24 25 26 27 28 |
- BUILD_DIR=unix
- name: "Linux/GCC/Shared: NO_DEPRECATED"
os: linux
dist: focal
compiler: gcc
env:
- BUILD_DIR=unix
| < | 22 23 24 25 26 27 28 29 30 31 32 33 34 35 |
- BUILD_DIR=unix
- name: "Linux/GCC/Shared: NO_DEPRECATED"
os: linux
dist: focal
compiler: gcc
env:
- BUILD_DIR=unix
- name: "Linux/GCC/Static"
os: linux
dist: focal
compiler: gcc
env:
- CFGOPT="--disable-shared"
- BUILD_DIR=unix
|
| ︙ | ︙ | |||
290 291 292 293 294 295 296 |
env:
- BUILD_DIR=win
- CFGOPT="--enable-64bit"
before_install: &makepreinst
- touch generic/tclStubInit.c generic/tclOOStubInit.c generic/tclOOScript.h
- choco install -y make zip
- cd ${BUILD_DIR}
| < < < < < < < | 289 290 291 292 293 294 295 296 297 298 299 300 301 302 |
env:
- BUILD_DIR=win
- CFGOPT="--enable-64bit"
before_install: &makepreinst
- touch generic/tclStubInit.c generic/tclOOStubInit.c generic/tclOOScript.h
- choco install -y make zip
- cd ${BUILD_DIR}
- name: "Windows/GCC/Static"
os: windows
compiler: gcc
env:
- BUILD_DIR=win
- CFGOPT="--enable-64bit --disable-shared"
before_install: *makepreinst
|
| ︙ | ︙ | |||
325 326 327 328 329 330 331 |
# Test on Windows with GCC native (32-bit)
- name: "Windows/GCC-x86/Shared"
os: windows
compiler: gcc
env:
- BUILD_DIR=win
before_install: *makepreinst
| < < < < < < < | 317 318 319 320 321 322 323 324 325 326 327 328 329 330 |
# Test on Windows with GCC native (32-bit)
- name: "Windows/GCC-x86/Shared"
os: windows
compiler: gcc
env:
- BUILD_DIR=win
before_install: *makepreinst
- name: "Windows/GCC-x86/Static"
os: windows
compiler: gcc
env:
- BUILD_DIR=win
- CFGOPT="--disable-shared"
before_install: *makepreinst
|
| ︙ | ︙ |
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 changes.
| ︙ | ︙ | |||
8243 8244 8245 8246 8247 8248 8249 |
2013-05-29 (bug fix)[3614102] [apply {{} {list [if 1]}}] stack woes (porter)
2013-06-03 Restored lost performance appending to long strings (elby,porter)
2013-06-05 (bug fix)[2835313] [while 1 {foo [continue]}] crash (fellows)
| | | 8243 8244 8245 8246 8247 8248 8249 8250 8251 8252 8253 8254 8255 8256 8257 |
2013-05-29 (bug fix)[3614102] [apply {{} {list [if 1]}}] stack woes (porter)
2013-06-03 Restored lost performance appending to long strings (elby,porter)
2013-06-05 (bug fix)[2835313] [while 1 {foo [continue]}] crash (fellows)
2013-06-17 (bug fix)[a876646] [:cntrl:] includes \x00 to \x1f (nijtmans)
2013-06-27 (bug fix)[983509] missing encodings for config values (nijtmans)
2013-06-27 (bug fix)[34538b] apply DST in 2099 (lang)
2013-07-02 (bug fix)[32afa6] corrected dirent64 check (griffin)
|
| ︙ | ︙ |
Changes to compat/dlfcn.h.
1 | /* | < < < < < < > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 | /* * 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 | * 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. */ /* * 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. | > > > > > > > > > | 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 | * 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. */ /* * 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. | > > > > > > > > > | 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 | /* | < < < < < > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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 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 | /* * 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. */ #include <errno.h> #include <fcntl.h> #include <stdlib.h> #include <unistd.h> #include <string.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 | /* * 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 | /* * 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. */ #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. | > > > > > > > > > | 1 2 3 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 | /* * 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. */ #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. | > > > > > > > > > | 1 2 3 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 | /* * 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. */ #include "tclPort.h" #ifndef pid_t #define pid_t int #endif | > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | /* * 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 | '\" '\" 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. '\" .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 | > > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > > | 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 | '\" '\" 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. '\" .TH Tcl_AppInit 3 7.0 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_AppInit \- perform application-specific initialization .SH SYNOPSIS | > > > > > > > | 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.
| ︙ | ︙ | |||
101 102 103 104 105 106 107 | 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. | < < < | 101 102 103 104 105 106 107 108 109 110 111 112 113 114 | 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. 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 |
.PP
.CS
.ta 1.5i
# Encoding file: iso2022-jp, escape-driven
E
init {}
final {}
| | | | | | | | | | 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
.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
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 | 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. | | | 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. 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.
| ︙ | ︙ | |||
264 265 266 267 268 269 270 | 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 | | | | | | | | | > | < | | | | 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 | 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 0 for compatability of ObjType definitions prior to version 9.0. Specifics about versions will be described further in the sections below. .SH "INTERFACES" .PP Additional fields in Tcl_ObjType structure expose interfaces for data types that a value may represent. For example, if the list interface functions are implemented for a Tcl_ObjType, then Tcl's list procedures use that interface to operate on the value as a list. It is not necessary to implement all functions for an interface. When a needed function is NULL, a procedure using the interface can attempt to convert the internal Tcl_ObjType to one that it can work with. For example, a procedure like \fBlndex\fR might attempt to convert the internal type of a Tcl_Obj to \fBtclListType\fR. .SS "SCALAR VALUE TYPES" .PP For a custom value type that is scalar or atomic in nature, i.e., not a divisible collection, version 0 is recommended. In this case, List commands treat the scalar value as if it where a list of length 1, and do 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 to be converted to a list. |
| ︙ | ︙ |
Changes to doc/Tcl.n.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 | '\" '\" 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. '\" .TH Tcl n "8.6" Tcl "Tcl Built-In Commands" .so man.macros .BS .SH NAME Tcl \- Tool Command Language .SH SYNOPSIS | > > > > > > | 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) 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 |
| ︙ | ︙ |
Changes to doc/abstract.n.
1 2 3 4 5 6 7 8 9 10 11 12 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 |
| ︙ | ︙ | |||
237 238 239 240 241 242 243 | .PP which returns a binary string equivalent to: .PP .CS \fB\e254\fR .CE .PP | | | 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 | .PP which returns a binary string equivalent to: .PP .CS \fB\e254\fR .CE .PP (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 |
| ︙ | ︙ | |||
295 296 297 298 299 300 301 | .CS \fBbinary format\fR B5B* 11100 111000011010 .CE .PP will return a binary string equivalent to: .PP .CS | | | 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 | .CS \fBbinary format\fR B5B* 11100 111000011010 .CE .PP will return a binary string equivalent to: .PP .CS \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 . |
| ︙ | ︙ | |||
322 323 324 325 326 327 328 | .CS \fBbinary format\fR H3H*H2 ab DEF 987 .CE .PP will return a binary string equivalent to: .PP .CS | | | | 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 | .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 .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 .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 |
| ︙ | ︙ | |||
359 360 361 362 363 364 365 |
.CS
\fBbinary format\fR c3cc* {3 -3 128 1} 260 {2 5}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
| | | 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 |
.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
.CE
.PP
whereas:
.PP
.CS
\fBbinary format\fR c {2 5}
.CE
|
| ︙ | ︙ | |||
385 386 387 388 389 390 391 |
.CS
\fBbinary format\fR s3 {3 -3 258 1}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
| | | | 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 |
.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
.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
.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
|
| ︙ | ︙ | |||
425 426 427 428 429 430 431 |
.CS
\fBbinary format\fR i3 {3 -3 65536 1}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
| | | | 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 |
.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
.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
.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.
|
| ︙ | ︙ | |||
506 507 508 509 510 511 512 |
.CS
\fBbinary format\fR f2 {1.6 3.4}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
| | | 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 |
.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
.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
|
| ︙ | ︙ | |||
532 533 534 535 536 537 538 |
.CS
\fBbinary format\fR d1 {1.6}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
| | | 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 |
.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
.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
|
| ︙ | ︙ | |||
784 785 786 787 788 789 790 | .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 | | | 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 | .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 .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 |
| ︙ | ︙ | |||
835 836 837 838 839 840 841 | .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 | | | | 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 | .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 .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 .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 |
| ︙ | ︙ | |||
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 32-bit integer will be scanned. For example, .RS .PP .CS | | | | 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 | .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 \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 \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 |
| ︙ | ︙ | |||
916 917 918 919 920 921 922 | .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 | | | | 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 | .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 \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 \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 |
| ︙ | ︙ | |||
962 963 964 965 966 967 968 | 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 | | | 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 | 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 .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 |
| ︙ | ︙ | |||
986 987 988 989 990 991 992 | 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 | | | 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 | 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 .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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. .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 \- Reads, writes and manipulates channels. .SH SYNOPSIS | > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | '\" '\" 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. '\" '\" You may distribute and/or modify this program under the terms of the GNU '\" Affero General Public License as published by the Free Software 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 \- Reads, writes and manipulates channels. .SH SYNOPSIS |
| ︙ | ︙ | |||
148 149 150 151 152 153 154 | \fB\-eofchar\fR \fIchar\fR . \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. The default value is the empty string. The acceptable range is \ex01 - | | | 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 | \fB\-eofchar\fR \fIchar\fR . \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. The default value is the empty string. The acceptable range is \ex01 - \ex7f. A value outside this range results in an error. .VS "TCL8.7 TIP656" .TP \fB\-profile\fR \fIprofile\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 |
| ︙ | ︙ |
Changes to doc/class.n.
1 2 3 4 5 6 7 8 9 10 11 12 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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/close.n.
1 2 3 4 5 6 7 8 9 10 11 12 13 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | '\" '\" 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. '\" '\" You may distribute and/or modify this program under the terms of the GNU '\" Affero General Public License as published by the Free Software 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 \- define and configure classes and objects | > > > > > > | 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 \- define and configure classes and objects |
| ︙ | ︙ |
Changes to doc/dict.n.
1 2 3 4 5 6 7 8 9 10 11 12 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .TH encoding n "8.1" Tcl "Tcl Built-In Commands" .so man.macros .BS .SH NAME encoding \- Work with encodings .SH SYNOPSIS \fBencoding \fIoperation\fR ?\fIarg arg ...\fR? .BE .SH INTRODUCTION .PP 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 | > > > > > > | | 1 2 3 4 5 6 7 8 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) 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 \- Work with encodings .SH SYNOPSIS \fBencoding \fIoperation\fR ?\fIarg arg ...\fR? .BE .SH INTRODUCTION .PP 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. iso8859-1 an encoding for a subset of Unicode in which each byte is a Unicode value of 255 or less. Thus, 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 |
| ︙ | ︙ |
Changes to doc/eof.n.
1 2 3 4 5 6 7 8 9 10 11 12 13 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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, tcl_findLibrary, parray, tcl_endOfWord, tcl_startOfNextWord, tcl_startOfPreviousWord, tcl_wordBreakAfter, tcl_wordBreakBefore \- standard library of Tcl procedures .SH SYNOPSIS | > > > > > > | 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, tcl_findLibrary, parray, tcl_endOfWord, tcl_startOfNextWord, tcl_startOfPreviousWord, tcl_wordBreakAfter, tcl_wordBreakBefore \- 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .so man.macros .ie '\w'o''\w'\C'^o''' .ds qo \C'^o' .el .ds qo u .TH re_syntax n "8.1" Tcl "Tcl Built-In Commands" .BS .SH NAME | > > > > > > | 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 .ie '\w'o''\w'\C'^o''' .ds qo \C'^o' .el .ds qo u .TH re_syntax n "8.1" Tcl "Tcl Built-In Commands" .BS .SH NAME |
| ︙ | ︙ |
Changes to doc/read.n.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 | '\" '\" 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. '\" .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 .SH SYNOPSIS | > > > > > > | 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. '\" .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 .SH SYNOPSIS |
| ︙ | ︙ | |||
58 59 60 61 62 63 64 | the data. An encoding error is reported by the POSIX error code \fBEILSEQ\fR. .PP In blocking mode, the error is directly thrown, even, if there is a leading decodable data portion. The file pointer is advanced just before the encoding error. An eventual well decoded data chunk before the encoding error is returned | | | | | | 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 |
the data.
An encoding error is reported by the POSIX error code \fBEILSEQ\fR.
.PP
In blocking mode, the error is directly thrown, even, if there is a
leading decodable data portion.
The file pointer is advanced just before the encoding error.
An eventual well decoded data chunk before the encoding error is returned
in the error option dictionary key \fB-result read\fR.
The value of the key contains the empty string, if the error arises at the
first data position.
.PP
In non blocking mode, first, any data without encoding error is returned
(without error state).
In the next call, no data is returned and the \fBEILSEQ\fR error state is set.
The key \fB-result read\fR is not present.
.PP
Here is an example with an encoding error in UTF-8 encoding, which is then
introspected by a switch to the binary encoding. The test file contains a not
continued multi-byte sequence at position 1 (\fBA \\xC3 B\fR):
.PP
File creation for examples
.
.CS
% set f [open test_A_195_B.txt wb]; puts -nonewline $f A\\xC3B; close $f
.CE
Blocking example
.
.CS
% set f [open test_A_195_B.txt r]
file35a65a0
% fconfigure $f -encoding utf-8 -profile strict -blocking 1
% catch {read $f} e d
1
% set d
-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
% tell $f
1
% fconfigure $f -encoding binary -profile strict
% read $f
ÃB
% close $f
.CE
The already decoded data "A" is returned in the error options 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 \fBread\fR command.
.PP
Non blocking example
.
.CS
% set f [open test_A_195_B.txt r]
|
| ︙ | ︙ |
Changes to doc/refchan.n.
1 2 3 4 5 6 7 8 9 10 11 12 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" Copyright (c) 2005 Sergey Brester aka sebres. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH timerate n "" Tcl "Tcl Built-In Commands" .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME timerate \- Calibrated performance measurements of script execution time | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | '\" '\" 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. '\" .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 | > > > > > > | 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 | /* | < < < | 1 2 3 4 5 6 7 8 | /* * 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 | * 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. */ #define CISERR() VISERR(cm->v) #define CERR(e) VERR(cm->v, (e)) /* - initcm - set up new colormap ^ static void initcm(struct vars *, struct colormap *); */ | > > > > > > > > > > > > > > > | 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 | /* | < < < | 1 2 3 4 5 6 7 8 | /* * 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 | * 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. */ /* * Notes: * Only (selected) functions in _this_ file should treat chr* as non-constant. */ /* | > > > > > > > > > > > > > > > | 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 | /* | < < < | 1 2 3 4 5 6 7 8 | /* * 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 | * 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. */ /* 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) \ | > > > > > > > > > > > > > > > | 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 |
/*
* 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.
*/
/* ASCII character-name table */
static const struct cname {
const char *name;
const char code;
} cnames[] = {
| > > > > > > > > > | 1 2 3 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 | * 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. */ #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 | > > > > > > > > > | 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 | * 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. * */ #include "regguts.h" /* * forward declarations, up here so forward datatypes etc. are defined early */ /* =====^!^===== begin forwards =====^!^===== */ | > > > > > > > > > | 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 | * 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. */ /* * Headers if any. */ #include "regex.h" | > > > > > > > > > | 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 | * 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. * */ /* - longest - longest-preferred matching engine ^ static chr *longest(struct vars *, struct dfa *, chr *, chr *, int *); */ static chr * /* endpoint, or NULL */ longest( | > > > > > > > > > | 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 | * 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. * */ #include "regguts.h" /* * Unknown-error explanation. */ | > > > > > > > > > | 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 | #ifndef _REGEX_H_ #define _REGEX_H_ /* never again */ #include "tclInt.h" /* | < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 | #ifndef _REGEX_H_ #define _REGEX_H_ /* never again */ #include "tclInt.h" /* * 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 | * 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. * * * 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 | > > > > > > > > > > > > | 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 | * 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. */ #include "regguts.h" /* * Lazy-DFA representation. */ | > > > > > > > > > | 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 | /* | < < | 1 2 3 4 5 6 7 8 | /* * 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 | * * 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. */ #include "regguts.h" /* - regfree - free an RE (generic function, punts to RE-specific function) * * Ignoring invocation with NULL is a convenience. | > > > > > > > > > > > > > > | 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 | /* | < < < < < | 1 2 3 4 5 6 7 8 | /* * 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 | * 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. */ #include "regguts.h" /* - regcomp - compile regular expression */ int | > > > > > > > > > > > > > > > > > | 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 | /* | < < | 1 2 3 4 5 6 7 8 | /* * 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 | * 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. */ /* * 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" | > > > > > > > > > > > > > > | 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 |
# 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.
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
| > > > > > > > | < | > | 8 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. In order to
# 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,
|
| ︙ | ︙ | |||
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 |
}
# ----- BASELINE -- FOR -- 8.7.0 / 9.0.0 ----- #
declare 688 {
void TclUnusedStubEntry(void)
}
##############################################################################
# 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,
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | 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 |
}
# ----- BASELINE -- FOR -- 8.7.0 / 9.0.0 ----- #
declare 688 {
void TclUnusedStubEntry(void)
}
declare 689 {
Tcl_ObjInterface *Tcl_NewObjInterface(void)
}
declare 690 {
Tcl_ObjType *Tcl_NewObjType(void)
}
declare 691 {
int Tcl_ObjInterfaceSetVersion(Tcl_ObjInterface *oiPtr ,int version)
}
declare 692 {
int Tcl_ObjTypeSetFreeInternalRepProc(Tcl_ObjType *otPtr
, Tcl_FreeInternalRepProc *freeIntRepProc)
}
declare 693 {
int Tcl_ObjTypeSetDupInternalRepProc(Tcl_ObjType *otPtr
,Tcl_DupInternalRepProc *dupIntRepProc)
}
declare 694 {
int Tcl_ObjTypeSetUpdateStringProc(Tcl_ObjType *otPtr
,Tcl_UpdateStringProc *updateStringProc)
}
declare 695 {
int Tcl_ObjTypeSetSetFromAnyProc(Tcl_ObjType *otPtr
,Tcl_SetFromAnyProc *setFromAnyProc)
}
declare 696 {
int Tcl_ObjTypeSetVersion(Tcl_ObjType *otPtr ,int version)
}
declare 697 {
int Tcl_ObjInterfaceSetFnListAll(Tcl_ObjInterface *oiPtr
, Tcl_ObjInterfaceListAllProc *fnPtr)
}
declare 698 {
int Tcl_ObjInterfaceSetFnListAppend(Tcl_ObjInterface *oiPtr
, Tcl_ObjInterfaceListAppendProc *fnPtr)
}
declare 699 {
int Tcl_ObjInterfaceSetFnListAppendList(Tcl_ObjInterface *oiPtr
, Tcl_ObjInterfaceListAppendlistProc fnPtr)
}
declare 700 {
int Tcl_ObjInterfaceSetFnListIndex(Tcl_ObjInterface *oiPtr
,Tcl_ObjInterfaceListIndexProc fnPtr)
}
declare 701 {
int Tcl_ObjInterfaceSetFnListIndexEnd(Tcl_ObjInterface *oiPtr
, Tcl_ObjInterfaceListIndexEndProc fnPtr)
}
declare 702 {
int Tcl_ObjInterfaceSetFnListIsSorted(Tcl_ObjInterface *oiPtr
, Tcl_ObjInterfaceListIsSortedProc fnPtr)
}
declare 703 {
int Tcl_ObjInterfaceSetFnListLength(Tcl_ObjInterface *oiPtr
,Tcl_ObjInterfaceListlengthProc fnPtr)
}
declare 704 {
int Tcl_ObjInterfaceSetFnListRange(Tcl_ObjInterface *oiPtr
,Tcl_ObjInterfaceListRangeProc fnPtr)
}
declare 705 {
int Tcl_ObjInterfaceSetFnListRangeEnd(Tcl_ObjInterface *oiPtr
,Tcl_ObjInterfaceListRangeEndProc fnPtr)
}
declare 706 {
int Tcl_ObjInterfaceSetFnListReplace(Tcl_ObjInterface *oiPtr
,Tcl_ObjInterfaceListReplaceProc fnPtr)
}
declare 707 {
int Tcl_ObjInterfaceSetFnListReplaceList(Tcl_ObjInterface *oiPtr
,Tcl_ObjInterfaceListReplaceListProc fnPtr)
}
declare 708 {
int Tcl_ObjInterfaceSetFnListReverse(Tcl_ObjInterface *objInterfacePtr
,Tcl_ObjInterfaceListReverseProc fnPtr)
}
declare 709 {
int Tcl_ObjInterfaceSetFnListSet(Tcl_ObjInterface *oiPtr
,Tcl_ObjInterfaceListSetProc fnPtr)
}
declare 710 {
int Tcl_ObjInterfaceSetFnListSetDeep(Tcl_ObjInterface *oiPtr
,Tcl_ObjInterfaceListSetDeepProc fnPtr)
}
declare 711 {
int Tcl_ObjInterfaceSetFnStringIndex(Tcl_ObjInterface *oiPtr
,Tcl_ObjInterfaceStringIndexProc fnPtr)
}
declare 712 {
int Tcl_ObjInterfaceSetFnStringIndexEnd(Tcl_ObjInterface *oiPtr
,Tcl_ObjInterfaceStringIndexEndProc fnPtr)
}
declare 713 {
int Tcl_ObjInterfaceSetFnStringLength(Tcl_ObjInterface *oiPtr
,Tcl_ObjInterfaceStringLengthProc fnPtr)
}
declare 714 {
int Tcl_ObjInterfaceSetFnStringRange(Tcl_ObjInterface *oiPtr
,Tcl_ObjInterfaceStringRangeProc fnPtr)
}
declare 715 {
int Tcl_ObjInterfaceSetFnStringRangeEnd(Tcl_ObjInterface *oiPtr
,Tcl_ObjInterfaceStringRangeEndProc fnPtr)
}
declare 716 {
int Tcl_ObjTypeSetInterface(Tcl_ObjType *objTypePtr
,Tcl_ObjInterface *objInterfacePtr)
}
declare 717 {
int Tcl_ObjTypeSetName(Tcl_ObjType *objTypePtr ,char *name)
}
declare 718 {
int Tcl_ObjInterfaceSetFnStringIsEmpty(Tcl_ObjInterface *oiPtr
,Tcl_ObjInterfaceStringIsEmptyProc fnPtr)
}
declare 719 {
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,
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 | /* | < < < < < > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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) 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" */ |
| ︙ | ︙ | |||
100 101 102 103 104 105 106 107 108 109 110 111 112 113 | * 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> #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 | > > > > > > | 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 | * 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 |
| ︙ | ︙ | |||
204 205 206 207 208 209 210 | # ifdef USE_TCL_STUBS # define TCL_STORAGE_CLASS # else # define TCL_STORAGE_CLASS DLLIMPORT # endif #endif | < < < < | 225 226 227 228 229 230 231 232 233 234 235 236 237 238 | # ifdef USE_TCL_STUBS # define TCL_STORAGE_CLASS # else # define TCL_STORAGE_CLASS DLLIMPORT # endif #endif /* * Make sure EXTERN isn't defined elsewhere. */ #ifdef EXTERN # undef EXTERN #endif /* EXTERN */ |
| ︙ | ︙ | |||
317 318 319 320 321 322 323 | #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))) | < < < < < | | | < < | < < < < < | 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 |
#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)))
typedef ptrdiff_t Tcl_Size;
#define TCL_SIZE_MAX PTRDIFF_MAX
#define TCL_SIZE_MODIFIER TCL_T_MODIFIER
#ifdef _WIN32
typedef struct __stat64 Tcl_StatBuf;
#elif defined(__CYGWIN__)
typedef struct {
unsigned st_dev;
unsigned short st_ino;
unsigned short st_mode;
short st_nlink;
short st_uid;
|
| ︙ | ︙ | |||
459 460 461 462 463 464 465 |
/*
* 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 {
| < < < < < < < < < < | 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 |
/*
* 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 {
Tcl_Size start; /* Character offset of first character in
* match. */
Tcl_Size end; /* Character offset of first character after
* the match. */
} 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. */
Tcl_Size extendStart; /* The offset at which a subsequent match
* might begin. */
} Tcl_RegExpInfo;
/*
* Picky compilers complain if this typdef doesn't appear before the struct's
* reference in tclDecls.h.
*/
|
| ︙ | ︙ | |||
575 576 577 578 579 580 581 | 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); | < < < < < < < | 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 | 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); 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_EncodingFreeProc Tcl_FreeProc 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); |
| ︙ | ︙ | |||
612 613 614 615 616 617 618 | 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); | < < < < < < < < < < < < < < < < < < < < < < < < < < < > > > > < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 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 |
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);
/*
*----------------------------------------------------------------------------
* 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. */
size_t version;
} Tcl_ObjType;
/*
* 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.
*/
|
| ︙ | ︙ | |||
726 727 728 729 730 731 732 | /* * 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. */ | | | | 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 |
/*
* 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.
*/
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: */
};
/*
*----------------------------------------------------------------------------
* 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).
|
| ︙ | ︙ | |||
937 938 939 940 941 942 943 | #define TCL_INDEX_TEMP_TABLE 64 /* * Flags that may be passed to Tcl_UniCharToUtf. * TCL_COMBINE Combine surrogates */ | < | < < < | 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 | #define TCL_INDEX_TEMP_TABLE 64 /* * Flags that may be passed to Tcl_UniCharToUtf. * TCL_COMBINE Combine surrogates */ #define TCL_COMBINE 0x1000000 /* *---------------------------------------------------------------------------- * 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: |
| ︙ | ︙ | |||
1046 1047 1048 1049 1050 1051 1052 | /* *---------------------------------------------------------------------------- * Forward declarations of Tcl_HashTable and related types. */ #ifndef TCL_HASH_TYPE | < | < < < | 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 | /* *---------------------------------------------------------------------------- * Forward declarations of Tcl_HashTable and related types. */ #ifndef TCL_HASH_TYPE #define TCL_HASH_TYPE size_t #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); |
| ︙ | ︙ | |||
1167 1168 1169 1170 1171 1172 1173 |
* 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. */
| < < < < < | 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 |
* 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. */
size_t mask; /* Mask value used in hashing function. */
int downShift; /* Shift count used in hashing function.
* Designed to use high-order bits of
* randomized keys. */
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,
|
| ︙ | ︙ | |||
1293 1294 1295 1296 1297 1298 1299 |
/*
* 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 {
| < < < < | | | 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 |
/*
* 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 {
long long sec; /* Seconds. */
#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);
|
| ︙ | ︙ | |||
1349 1350 1351 1352 1353 1354 1355 | #define TCL_CLOSE_WRITE (1<<2) /* * Value to use as the closeProc for a channel that supports the close2Proc * interface. */ | < | < < < | 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 | #define TCL_CLOSE_WRITE (1<<2) /* * Value to use as the closeProc for a channel that supports the close2Proc * interface. */ #define TCL_CLOSE2PROC NULL /* * Channel version tag. This was introduced in 8.3.2/8.4. */ #define TCL_CHANNEL_VERSION_5 ((Tcl_ChannelTypeVersion) 0x5) |
| ︙ | ︙ | |||
1901 1902 1903 1904 1905 1906 1907 |
* 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. */
| < < < < < | 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 |
* 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. */
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. */
/*
* 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). */
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;
|
| ︙ | ︙ | |||
1984 1985 1986 1987 1988 1989 1990 | * 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. | | | 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 | * 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 - 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. |
| ︙ | ︙ | |||
2009 2010 2011 2012 2013 2014 2015 | * 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 | < | < < < | | 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 | * 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 #define TCL_ENCODING_STOPONERROR 0x0 /* Not used any more */ #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 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: * |
| ︙ | ︙ | |||
2066 2067 2068 2069 2070 2071 2072 | * 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 | < < < < < | | | | | < < < < < | 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 | * 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 # define TCL_UTF_MAX 4 #endif /* * This represents a Unicode character. Any changes to this should also be * reflected 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; /* *---------------------------------------------------------------------------- * TIP #59: The following structure is used in calls 'Tcl_RegisterConfig' to * provide the system with the embedded configuration data. */ |
| ︙ | ︙ | |||
2119 2120 2121 2122 2123 2124 2125 | /* * 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); | < < < < | 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 | /* * 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); #define Tcl_LimitHandlerDeleteProc Tcl_FreeProc #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 |
| ︙ | ︙ | |||
2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 | /* * 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) /* *---------------------------------------------------------------------------- * 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. */ | > < | < < < | 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 | /* * 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. */ #define TCL_STUB_MAGIC ((int) 0xFCA3BACB + (int) sizeof(void *)) /* * 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. */ |
| ︙ | ︙ | |||
2306 2307 2308 2309 2310 2311 2312 |
#if defined(_WIN32)
TCL_NORETURN1 void Tcl_ConsolePanic(const char *format, ...);
#else
# define Tcl_ConsolePanic NULL
#endif
#ifdef USE_TCL_STUBS
| < < < < < < < < < < < < | < < | | 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 |
#if defined(_WIN32)
TCL_NORETURN1 void Tcl_ConsolePanic(const char *format, ...);
#else
# define Tcl_ConsolePanic NULL
#endif
#ifdef USE_TCL_STUBS
#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, TCL_PATCH_LEVEL, \
1|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
TCL_STUB_MAGIC)
#endif
#else
#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))
|
| ︙ | ︙ | |||
2364 2365 2366 2367 2368 2369 2370 | EXTERN const char * Tcl_SetPreInitScript(const char *string); EXTERN const char * Tcl_SetPanicProc( TCL_NORETURN1 Tcl_PanicProc *panicProc); EXTERN void Tcl_StaticLibrary(Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); | < < < | | 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 |
EXTERN const char * Tcl_SetPreInitScript(const char *string);
EXTERN const char * Tcl_SetPanicProc(
TCL_NORETURN1 Tcl_PanicProc *panicProc);
EXTERN void Tcl_StaticLibrary(Tcl_Interp *interp,
const char *prefix,
Tcl_LibraryInitProc *initProc,
Tcl_LibraryInitProc *safeInitProc);
EXTERN Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 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)
#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) \
|
| ︙ | ︙ | |||
2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 | ((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 /* *---------------------------------------------------------------------------- * Include the public function declarations that are accessible via the stubs * table. */ #include "tclDecls.h" | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
((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"
|
| ︙ | ︙ | |||
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 | #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: */ | > > > | 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 | #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 | /* | < < < < < < < > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 | /* * 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" |
| ︙ | ︙ |
Changes to generic/tclArithSeries.c.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | /* * 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. */ #include "tcl.h" #include "tclInt.h" #include <assert.h> #include <math.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 | /* * 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> /* |
| ︙ | ︙ | |||
63 64 65 66 67 68 69 |
double end;
double step;
int precision;
} ArithSeriesDbl;
/* -------------------------- ArithSeries object ---------------------------- */
| < < < < < < < < < > > > > > > > > > > > > > | | > > > | > | > > > > | > | | | | > | < < | | | 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 |
double end;
double step;
int precision;
} ArithSeriesDbl;
/* -------------------------- ArithSeries object ---------------------------- */
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 ArithSeriesObjIndex(TCL_UNUSED(Tcl_Interp *), Tcl_Obj *arithSeriesObj,
Tcl_Size index, Tcl_Obj **elemObj);
static int ArithSeriesObjLength(TCL_UNUSED(Tcl_Interp *),
Tcl_Obj *arithSeriesObj, Tcl_Size *result);
static Tcl_ObjInterfaceListRangeProc ArithSeriesObjRange;
static int ArithSeriesObjReverse(Tcl_Interp *interp, Tcl_Obj *arithSeriesObj);
static int ArithSeriesGetElements(Tcl_Interp *interp,
Tcl_Obj *objPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr);
static int ArithSeriesObjStep(Tcl_Obj *arithSeriesObj, Tcl_Obj **stepObj);
static ObjectType tclArithSeriesType = {
"arithseries",
FreeArithSeriesInternalRep, /* freeIntRepProc */
DupArithSeriesInternalRep, /* dupIntRepProc */
UpdateStringOfArithSeries, /* updateStringProc */
SetArithSeriesFromAny, /* setFromAnyProc */
2,
NULL
};
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 *)&tclArithSeriesType ,oiPtr);
return;
}
/*
* Helper functions
*
* - 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 provided, determine the longest precision
* in the arithSeries
*/
static inline double
ArithRound(double d, unsigned int n) {
double scalefactor = pow(10, n);
return round(d*scalefactor)/scalefactor;
}
|
| ︙ | ︙ | |||
146 147 148 149 150 151 152 |
}
}
static inline ArithSeries*
ArithSeriesGetInternalRep(Tcl_Obj *objPtr)
{
const Tcl_ObjInternalRep *irPtr;
| | | 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 |
}
}
static inline ArithSeries*
ArithSeriesGetInternalRep(Tcl_Obj *objPtr)
{
const Tcl_ObjInternalRep *irPtr;
irPtr = TclFetchInternalRep((objPtr), (Tcl_ObjType *)&tclArithSeriesType);
return irPtr ? (ArithSeries *)irPtr->twoPtrValue.ptr1 : NULL;
}
/*
* Compute number of significant factional digits
*/
static inline int
|
| ︙ | ︙ | |||
177 178 179 180 181 182 183 |
int i = Precision(start);
dp = i>dp ? i : dp;
i = Precision(end);
dp = i>dp ? i : dp;
return dp;
}
| < < | 200 201 202 203 204 205 206 207 208 209 210 211 212 213 |
int 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
* every element is generated starting from *start*,
|
| ︙ | ︙ | |||
232 233 234 235 236 237 238 |
return floor(ilen);
}
/*
*----------------------------------------------------------------------
*
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 253 254 255 256 257 258 259 260 261 262 263 264 265 266 |
return floor(ilen);
}
/*
*----------------------------------------------------------------------
*
* NewArithSeriesInt --
*
* Creates a new ArithSeries object. The returned object has
* refcount = 0.
*
* Results:
*
|
| ︙ | ︙ | |||
352 353 354 355 356 357 358 |
arithSeriesRepPtr->start = start;
arithSeriesRepPtr->end = end;
arithSeriesRepPtr->step = step;
arithSeriesRepPtr->len = length;
arithSeriesRepPtr->elements = NULL;
arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL;
| | | 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 |
arithSeriesRepPtr->start = start;
arithSeriesRepPtr->end = end;
arithSeriesRepPtr->step = step;
arithSeriesRepPtr->len = length;
arithSeriesRepPtr->elements = NULL;
arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL;
arithSeriesObj->typePtr = (Tcl_ObjType *)&tclArithSeriesType;
if (length > 0)
Tcl_InvalidateStringRep(arithSeriesObj);
return arithSeriesObj;
}
/*
|
| ︙ | ︙ | |||
407 408 409 410 411 412 413 |
arithSeriesRepPtr->end = end;
arithSeriesRepPtr->step = step;
arithSeriesRepPtr->len = length;
arithSeriesRepPtr->elements = NULL;
arithSeriesRepPtr->precision = maxPrecision(start,end,step);
arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL;
| | | 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 |
arithSeriesRepPtr->end = end;
arithSeriesRepPtr->step = step;
arithSeriesRepPtr->len = length;
arithSeriesRepPtr->elements = NULL;
arithSeriesRepPtr->precision = maxPrecision(start,end,step);
arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL;
arithSeriesObj->typePtr = (Tcl_ObjType *)&tclArithSeriesType;
if (length > 0) {
Tcl_InvalidateStringRep(arithSeriesObj);
}
return arithSeriesObj;
}
|
| ︙ | ︙ | |||
484 485 486 487 488 489 490 | * * Side Effects: * * None. *---------------------------------------------------------------------- */ | < > < > | | | | 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 |
*
* Side Effects:
*
* None.
*----------------------------------------------------------------------
*/
Tcl_Obj *
TclNewArithSeriesObj(
Tcl_Interp *interp, /* For error reporting */
int useDoubles, /* Flag indicates values start,
** end, step, are treated as doubles */
Tcl_Obj *startObj, /* Starting value */
Tcl_Obj *endObj, /* Ending limit */
Tcl_Obj *stepObj, /* increment value */
Tcl_Obj *lenObj) /* Number of elements */
{
double dstart, dend, dstep;
Tcl_WideInt start, end, step;
Tcl_WideInt len = -1;
Tcl_Obj *arithSeriesObjPtr = NULL;
if (startObj) {
assignNumber(useDoubles, &start, &dstart, startObj);
} else {
start = 0;
dstart = start;
}
if (stepObj) {
assignNumber(useDoubles, &step, &dstep, stepObj);
if (useDoubles) {
step = dstep;
} else {
dstep = step;
}
if (dstep == 0) {
TclNewObj(arithSeriesObjPtr);
return arithSeriesObjPtr;
}
}
if (endObj) {
assignNumber(useDoubles, &end, &dend, endObj);
}
if (lenObj) {
if (TCL_OK != Tcl_GetWideIntFromObj(interp, lenObj, &len)) {
return arithSeriesObjPtr;
}
}
if (startObj && endObj) {
if (!stepObj) {
if (useDoubles) {
dstep = (dstart < dend) ? 1.0 : -1.0;
|
| ︙ | ︙ | |||
562 563 564 565 566 567 568 |
}
if (len > TCL_SIZE_MAX) {
Tcl_SetObjResult(
interp,
Tcl_NewStringObj("max length of a Tcl list exceeded", -1));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", (void *)NULL);
| | | < | | < | | | | < < < | > | | 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 |
}
if (len > TCL_SIZE_MAX) {
Tcl_SetObjResult(
interp,
Tcl_NewStringObj("max length of a Tcl list exceeded", -1));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", (void *)NULL);
return arithSeriesObjPtr;
}
arithSeriesObjPtr = useDoubles
? NewArithSeriesDbl(dstart, dend, dstep, len)
: NewArithSeriesInt(start, end, step, len);
return arithSeriesObjPtr;
}
/*
*----------------------------------------------------------------------
*
* ArithSeriesObjIndex --
*
* Stores in **resultPtr the element with the specified index in the list
* represented by the specified Arithmetic Sequence object.
*
* Results:
*
* On success, returns TCL_OK and stores the position of the element in
* *element. Returns TCL_ERROR if the 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.
*
*----------------------------------------------------------------------
*/
int
ArithSeriesObjIndex(
TCL_UNUSED(Tcl_Interp *),/* Used for error reporting if not NULL. */
Tcl_Obj *arithSeriesObj, /* List obj */
Tcl_Size index, /* index to element of interest */
Tcl_Obj **elemObj) /* Return value */
{
ArithSeries *arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
|
| ︙ | ︙ | |||
636 637 638 639 640 641 642 | * * Side Effects: * * None. * *---------------------------------------------------------------------- */ | > | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | 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 |
*
* Side Effects:
*
* None.
*
*----------------------------------------------------------------------
*/
int ArithSeriesObjLength(TCL_UNUSED(Tcl_Interp *),
Tcl_Obj *arithSeriesObj, Tcl_Size *result)
{
ArithSeries *arithSeriesRepPtr = (ArithSeries*)
arithSeriesObj->internalRep.twoPtrValue.ptr1;
*result = arithSeriesRepPtr->len;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* FreeArithSeriesInternalRep --
*
* Deallocate the storage associated with an arithseries object's
* internal representation.
*
* Results:
* None.
*
* Side effects:
* Frees arithSeriesObj's ArithSeries* internal representation and
* sets listPtr's internalRep.twoPtrValue.ptr1 to NULL.
*
*----------------------------------------------------------------------
*/
static void
FreeArithSeriesInternalRep(Tcl_Obj *arithSeriesObj)
{
ArithSeries *arithSeriesRepPtr =
(ArithSeries *) arithSeriesObj->internalRep.twoPtrValue.ptr1;
if (arithSeriesRepPtr->elements) {
Tcl_Size i;
Tcl_Obj**elmts = arithSeriesRepPtr->elements;
for(i=0; i<arithSeriesRepPtr->len; i++) {
if (elmts[i]) {
Tcl_DecrRefCount(elmts[i]);
}
}
Tcl_Free((char *) arithSeriesRepPtr->elements);
}
Tcl_Free((char *) arithSeriesRepPtr);
arithSeriesObj->internalRep.twoPtrValue.ptr1 = NULL;
}
/*
*----------------------------------------------------------------------
*
* DupArithSeriesInternalRep --
*
* Initialize the internal representation of a arithseries Tcl_Obj to a
* copy of the internal representation of an existing arithseries object.
*
* 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 *srcArithSeriesRepPtr =
(ArithSeries *) srcPtr->internalRep.twoPtrValue.ptr1;
/*
* Allocate a new ArithSeries structure. */
if (srcArithSeriesRepPtr->isDouble) {
ArithSeriesDbl *srcArithSeriesDblRepPtr =
(ArithSeriesDbl *)srcArithSeriesRepPtr;
ArithSeriesDbl *copyArithSeriesDblRepPtr =
(ArithSeriesDbl *) Tcl_Alloc(sizeof(ArithSeriesDbl));
*copyArithSeriesDblRepPtr = *srcArithSeriesDblRepPtr;
copyArithSeriesDblRepPtr->elements = NULL;
copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesDblRepPtr;
} else {
ArithSeries *copyArithSeriesRepPtr =
(ArithSeries *) Tcl_Alloc(sizeof(ArithSeries));
*copyArithSeriesRepPtr = *srcArithSeriesRepPtr;
copyArithSeriesRepPtr->elements = NULL;
copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesRepPtr;
}
copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
copyPtr->typePtr = (Tcl_ObjType *)&tclArithSeriesType;
}
/*
*----------------------------------------------------------------------
*
* UpdateStringOfArithSeries --
*
* Update the string representation for an arithseries object.
* Note: This procedure does not invalidate an existing old string rep
* so storage will be lost if this has not already been done.
*
* Results:
* None.
*
* Side effects:
* The object's string is set to a valid string that results from
* the list-to-string conversion. This string will be empty if the
* list has no elements. The list internal representation
* should not be NULL and we assume it is not NULL.
*
* Notes:
* At the cost of overallocation it's possible to estimate
* the length of the string representation and make this procedure
* 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(Tcl_Obj *arithSeriesObj)
{
ArithSeries *arithSeriesRepPtr =
(ArithSeries*) arithSeriesObj->internalRep.twoPtrValue.ptr1;
char *elem, *p;
Tcl_Obj *elemObj;
Tcl_Size i;
Tcl_Size length = 0;
Tcl_Size slen;
/*
* Pass 1: estimate space.
*/
if (!arithSeriesRepPtr->isDouble) {
for (i = 0; i < arithSeriesRepPtr->len; i++) {
double d = ArithSeriesIndexDbl(arithSeriesRepPtr, i);
slen = d>0 ? log10(d)+1 : d<0 ? log10((0-d))+2 : 1;
length += 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);
if ((length + strlen(tmp)) > TCL_SIZE_MAX) {
break; // overflow
}
length += strlen(tmp);
}
}
length += arithSeriesRepPtr->len; // Space for each separator
/*
* Pass 2: generate the string repr.
*/
p = Tcl_InitStringRep(arithSeriesObj, NULL, length);
if (p == NULL) {
Tcl_Panic("Unable to allocate string size %" TCL_Z_MODIFIER "u", length);
}
for (i = 0; i < arithSeriesRepPtr->len; i++) {
if (ArithSeriesObjIndex(NULL, arithSeriesObj, i, &elemObj) == TCL_OK)
{
elem = Tcl_GetStringFromObj(elemObj, &slen);
if (((p - arithSeriesObj->bytes)+slen) > length) {
break;
}
strncpy(p, elem, slen);
p[slen] = ' ';
p += slen+1;
Tcl_DecrRefCount(elemObj);
} else {
Tcl_Panic("UpdateStringOfArithSeries"
" {could not get value at index} index %"
TCL_Z_MODIFIER "u", i);
}
}
if (length > 0) arithSeriesObj->bytes[length-1] = '\0';
arithSeriesObj->length = length-1;
return;
}
/*
*----------------------------------------------------------------------
*
* 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.
*----------------------------------------------------------------------
*/
static int
ArithSeriesObjStep(
Tcl_Obj *arithSeriesObj,
Tcl_Obj **stepObj)
{
ArithSeries *arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
if (arithSeriesRepPtr->isDouble) {
*stepObj = Tcl_NewDoubleObj(((ArithSeriesDbl*)(arithSeriesRepPtr))->step);
} else {
|
| ︙ | ︙ | |||
710 711 712 713 714 715 716 |
Tcl_Panic("SetArithSeriesFromAny: should never be called");
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
| | | > | | | > | | < < < < | < < < < | | > | < | | < < < < < < < < < | | < < < < < < < < < < < < < | < < < < < < | < < < | < | | | 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 |
Tcl_Panic("SetArithSeriesFromAny: should never be called");
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
* ArithSeriesObjRange --
*
* Makes a slice of an ArithSeries value.
* *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.
*
* Side effects:
* ?The possible conversion of the object referenced by listPtr?
* ?to a list object.?
*
*----------------------------------------------------------------------
*/
int
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 **resPtr
) /* return value */
{
ArithSeries *arithSeriesRepPtr;
Tcl_Obj *startObj, *endObj, *stepObj ,*newObjPtr;
(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);
*resPtr = newObjPtr;
return TCL_OK;
}
if (fromIdx < 0) {
fromIdx = 0;
}
if (toIdx < 0) {
toIdx = 0;
}
if (toIdx > arithSeriesRepPtr->len-1) {
toIdx = arithSeriesRepPtr->len-1;
}
ArithSeriesObjIndex(interp, arithSeriesObj, fromIdx, &startObj);
if (startObj == NULL) {
return TCL_ERROR;
}
Tcl_IncrRefCount(startObj);
ArithSeriesObjIndex(interp, arithSeriesObj, toIdx, &endObj);
if (endObj == NULL) {
return TCL_ERROR;
}
Tcl_IncrRefCount(endObj);
ArithSeriesObjStep(arithSeriesObj, &stepObj);
Tcl_IncrRefCount(stepObj);
newObjPtr = TclNewArithSeriesObj(NULL,
arithSeriesRepPtr->isDouble, startObj, endObj, stepObj, NULL);
Tcl_DecrRefCount(startObj);
Tcl_DecrRefCount(endObj);
Tcl_DecrRefCount(stepObj);
*resPtr = newObjPtr;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* 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
|
| ︙ | ︙ | |||
859 860 861 862 863 864 865 | * Side effects: * None. * *---------------------------------------------------------------------- */ int | | | | 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 |
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
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,(Tcl_ObjType *)&tclArithSeriesType)) {
ArithSeries *arithSeriesRepPtr;
Tcl_Obj **objv;
int i, objc;
arithSeriesRepPtr = ArithSeriesGetInternalRep(objPtr);
objc = arithSeriesRepPtr->len;
|
| ︙ | ︙ | |||
894 895 896 897 898 899 900 |
Tcl_NewStringObj("max length of a Tcl list exceeded", -1));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", (void *)NULL);
}
return TCL_ERROR;
}
arithSeriesRepPtr->elements = objv;
for (i = 0; i < objc; i++) {
| | | 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 |
Tcl_NewStringObj("max length of a Tcl list exceeded", -1));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", (void *)NULL);
}
return TCL_ERROR;
}
arithSeriesRepPtr->elements = objv;
for (i = 0; i < objc; i++) {
int status = ArithSeriesObjIndex(interp, objPtr, i, &objv[i]);
if (status) {
return TCL_ERROR;
}
Tcl_IncrRefCount(objv[i]);
}
}
} else {
|
| ︙ | ︙ | |||
921 922 923 924 925 926 927 |
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
| | | | | < > < | | | | | < < < < < < < < < < < < < < < | | | | | | | | | | | | | | | | | | | | < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 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 |
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* 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.
*
* Side effects:
* The original obj will be modified and returned if it is not Shared.
*
*----------------------------------------------------------------------
*/
int
ArithSeriesObjReverse(
Tcl_Interp *interp, /* For error message(s) */
Tcl_Obj *arithSeriesObj /* List object to reverse. */
)
{
ArithSeries *arithSeriesRepPtr;
Tcl_Obj *startObj, *endObj, *stepObj;
Tcl_WideInt start, end, step, len;
double dstart, dend, dstep;
int isDouble;
(void)interp;
if (Tcl_IsShared(arithSeriesObj)) {
Tcl_Panic("%s called with shared object", "ArithSeriesObjReverse");
}
arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
isDouble = arithSeriesRepPtr->isDouble;
len = arithSeriesRepPtr->len;
ArithSeriesObjIndex(NULL, arithSeriesObj, (len-1), &startObj);
Tcl_IncrRefCount(startObj);
ArithSeriesObjIndex(NULL, arithSeriesObj, 0, &endObj);
Tcl_IncrRefCount(endObj);
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);
}
TclInvalidateStringRep(arithSeriesObj);
if (isDouble) {
ArithSeriesDbl *arithSeriesDblRepPtr =
(ArithSeriesDbl*)arithSeriesRepPtr;
arithSeriesDblRepPtr->start = dstart;
arithSeriesDblRepPtr->end = dend;
arithSeriesDblRepPtr->step = dstep;
} else {
arithSeriesRepPtr->start = start;
arithSeriesRepPtr->end = end;
arithSeriesRepPtr->step = step;
}
if (arithSeriesRepPtr->elements) {
Tcl_WideInt i;
for (i=0; i<len; i++) {
Tcl_DecrRefCount(arithSeriesRepPtr->elements[i]);
}
Tcl_Free((char*)arithSeriesRepPtr->elements);
}
arithSeriesRepPtr->elements = NULL;
Tcl_DecrRefCount(startObj);
Tcl_DecrRefCount(endObj);
Tcl_DecrRefCount(stepObj);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ArithSeriesInOperator --
*
* Evaluate the "in" operation for expr
|
| ︙ | ︙ | |||
1129 1130 1131 1132 1133 1134 1135 |
*
*----------------------------------------------------------------------
*/
static int
ArithSeriesInOperation(
Tcl_Interp *interp,
| < > | > < | 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 |
*
*----------------------------------------------------------------------
*/
static int
ArithSeriesInOperation(
Tcl_Interp *interp,
Tcl_Obj *arithSeriesObjPtr,
Tcl_Obj *valueObj,
int *boolResult)
{
ArithSeries *arithSeriesRepPtr = (ArithSeries*)arithSeriesObjPtr->internalRep.twoPtrValue.ptr1;
ArithSeriesDbl *dblRepPtr = (ArithSeriesDbl*)arithSeriesRepPtr;
int status;
Tcl_Size index, incr, elen, vlen;
if (arithSeriesRepPtr->isDouble) {
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) {
test = 0;
} else {
char *vstr = Tcl_GetStringFromObj(valueObj, &vlen);
index = (y - dblRepPtr->start) / dblRepPtr->step;
while (incr<2) {
Tcl_Obj *elemObj;
ArithSeriesObjIndex(interp, arithSeriesObjPtr, (index+incr), &elemObj);
elen = 0;
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;
|
| ︙ | ︙ | |||
1180 1181 1182 1183 1184 1185 1186 |
if (boolResult) {
*boolResult = 0;
}
} else {
Tcl_Obj *elemObj;
elen = 0;
index = (y - intRepPtr->start) / intRepPtr->step;
| | | 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 |
if (boolResult) {
*boolResult = 0;
}
} else {
Tcl_Obj *elemObj;
elen = 0;
index = (y - intRepPtr->start) / intRepPtr->step;
ArithSeriesObjIndex(interp, arithSeriesObjPtr, index, &elemObj);
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 | /* * 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. * | > > > > > > > > > > > > > > > > > < < < < < | | 1 2 3 4 5 6 7 8 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. * */ /*- *- 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 |
| ︙ | ︙ | |||
322 323 324 325 326 327 328 |
static const Tcl_ObjType assembleCodeType = {
"assemblecode",
FreeAssembleCodeInternalRep, /* freeIntRepProc */
DupAssembleCodeInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
| < > | 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 |
static const Tcl_ObjType assembleCodeType = {
"assemblecode",
FreeAssembleCodeInternalRep, /* freeIntRepProc */
DupAssembleCodeInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
0
};
/*
* Source instructions recognized in the Tcl Assembly Language (TAL)
*/
static const TalInstDesc TalInstructionTable[] = {
|
| ︙ | ︙ |
Changes to generic/tclAsync.c.
1 | /* | < < < < < < > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 © 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; /* |
| ︙ | ︙ |
Changes to generic/tclBasic.c.
1 | /* | < < < < < < > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 © 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> |
| ︙ | ︙ | |||
6117 6118 6119 6120 6121 6122 6123 | * 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); | | > > > > | 6129 6130 6131 6132 6133 6134 6135 6136 6137 6138 6139 6140 6141 6142 6143 6144 6145 6146 6147 |
* 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 = 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.
*
|
| ︙ | ︙ | |||
7011 7012 7013 7014 7015 7016 7017 |
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) {
| | | 7027 7028 7029 7030 7031 7032 7033 7034 7035 7036 7037 7038 7039 7040 7041 |
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);
if (irPtr) {
Tcl_SetObjResult(interp, objv[1]);
return TCL_OK;
}
}
#endif
|
| ︙ | ︙ | |||
7051 7052 7053 7054 7055 7056 7057 |
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) {
| | | 7067 7068 7069 7070 7071 7072 7073 7074 7075 7076 7077 7078 7079 7080 7081 |
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);
if (irPtr) {
Tcl_SetObjResult(interp, objv[1]);
return TCL_OK;
}
}
#endif
|
| ︙ | ︙ | |||
7197 7198 7199 7200 7201 7202 7203 |
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) {
| | | 7213 7214 7215 7216 7217 7218 7219 7220 7221 7222 7223 7224 7225 7226 7227 |
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);
if (irPtr) {
Tcl_SetObjResult(interp, objv[1]);
return TCL_OK;
}
}
#endif
|
| ︙ | ︙ | |||
7251 7252 7253 7254 7255 7256 7257 |
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) {
| | | 7267 7268 7269 7270 7271 7272 7273 7274 7275 7276 7277 7278 7279 7280 7281 |
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);
if (irPtr) {
d = irPtr->doubleValue;
Tcl_ResetResult(interp);
code = TCL_OK;
}
}
|
| ︙ | ︙ | |||
7315 7316 7317 7318 7319 7320 7321 |
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) {
| | | | 7331 7332 7333 7334 7335 7336 7337 7338 7339 7340 7341 7342 7343 7344 7345 7346 7347 7348 7349 7350 7351 7352 7353 7354 7355 7356 7357 7358 7359 7360 |
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);
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);
if (irPtr) {
d2 = irPtr->doubleValue;
Tcl_ResetResult(interp);
code = TCL_OK;
}
}
|
| ︙ | ︙ | |||
7491 7492 7493 7494 7495 7496 7497 |
if (objc != 2) {
MathFuncWrongNumArgs(interp, 2, objc, objv);
return TCL_ERROR;
}
if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) {
#ifdef ACCEPT_NAN
| | | 7507 7508 7509 7510 7511 7512 7513 7514 7515 7516 7517 7518 7519 7520 7521 |
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)) {
Tcl_SetObjResult(interp, objv[1]);
return TCL_OK;
}
#endif
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewDoubleObj(dResult));
|
| ︙ | ︙ |
Changes to generic/tclBinary.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 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 © 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 |
static const Tcl_ObjType properByteArrayType = {
"bytearray",
FreeProperByteArrayInternalRep,
DupProperByteArrayInternalRep,
UpdateStringOfByteArray,
NULL,
| < > | 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 |
static const Tcl_ObjType properByteArrayType = {
"bytearray",
FreeProperByteArrayInternalRep,
DupProperByteArrayInternalRep,
UpdateStringOfByteArray,
NULL,
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.
|
| ︙ | ︙ | |||
377 378 379 380 381 382 383 |
if (numBytesPtr != NULL) {
*numBytesPtr = baPtr->used;
}
return baPtr->bytes;
}
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 389 390 391 392 393 394 395 396 397 398 399 400 401 402 |
if (numBytesPtr != NULL) {
*numBytesPtr = baPtr->used;
}
return baPtr->bytes;
}
/*
*----------------------------------------------------------------------
*
* Tcl_SetByteArrayLength --
*
* This procedure changes the length of the byte array for this object.
|
| ︙ | ︙ | |||
1997 1998 1999 2000 2001 2002 2003 |
/*
* 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) {
| | | | 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 |
/*
* 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);
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);
if (irPtr == NULL) {
return TCL_ERROR;
}
dvalue = irPtr->doubleValue;
}
|
| ︙ | ︙ |
Changes to generic/tclCkalloc.c.
1 | /* | < < < < < < > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 © 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 |
| ︙ | ︙ |
Changes to generic/tclClock.c.
1 | /* | < < < < < < > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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-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. */ /* * tclClock.c -- * * Contains the time and date related commands. This code is derived from * the time and date facilities of TclX, by Mark Diekhans and Karl * Lehenbauer. */ #include "tclInt.h" #include "tclTomMath.h" /* * Windows has mktime. The configurators do not check. */ |
| ︙ | ︙ | |||
429 430 431 432 433 434 435 |
}
/*
* fields.seconds could be an unsigned number that overflowed. Make sure
* that it isn't.
*/
| | | 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 |
}
/*
* fields.seconds could be an unsigned number that overflowed. Make sure
* that it isn't.
*/
if (TclHasInternalRep(objv[1], tclBignumType)) {
Tcl_SetObjResult(interp, lit[LIT_INTEGER_VALUE_TOO_LARGE]);
return TCL_ERROR;
}
/*
* Convert UTC time to local.
*/
|
| ︙ | ︙ |
Changes to generic/tclCmdAH.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 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 © 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 |
| ︙ | ︙ | |||
2075 2076 2077 2078 2079 2080 2081 |
{
Tcl_Obj *res;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
}
| | | 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 |
{
Tcl_Obj *res;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
}
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",
(void *)NULL);
return TCL_ERROR;
|
| ︙ | ︙ | |||
2816 2817 2818 2819 2820 2821 2822 |
/*
* Break up the value lists and variable lists into elements.
*/
for (i=0 ; i<numLists ; i++) {
/* List */
/* Variables */
| | > | | 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 |
/*
* Break up the value lists and variable lists into elements.
*/
for (i=0 ; i<numLists ; i++) {
/* List */
/* Variables */
statePtr->vCopyList[i] = TclDuplicatePureObj(
interp, objv[1+i*2], tclListTypePtr);
if (!statePtr->vCopyList[i]) {
result = TCL_ERROR;
goto done;
}
result = TclListObjLengthM(interp, statePtr->vCopyList[i],
&statePtr->varcList[i]);
if (result != TCL_OK) {
result = TCL_ERROR;
|
| ︙ | ︙ | |||
2841 2842 2843 2844 2845 2846 2847 | result = TCL_ERROR; goto done; } TclListObjGetElementsM(NULL, statePtr->vCopyList[i], &statePtr->varcList[i], &statePtr->varvList[i]); /* Values */ | | | > > | > > > > < | > | | 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 |
result = TCL_ERROR;
goto done;
}
TclListObjGetElementsM(NULL, statePtr->vCopyList[i],
&statePtr->varcList[i], &statePtr->varvList[i]);
/* Values */
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,
length, interp, statePtr->aCopyList[i], &statePtr->argcList[i]);
if (status != TCL_OK) {
result = TCL_ERROR;
goto done;
}
} else {
statePtr->aCopyList[i] = TclDuplicatePureObj(
interp, objv[2+i*2], tclListTypePtr);
if (!statePtr->aCopyList[i]) {
result = TCL_ERROR;
goto done;
}
result = TclListObjGetElementsM(interp, statePtr->aCopyList[i],
&statePtr->argcList[i], &statePtr->argvList[i]);
if (result != TCL_OK) {
goto done;
|
| ︙ | ︙ | |||
2990 2991 2992 2993 2994 2995 2996 |
struct ForeachState *statePtr)
{
int i;
Tcl_Size v, k;
Tcl_Obj *valuePtr, *varValuePtr;
for (i=0 ; i<statePtr->numLists ; i++) {
| | > | < | > | > | 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 |
struct ForeachState *statePtr)
{
int i;
Tcl_Size v, k;
Tcl_Obj *valuePtr, *varValuePtr;
for (i=0 ; i<statePtr->numLists ; i++) {
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 (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 | /* | < < < < < < < > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 © 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> /* |
| ︙ | ︙ | |||
2200 2201 2202 2203 2204 2205 2206 |
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;
| | | | | < < | | > | | > > > > > | > > | | | | | | > | > > > > > > | | | | | | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > | > | 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 |
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 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 (TclObjectHasInterface(objv[1], list, length)) {
status = TclObjectDispatchNoDefault(interp, status, objv[1], list,
length, interp, objv[1], &listLen);
if (status != TCL_OK ) {
return TCL_ERROR;
}
} else {
if (TclListObjGetElementsM(interp, objv[1], &listLen,
&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 (status != TCL_OK) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, valueObj);
} else {
if (elemPtrs == NULL) {
if (TclListObjGetElementsM(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) Tcl_GetStringFromObj(joinObjPtr, &length);
if (length == 0) {
if (TclListObjGetElementsM(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) {
/*
* 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);
}
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 (TclListObjGetElementsM(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;
}
|
| ︙ | ︙ | |||
2305 2306 2307 2308 2309 2310 2311 |
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 */
| | | 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 |
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, status;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "list ?varName ...?");
return TCL_ERROR;
}
/*
|
| ︙ | ︙ | |||
2368 2369 2370 2371 2372 2373 2374 |
return TCL_ERROR;
}
}
Tcl_DecrRefCount(emptyObj);
}
if (listObjc > 0) {
| | | | | > | | | | | | 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 |
return TCL_ERROR;
}
}
Tcl_DecrRefCount(emptyObj);
}
if (listObjc > 0) {
Tcl_Obj *resultPtr = NULL;
Tcl_Size fromIdx = origListObjc - listObjc;
Tcl_Size toIdx = origListObjc - 1;
if (TclObjectHasInterface(listPtr, list, range)) {
TclObjectDispatchNoDefault(interp, status, listPtr, list, range,
interp, listPtr, fromIdx, toIdx, &resultPtr);
if (status != TCL_OK) {
return TCL_ERROR;
}
}
else {
status = TclListObjRange(interp, listPtr,
origListObjc - listObjc, origListObjc - 1, &resultPtr);
if (status != TCL_OK || resultPtr == NULL) {
return status;
}
}
Tcl_SetObjResult(interp, resultPtr);
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
2507 2508 2509 2510 2511 2512 2513 |
/*
* 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)) {
| > | > > | 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 |
/*
* 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);
if (!listPtr) {
return TCL_ERROR;
}
copied = 1;
}
if ((objc == 4) && (index == len)) {
/*
* Special case: insert one element at the end of the list.
*/
|
| ︙ | ︙ | |||
2652 2653 2654 2655 2656 2657 2658 |
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[])
/* Argument objects. */
{
Tcl_Size listLen;
| | | 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 |
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[])
/* Argument objects. */
{
Tcl_Size listLen;
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;
}
|
| ︙ | ︙ | |||
2704 2705 2706 2707 2708 2709 2710 |
}
}
Tcl_SetObjResult(interp, elemPtr);
Tcl_DecrRefCount(elemPtr);
/*
* Second, remove the element.
| < > | > > < < < < | < | < < < | < | 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 |
}
}
Tcl_SetObjResult(interp, elemPtr);
Tcl_DecrRefCount(elemPtr);
/*
* Second, remove the element.
*/
if (objc == 2) {
if (Tcl_IsShared(listPtr)) {
listPtr = TclDuplicatePureObj(interp, listPtr, tclListTypePtr);
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;
status = TclLsetFlat(interp, listPtr, objc-2, objv+2, NULL, &newListPtr);
if (status != TCL_OK || newListPtr == NULL) {
return status;
} else {
listPtr = newListPtr;
}
}
stored = Tcl_ObjSetVar2(interp, objv[1], NULL, listPtr, TCL_LEAVE_ERR_MSG);
if (stored == NULL) {
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
2771 2772 2773 2774 2775 2776 2777 |
Tcl_LrangeObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[])
/* Argument objects. */
{
| | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | | | | | | | < < | | < < | < < < < < | | 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 |
Tcl_LrangeObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[])
/* Argument objects. */
{
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 = TclListObjLengthM(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[3], /*endValue*/ listLen - 1,
&last);
if (result != TCL_OK) {
return result;
}
status = TclListObjRange(interp, objv[1], first, last, &resultPtr);
if (status != TCL_OK || resultPtr == NULL) {
return status;
}
Tcl_SetObjResult(interp, resultPtr);
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
2899 2900 2901 2902 2903 2904 2905 |
}
/*
* Make our working copy, then do the actual removes piecemeal.
*/
if (Tcl_IsShared(listObj)) {
| > | > > > | 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 |
}
/*
* Make our working copy, then do the actual removes piecemeal.
*/
if (Tcl_IsShared(listObj)) {
listObj = TclDuplicatePureObj(interp, listObj, tclListTypePtr);
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];
|
| ︙ | ︙ | |||
2984 2985 2986 2987 2988 2989 2990 |
Tcl_LrepeatObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[])
/* The argument objects. */
{
| | < | | | 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 |
Tcl_LrepeatObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[])
/* The argument objects. */
{
Tcl_Size elementCount, i, 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 != Tcl_GetSizeIntFromObj(interp, objv[1], &elementCount)) {
return TCL_ERROR;
}
if (elementCount < 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad count \"%" TCL_SIZE_MODIFIER "d\": must be integer >= 0", elementCount));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPEAT", "NEGARG",
(void *)NULL);
return TCL_ERROR;
}
/*
* Skip forward to the interesting arguments now we've finished parsing.
|
| ︙ | ︙ | |||
3139 3140 3141 3142 3143 3144 3145 |
first = listLen;
}
if (last >= listLen) {
last = listLen - 1;
}
if (first <= last) {
| | > | > > | 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 |
first = listLen;
}
if (last >= listLen) {
last = listLen - 1;
}
if (first <= last) {
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);
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
|
| ︙ | ︙ | |||
3208 3209 3210 3211 3212 3213 3214 |
Tcl_Size elemc, i, j;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "list");
return TCL_ERROR;
}
| < < < < | > | > > > > | > > | | > | | < | 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 |
Tcl_Size elemc, i, j;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "list");
return TCL_ERROR;
}
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;
}
if (TclListObjLengthM(interp, objv[1], &elemc) != TCL_OK) {
return TCL_ERROR;
}
/*
* If the list is empty, just return it. [Bug 1876793]
|
| ︙ | ︙ | |||
3306 3307 3308 3309 3310 3311 3312 |
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;
| | | | | 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 |
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 groupSize, groupOffset, lower, upper;
int allocatedIndexVector = 0;
int isIncreasing;
Tcl_WideInt patWide, objWide, wide;
int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
double patDouble, objDouble;
SortInfo sortInfo;
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",
|
| ︙ | ︙ | |||
3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 |
enum modes mode;
mode = GLOB;
dataType = ASCII;
isIncreasing = 1;
allMatches = 0;
inlineReturn = 0;
returnSubindices = 0;
negatedMatch = 0;
bisect = 0;
listPtr = NULL;
startPtr = NULL;
groupSize = 1;
groupOffset = 0;
| > | 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 |
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;
|
| ︙ | ︙ | |||
3611 3612 3613 3614 3615 3616 3617 |
}
/*
* Make sure the list argument is a list object and get its length and a
* pointer to its array of element pointers.
*/
| > | | 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 |
}
/*
* 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 = 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]
|
| ︙ | ︙ | |||
3665 3666 3667 3668 3669 3670 3671 |
}
/*
* Get the user-specified start offset.
*/
if (startPtr) {
| | > | | > | 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 |
}
/*
* Get the user-specified start offset.
*/
if (startPtr) {
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, just return a
* "did not match anything at all" result straight away. [Bug 1374778]
*/
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.
*/
|
| ︙ | ︙ | |||
3712 3713 3714 3715 3716 3717 3718 |
case INTEGER:
result = TclGetWideIntFromObj(interp, patObj, &patWide);
if (result != TCL_OK) {
goto done;
}
/*
| < | > < < < | > < < > > > | > | > > | > > | > > > > > > > > > > > > > > > > > > | < < > > | > > > > > > | | > > > | | 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 |
case INTEGER:
result = TclGetWideIntFromObj(interp, patObj, &patWide);
if (result != TCL_OK) {
goto done;
}
/*
* [Bug 1844789], "lsearch -exact -integer ..." crashes, was
* previously fixed at this point.
*/
break;
case REAL:
result = Tcl_GetDoubleFromObj(interp, patObj, &patDouble);
if (result != TCL_OK) {
goto done;
}
/*
* [Bug 1844789], "lsearch -exact -integer ..." crashes, was
* previously fixed at this point.
*/
break;
}
} else {
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;
} 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;
}
} else {
goto done;
}
} else {
goto done;
}
}
}
Tcl_IncrRefCount(itemPtr);
if (sortInfo.indexc != 0) {
item2Ptr = SelectObjFromSublist(itemPtr, &sortInfo);
if (sortInfo.resultCode != TCL_OK) {
result = sortInfo.resultCode;
goto done;
}
/* 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:
|
| ︙ | ︙ | |||
3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 |
} else if (patDouble < objDouble) {
match = -1;
} else {
match = 1;
}
break;
}
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
*
| > > | 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 |
} 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
*
|
| ︙ | ︙ | |||
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 |
lower = i;
} else {
upper = i;
}
} else if (match > 0) {
if (isIncreasing) {
lower = i;
} else {
upper = i;
}
} else {
if (isIncreasing) {
upper = i;
} else {
lower = i;
}
}
}
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);
}
| > > > > > > > > | | | > | > | | > > > | | 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 |
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; listc < 0 || i < listc; i += groupSize) {
match = 0;
result = Tcl_ListObjIndex(interp, subjectPtr, i+groupOffset, &itemPtr);
if (result != TCL_OK) {
goto done;
}
Tcl_IncrRefCount(itemPtr);
if (sortInfo.indexc != 0) {
item2Ptr = SelectObjFromSublist(itemPtr, &sortInfo);
if (sortInfo.resultCode != TCL_OK) {
if (listPtr != NULL) {
Tcl_DecrRefCount(listPtr);
}
result = sortInfo.resultCode;
goto done;
}
/* 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:
|
| ︙ | ︙ | |||
3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 |
* Invert match condition for -not.
*/
if (negatedMatch) {
match = !match;
}
if (!match) {
continue;
}
if (!allMatches) {
index = i;
break;
} else if (inlineReturn) {
/*
| > > > > | > > > > > > | | < | > > > > > > > > | | > | | > > > | > > < < < > | | > > > > > | < > > > > > > > > > > | > > > > | > | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
* 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) {
/*
* 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_IncrRefCount(itemPtr);
item2Ptr = SelectObjFromSublist(itemPtr, &sortInfo);
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,
1, &itemPtr);
}
} else {
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;
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;
}
}
/*
* 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_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, item2Ptr);
} 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, listPtr);
} else {
result = Tcl_ListObjIndex(interp, subjectPtr, index, &itemPtr);
if (result != TCL_OK) {
goto done;
}
Tcl_SetObjResult(interp, itemPtr);
}
itemPtr = NULL;
}
result = TCL_OK;
/*
* Cleanup the index list array.
*/
done:
if (itemPtr != NULL) {
Tcl_DecrRefCount(itemPtr);
}
if (startPtr != NULL) {
Tcl_DecrRefCount(startPtr);
}
if (allocatedIndexVector) {
TclStackFree(interp, sortInfo.indexv);
}
return result;
}
/*
*----------------------------------------------------------------------
*
* 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(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,
"listVar ?index? ?index ...? value");
return TCL_ERROR;
}
/*
* Look up the list variable's value.
*/
listPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
if (listPtr == NULL) {
return TCL_ERROR;
}
/*
* 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 {
status = TclLsetFlat(interp, listPtr, objc-3, objv+2,
objv[objc-1], &finalValuePtr);
}
/*
* If substitution has failed, bail out.
*/
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);
if (listPtr == NULL) {
return TCL_ERROR;
}
/*
* Return the new value of the variable as the interpreter result.
*/
Tcl_SetObjResult(interp, listPtr);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* SequenceIdentifyArgument --
* (for [lseq] command)
*
|
| ︙ | ︙ | |||
4427 4428 4429 4430 4431 4432 4433 |
goto done;
break;
}
/*
* Success! Now lets create the series object.
*/
| | | > | > > > < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 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 |
goto done;
break;
}
/*
* Success! Now lets create the series object.
*/
arithSeriesPtr = TclNewArithSeriesObj(interp,
useDoubles, start, end, step, elementCount);
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]) Tcl_DecrRefCount(numValues[value_i]);
}
// Free constants
Tcl_DecrRefCount(zero);
Tcl_DecrRefCount(one);
return status;
}
/*
*----------------------------------------------------------------------
*
* Tcl_LsortObjCmd --
*
* This procedure is invoked to process the "lsort" Tcl command. See the
|
| ︙ | ︙ | |||
4567 4568 4569 4570 4571 4572 4573 |
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;
| | | | 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 |
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, 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
|
| ︙ | ︙ | |||
4784 4785 4786 4787 4788 4789 4790 | /* * 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] */ | | | 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 |
/*
* 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 = 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
|
| ︙ | ︙ | |||
4809 4810 4811 4812 4813 4814 4815 |
sortInfo.resultCode = TCL_ERROR;
goto done;
}
Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj());
sortInfo.compareCmdPtr = newCommandPtr;
}
| | > | | | 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 |
sortInfo.resultCode = TCL_ERROR;
goto done;
}
Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj());
sortInfo.compareCmdPtr = newCommandPtr;
}
if (TclObjectHasInterface(listObj, list, all)) {
TCL_UNUSEDVAR(int status);
sortInfo.resultCode = TclObjectDispatchNoDefault(interp, status,
listObj, list, all, interp, listObj, &length, &listObjPtrs);
} else {
sortInfo.resultCode = TclListObjGetElementsM(interp, listObj,
&length, &listObjPtrs);
}
if (sortInfo.resultCode != TCL_OK || length <= 0) {
goto done;
}
|
| ︙ | ︙ | |||
5005 5006 5007 5008 5009 5010 5011 |
ListRep listRep;
Tcl_Obj **newArray, *objPtr;
resultPtr = Tcl_NewListObj(sortInfo.numElements * groupSize, NULL);
ListObjGetRep(resultPtr, &listRep);
newArray = ListRepElementsBase(&listRep);
if (group) {
| | | 5173 5174 5175 5176 5177 5178 5179 5180 5181 5182 5183 5184 5185 5186 5187 |
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) {
idx = elementPtr->payload.index;
for (j = 0; j < groupSize; j++) {
if (indices) {
TclNewIndexObj(objPtr, idx + j - groupOffset);
newArray[i++] = objPtr;
Tcl_IncrRefCount(objPtr);
} else {
|
| ︙ | ︙ | |||
5133 5134 5135 5136 5137 5138 5139 |
first = listLen;
}
if (last >= listLen) {
last = listLen - 1;
}
if (first <= last) {
| | > | > > | 5301 5302 5303 5304 5305 5306 5307 5308 5309 5310 5311 5312 5313 5314 5315 5316 5317 5318 5319 5320 5321 5322 5323 5324 |
first = listLen;
}
if (last >= listLen) {
last = listLen - 1;
}
if (first <= last) {
numToDelete = last - first + 1;
} else {
numToDelete = 0;
}
if (Tcl_IsShared(listPtr)) {
listPtr = TclDuplicatePureObj(interp, listPtr, tclListTypePtr);
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 | /* | < < < < < < < > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 | /* * 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, |
| ︙ | ︙ | |||
1310 1311 1312 1313 1314 1315 1316 |
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,
| | | 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?");
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 |
Tcl_Size index, end;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "string charIndex");
return TCL_ERROR;
}
| > > > > > > > > > > > | | | | | | | | | | | | | | | | | | | | | | | | | | > | 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.
*/
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 (ch == -1) {
return TCL_OK;
}
/*
* 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);
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;
}
}
/*
*----------------------------------------------------------------------
*
* StringInsertCmd --
*
|
| ︙ | ︙ | |||
1606 1607 1608 1609 1610 1611 1612 |
break;
case STR_IS_ASCII:
chcomp = UniCharIsAscii;
break;
case STR_IS_BOOL:
case STR_IS_TRUE:
case STR_IS_FALSE:
| | | 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 |
break;
case STR_IS_ASCII:
chcomp = UniCharIsAscii;
break;
case STR_IS_BOOL:
case STR_IS_TRUE:
case STR_IS_FALSE:
if (!TclHasInternalRep(objPtr, tclBooleanType)
&& (TCL_OK != TclSetBooleanFromAny(NULL, objPtr))) {
if (strict) {
result = 0;
} else {
string1 = Tcl_GetStringFromObj(objPtr, &length1);
result = length1 == 0;
}
|
| ︙ | ︙ | |||
1675 1676 1677 1678 1679 1680 1681 |
}
break;
}
case STR_IS_DIGIT:
chcomp = Tcl_UniCharIsDigit;
break;
case STR_IS_DOUBLE: {
| | | | | 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 |
}
break;
}
case STR_IS_DIGIT:
chcomp = Tcl_UniCharIsDigit;
break;
case STR_IS_DOUBLE: {
if (TclHasInternalRep(objPtr, tclDoubleType) ||
TclHasInternalRep(objPtr, tclIntType) ||
TclHasInternalRep(objPtr, tclBignumType)) {
break;
}
string1 = Tcl_GetStringFromObj(objPtr, &length1);
if (length1 == 0) {
if (strict) {
result = 0;
}
|
| ︙ | ︙ | |||
1706 1707 1708 1709 1710 1711 1712 |
break;
}
case STR_IS_GRAPH:
chcomp = Tcl_UniCharIsGraph;
break;
case STR_IS_INT:
case STR_IS_ENTIER:
| | | | 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 |
break;
}
case STR_IS_GRAPH:
chcomp = Tcl_UniCharIsGraph;
break;
case STR_IS_INT:
case STR_IS_ENTIER:
if (TclHasInternalRep(objPtr, tclIntType) ||
TclHasInternalRep(objPtr, tclBignumType)) {
break;
}
string1 = Tcl_GetStringFromObj(objPtr, &length1);
if (length1 == 0) {
if (strict) {
result = 0;
}
|
| ︙ | ︙ | |||
1985 1986 1987 1988 1989 1990 1991 |
/*
* 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])
| | | 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 |
/*
* 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], 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.
|
| ︙ | ︙ | |||
2527 2528 2529 2530 2531 2532 2533 |
int delta = 0;
const Tcl_UniChar *next;
if (!Tcl_UniCharIsWordChar(ch)) {
break;
}
| | < > | 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 |
int delta = 0;
const Tcl_UniChar *next;
if (!Tcl_UniCharIsWordChar(ch)) {
break;
}
next = p > string ? p - 1 : p;
do {
next += delta;
delta = 1;
ch = *next;
} while (next + delta < p);
p = next;
}
if (cur != index) {
cur += 1;
}
}
|
| ︙ | ︙ |
Changes to generic/tclCompCmds.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 © 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:
*/
|
| ︙ | ︙ |
Changes to generic/tclCompCmdsGR.c.
1 | /* | < < < < < < > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 © 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 | * 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 | | | 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 *indexPtr.
*
*----------------------------------------------------------------------
*/
int
TclGetIndexFromToken(
Tcl_Token *tokenPtr,
|
| ︙ | ︙ | |||
1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 |
TCL_UNUSED(Command *),
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
int i;
if (parsePtr->numWords < 4) {
return TCL_ERROR;
}
/* Push list, first, last onto the stack */
tokenPtr = TokenAfter(parsePtr->tokenPtr);
CompileWord(envPtr, tokenPtr, interp, 1);
| > > > > > > > | 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 |
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);
|
| ︙ | ︙ |
Changes to generic/tclCompCmdsSZ.c.
1 | /* | < < < < < < < > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 © 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:
*/
|
| ︙ | ︙ |
Changes to generic/tclCompExpr.c.
1 2 3 4 5 6 | /* * 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::+ . | > > > > > > > > > > > > > > > > < < < < < | 1 2 3 4 5 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::+ . */ #include "tclInt.h" #include "tclCompile.h" /* CompileEnv */ /* * Expression parsing takes place in the routine ParseExpr(). It takes a |
| ︙ | ︙ | |||
2107 2108 2109 2110 2111 2112 2113 | /* * 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] */ | | | 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)) {
const char *p = start;
while (p < end) {
if (!TclIsBareword(*p++)) {
/*
* The number has non-bareword characters, so we
* must treat it as a number.
|
| ︙ | ︙ |
Changes to generic/tclCompile.c.
1 | /* | < < < < < < > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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-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 |
const Tcl_ObjType tclByteCodeType = {
"bytecode", /* name */
FreeByteCodeInternalRep, /* freeIntRepProc */
DupByteCodeInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
SetByteCodeFromAny, /* setFromAnyProc */
| < > < > | 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 */
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 */
0
};
#define SubstFlags(objPtr) (objPtr)->internalRep.twoPtrValue.ptr2
/*
* Helper macros.
*/
|
| ︙ | ︙ |
Changes to generic/tclCompile.h.
1 | /* | < < > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 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 (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. */ |
| ︙ | ︙ | |||
286 287 288 289 290 291 292 |
* compiled. Commands and their compile procs
* are specific to an interpreter so the code
* emitted will depend on the interpreter. */
const char *source; /* The source string being compiled by
* SetByteCodeFromAny. This pointer is not
* owned by the CompileEnv and must not be
* freed or changed by it. */
| | | | > | | | > | | < < | < < < < < < < < | | | 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 |
* compiled. Commands and their compile procs
* are specific to an interpreter so the code
* emitted will depend on the interpreter. */
const char *source; /* The source string being compiled by
* SetByteCodeFromAny. This pointer is not
* owned by the CompileEnv and must not be
* freed or changed by it. */
Tcl_Size numSrcBytes; /* Number of bytes in source. */
Proc *procPtr; /* If a procedure is being compiled, a pointer
* to its Proc structure; otherwise NULL. Used
* to compile local variables. Set from
* information provided by ObjInterpProc in
* tclProc.c. */
Tcl_Size numCommands; /* Number of commands compiled. */
Tcl_Size exceptDepth; /* Current exception range nesting level;
* TCL_INDEX_NONE if not in any range
* currently. */
Tcl_Size maxExceptDepth; /* Max nesting level of exception ranges;
* TCL_INDEX_NONE if no ranges have been
* compiled. */
Tcl_Size maxStackDepth; /* Maximum number of stack elements needed to
* execute the code. Set by compilation
* procedures before returning. */
Tcl_Size currStackDepth; /* Current stack depth. */
LiteralTable localLitTable; /* Contains LiteralEntry's describing all Tcl
* objects referenced by this compiled code.
* Indexed by the string representations of
* the literals. Used to avoid creating
* 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.*/
int mallocedExceptArray; /* 1 if ExceptionRange array was expanded and
* exceptArrayPtr points in heap, else 0. */
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. */
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. */
int mallocedAuxDataArray; /* 1 if aux data array was expanded and
* auxDataArrayPtr points in heap else 0. */
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. */
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];
/* Initial static except auxiliary info array
* storage. */
CmdLocation staticCmdMapSpace[COMPILEENV_INIT_CMD_MAP_SIZE];
/* Initial storage for cmd location map. */
AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE];
/* Initial storage for aux data array. */
/* TIP #280 */
ExtCmdLoc *extCmdMapPtr; /* Extended command location information for
* 'info frame'. */
Tcl_Size line; /* First line of the script, based on the
* invoking context, then the line of the
* command currently compiled. */
int atCmdStart; /* Flag to say whether an INST_START_CMD
* should be issued; they should never be
* issued repeatedly, as that is significantly
* inefficient. If set to 2, that instruction
* should not be issued at all (by the generic
* part of the command compiler). */
Tcl_Size expandCount; /* Number of INST_EXPAND_START instructions
* encountered that have not yet been paired
* with a corresponding
* INST_INVOKE_EXPANDED. */
Tcl_Size *clNext; /* If not NULL, it refers to the next slot in
* clLoc to check for an invisible
* continuation line. */
} CompileEnv;
|
| ︙ | ︙ | |||
1064 1065 1066 1067 1068 1069 1070 | /* *---------------------------------------------------------------- * Procedures exported by tclBasic.c to be used within the engine. *---------------------------------------------------------------- */ | < | 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 | /* *---------------------------------------------------------------- * Procedures exported by tclBasic.c to be used within the engine. *---------------------------------------------------------------- */ MODULE_SCOPE Tcl_ObjCmdProc TclNRInterpCoroutine; /* *---------------------------------------------------------------- * Procedures exported by the engine to be used by tclBasic.c *---------------------------------------------------------------- */ |
| ︙ | ︙ | |||
1203 1204 1205 1206 1207 1208 1209 | 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); | < < < | 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 | 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); /* *---------------------------------------------------------------- * Macros and flag values used by Tcl bytecode compilation and execution * modules inside the Tcl core but not used outside. *---------------------------------------------------------------- */ |
| ︙ | ︙ |
Changes to generic/tclConfig.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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 © 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 |
| ︙ | ︙ |
Changes to generic/tclDTrace.d.
1 | /* | < < < < > > > > | > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 (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.
*/
/*
* 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/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 | /* * 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. */ #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) | > > > > > > > > > < < | | 1 2 3 4 5 6 7 8 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) #else # 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. |
| ︙ | ︙ | |||
1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 |
Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr);
/* 685 */
EXTERN Tcl_Obj * Tcl_DStringToObj(Tcl_DString *dsPtr);
/* Slot 686 is reserved */
/* Slot 687 is reserved */
/* 688 */
EXTERN void TclUnusedStubEntry(void);
typedef struct {
const struct TclPlatStubs *tclPlatStubs;
const struct TclIntStubs *tclIntStubs;
const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr);
/* 685 */
EXTERN Tcl_Obj * Tcl_DStringToObj(Tcl_DString *dsPtr);
/* Slot 686 is reserved */
/* Slot 687 is reserved */
/* 688 */
EXTERN void TclUnusedStubEntry(void);
/* 689 */
EXTERN Tcl_ObjInterface * Tcl_NewObjInterface(void);
/* 690 */
EXTERN Tcl_ObjType * Tcl_NewObjType(void);
/* 691 */
EXTERN int Tcl_ObjInterfaceSetVersion(Tcl_ObjInterface *oiPtr,
int version);
/* 692 */
EXTERN int Tcl_ObjTypeSetFreeInternalRepProc(Tcl_ObjType *otPtr,
Tcl_FreeInternalRepProc *freeIntRepProc);
/* 693 */
EXTERN int Tcl_ObjTypeSetDupInternalRepProc(Tcl_ObjType *otPtr,
Tcl_DupInternalRepProc *dupIntRepProc);
/* 694 */
EXTERN int Tcl_ObjTypeSetUpdateStringProc(Tcl_ObjType *otPtr,
Tcl_UpdateStringProc *updateStringProc);
/* 695 */
EXTERN int Tcl_ObjTypeSetSetFromAnyProc(Tcl_ObjType *otPtr,
Tcl_SetFromAnyProc *setFromAnyProc);
/* 696 */
EXTERN int Tcl_ObjTypeSetVersion(Tcl_ObjType *otPtr,
int version);
/* 697 */
EXTERN int Tcl_ObjInterfaceSetFnListAll(Tcl_ObjInterface *oiPtr,
Tcl_ObjInterfaceListAllProc *fnPtr);
/* 698 */
EXTERN int Tcl_ObjInterfaceSetFnListAppend(
Tcl_ObjInterface *oiPtr,
Tcl_ObjInterfaceListAppendProc *fnPtr);
/* 699 */
EXTERN int Tcl_ObjInterfaceSetFnListAppendList(
Tcl_ObjInterface *oiPtr,
Tcl_ObjInterfaceListAppendlistProc fnPtr);
/* 700 */
EXTERN int Tcl_ObjInterfaceSetFnListIndex(
Tcl_ObjInterface *oiPtr,
Tcl_ObjInterfaceListIndexProc fnPtr);
/* 701 */
EXTERN int Tcl_ObjInterfaceSetFnListIndexEnd(
Tcl_ObjInterface *oiPtr,
Tcl_ObjInterfaceListIndexEndProc fnPtr);
/* 702 */
EXTERN int Tcl_ObjInterfaceSetFnListIsSorted(
Tcl_ObjInterface *oiPtr,
Tcl_ObjInterfaceListIsSortedProc fnPtr);
/* 703 */
EXTERN int Tcl_ObjInterfaceSetFnListLength(
Tcl_ObjInterface *oiPtr,
Tcl_ObjInterfaceListlengthProc fnPtr);
/* 704 */
EXTERN int Tcl_ObjInterfaceSetFnListRange(
Tcl_ObjInterface *oiPtr,
Tcl_ObjInterfaceListRangeProc fnPtr);
/* 705 */
EXTERN int Tcl_ObjInterfaceSetFnListRangeEnd(
Tcl_ObjInterface *oiPtr,
Tcl_ObjInterfaceListRangeEndProc fnPtr);
/* 706 */
EXTERN int Tcl_ObjInterfaceSetFnListReplace(
Tcl_ObjInterface *oiPtr,
Tcl_ObjInterfaceListReplaceProc fnPtr);
/* 707 */
EXTERN int Tcl_ObjInterfaceSetFnListReplaceList(
Tcl_ObjInterface *oiPtr,
Tcl_ObjInterfaceListReplaceListProc fnPtr);
/* 708 */
EXTERN int Tcl_ObjInterfaceSetFnListReverse(
Tcl_ObjInterface *objInterfacePtr,
Tcl_ObjInterfaceListReverseProc fnPtr);
/* 709 */
EXTERN int Tcl_ObjInterfaceSetFnListSet(Tcl_ObjInterface *oiPtr,
Tcl_ObjInterfaceListSetProc fnPtr);
/* 710 */
EXTERN int Tcl_ObjInterfaceSetFnListSetDeep(
Tcl_ObjInterface *oiPtr,
Tcl_ObjInterfaceListSetDeepProc fnPtr);
/* 711 */
EXTERN int Tcl_ObjInterfaceSetFnStringIndex(
Tcl_ObjInterface *oiPtr,
Tcl_ObjInterfaceStringIndexProc fnPtr);
/* 712 */
EXTERN int Tcl_ObjInterfaceSetFnStringIndexEnd(
Tcl_ObjInterface *oiPtr,
Tcl_ObjInterfaceStringIndexEndProc fnPtr);
/* 713 */
EXTERN int Tcl_ObjInterfaceSetFnStringLength(
Tcl_ObjInterface *oiPtr,
Tcl_ObjInterfaceStringLengthProc fnPtr);
/* 714 */
EXTERN int Tcl_ObjInterfaceSetFnStringRange(
Tcl_ObjInterface *oiPtr,
Tcl_ObjInterfaceStringRangeProc fnPtr);
/* 715 */
EXTERN int Tcl_ObjInterfaceSetFnStringRangeEnd(
Tcl_ObjInterface *oiPtr,
Tcl_ObjInterfaceStringRangeEndProc fnPtr);
/* 716 */
EXTERN int Tcl_ObjTypeSetInterface(Tcl_ObjType *objTypePtr,
Tcl_ObjInterface *objInterfacePtr);
/* 717 */
EXTERN int Tcl_ObjTypeSetName(Tcl_ObjType *objTypePtr,
char *name);
/* 718 */
EXTERN int Tcl_ObjInterfaceSetFnStringIsEmpty(
Tcl_ObjInterface *oiPtr,
Tcl_ObjInterfaceStringIsEmptyProc fnPtr);
/* 719 */
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;
|
| ︙ | ︙ | |||
2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 |
int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */
Tcl_Size (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */
int (*tcl_GetWideUIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 684 */
Tcl_Obj * (*tcl_DStringToObj) (Tcl_DString *dsPtr); /* 685 */
void (*reserved686)(void);
void (*reserved687)(void);
void (*tclUnusedStubEntry) (void); /* 688 */
} TclStubs;
extern const TclStubs *tclStubsPtr;
#ifdef __cplusplus
}
#endif
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */
Tcl_Size (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */
int (*tcl_GetWideUIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 684 */
Tcl_Obj * (*tcl_DStringToObj) (Tcl_DString *dsPtr); /* 685 */
void (*reserved686)(void);
void (*reserved687)(void);
void (*tclUnusedStubEntry) (void); /* 688 */
Tcl_ObjInterface * (*tcl_NewObjInterface) (void); /* 689 */
Tcl_ObjType * (*tcl_NewObjType) (void); /* 690 */
int (*tcl_ObjInterfaceSetVersion) (Tcl_ObjInterface *oiPtr, int version); /* 691 */
int (*tcl_ObjTypeSetFreeInternalRepProc) (Tcl_ObjType *otPtr, Tcl_FreeInternalRepProc *freeIntRepProc); /* 692 */
int (*tcl_ObjTypeSetDupInternalRepProc) (Tcl_ObjType *otPtr, Tcl_DupInternalRepProc *dupIntRepProc); /* 693 */
int (*tcl_ObjTypeSetUpdateStringProc) (Tcl_ObjType *otPtr, Tcl_UpdateStringProc *updateStringProc); /* 694 */
int (*tcl_ObjTypeSetSetFromAnyProc) (Tcl_ObjType *otPtr, Tcl_SetFromAnyProc *setFromAnyProc); /* 695 */
int (*tcl_ObjTypeSetVersion) (Tcl_ObjType *otPtr, int version); /* 696 */
int (*tcl_ObjInterfaceSetFnListAll) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListAllProc *fnPtr); /* 697 */
int (*tcl_ObjInterfaceSetFnListAppend) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListAppendProc *fnPtr); /* 698 */
int (*tcl_ObjInterfaceSetFnListAppendList) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListAppendlistProc fnPtr); /* 699 */
int (*tcl_ObjInterfaceSetFnListIndex) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListIndexProc fnPtr); /* 700 */
int (*tcl_ObjInterfaceSetFnListIndexEnd) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListIndexEndProc fnPtr); /* 701 */
int (*tcl_ObjInterfaceSetFnListIsSorted) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListIsSortedProc fnPtr); /* 702 */
int (*tcl_ObjInterfaceSetFnListLength) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListlengthProc fnPtr); /* 703 */
int (*tcl_ObjInterfaceSetFnListRange) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListRangeProc fnPtr); /* 704 */
int (*tcl_ObjInterfaceSetFnListRangeEnd) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListRangeEndProc fnPtr); /* 705 */
int (*tcl_ObjInterfaceSetFnListReplace) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListReplaceProc fnPtr); /* 706 */
int (*tcl_ObjInterfaceSetFnListReplaceList) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListReplaceListProc fnPtr); /* 707 */
int (*tcl_ObjInterfaceSetFnListReverse) (Tcl_ObjInterface *objInterfacePtr, Tcl_ObjInterfaceListReverseProc fnPtr); /* 708 */
int (*tcl_ObjInterfaceSetFnListSet) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListSetProc fnPtr); /* 709 */
int (*tcl_ObjInterfaceSetFnListSetDeep) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListSetDeepProc fnPtr); /* 710 */
int (*tcl_ObjInterfaceSetFnStringIndex) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceStringIndexProc fnPtr); /* 711 */
int (*tcl_ObjInterfaceSetFnStringIndexEnd) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceStringIndexEndProc fnPtr); /* 712 */
int (*tcl_ObjInterfaceSetFnStringLength) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceStringLengthProc fnPtr); /* 713 */
int (*tcl_ObjInterfaceSetFnStringRange) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceStringRangeProc fnPtr); /* 714 */
int (*tcl_ObjInterfaceSetFnStringRangeEnd) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceStringRangeEndProc fnPtr); /* 715 */
int (*tcl_ObjTypeSetInterface) (Tcl_ObjType *objTypePtr, Tcl_ObjInterface *objInterfacePtr); /* 716 */
int (*tcl_ObjTypeSetName) (Tcl_ObjType *objTypePtr, char *name); /* 717 */
int (*tcl_ObjInterfaceSetFnStringIsEmpty) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceStringIsEmptyProc fnPtr); /* 718 */
int (*tcl_ObjInterfaceSetFnListContains) (Tcl_ObjInterface *oiPtr, Tcl_ObjInterfaceListContainsProc fnPtr); /* 719 */
} TclStubs;
extern const TclStubs *tclStubsPtr;
#ifdef __cplusplus
}
#endif
|
| ︙ | ︙ | |||
3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 | (tclStubsPtr->tcl_GetWideUIntFromObj) /* 684 */ #define Tcl_DStringToObj \ (tclStubsPtr->tcl_DStringToObj) /* 685 */ /* Slot 686 is reserved */ /* Slot 687 is reserved */ #define TclUnusedStubEntry \ (tclStubsPtr->tclUnusedStubEntry) /* 688 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #undef TclUnusedStubEntry | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | (tclStubsPtr->tcl_GetWideUIntFromObj) /* 684 */ #define Tcl_DStringToObj \ (tclStubsPtr->tcl_DStringToObj) /* 685 */ /* Slot 686 is reserved */ /* Slot 687 is reserved */ #define TclUnusedStubEntry \ (tclStubsPtr->tclUnusedStubEntry) /* 688 */ #define Tcl_NewObjInterface \ (tclStubsPtr->tcl_NewObjInterface) /* 689 */ #define Tcl_NewObjType \ (tclStubsPtr->tcl_NewObjType) /* 690 */ #define Tcl_ObjInterfaceSetVersion \ (tclStubsPtr->tcl_ObjInterfaceSetVersion) /* 691 */ #define Tcl_ObjTypeSetFreeInternalRepProc \ (tclStubsPtr->tcl_ObjTypeSetFreeInternalRepProc) /* 692 */ #define Tcl_ObjTypeSetDupInternalRepProc \ (tclStubsPtr->tcl_ObjTypeSetDupInternalRepProc) /* 693 */ #define Tcl_ObjTypeSetUpdateStringProc \ (tclStubsPtr->tcl_ObjTypeSetUpdateStringProc) /* 694 */ #define Tcl_ObjTypeSetSetFromAnyProc \ (tclStubsPtr->tcl_ObjTypeSetSetFromAnyProc) /* 695 */ #define Tcl_ObjTypeSetVersion \ (tclStubsPtr->tcl_ObjTypeSetVersion) /* 696 */ #define Tcl_ObjInterfaceSetFnListAll \ (tclStubsPtr->tcl_ObjInterfaceSetFnListAll) /* 697 */ #define Tcl_ObjInterfaceSetFnListAppend \ (tclStubsPtr->tcl_ObjInterfaceSetFnListAppend) /* 698 */ #define Tcl_ObjInterfaceSetFnListAppendList \ (tclStubsPtr->tcl_ObjInterfaceSetFnListAppendList) /* 699 */ #define Tcl_ObjInterfaceSetFnListIndex \ (tclStubsPtr->tcl_ObjInterfaceSetFnListIndex) /* 700 */ #define Tcl_ObjInterfaceSetFnListIndexEnd \ (tclStubsPtr->tcl_ObjInterfaceSetFnListIndexEnd) /* 701 */ #define Tcl_ObjInterfaceSetFnListIsSorted \ (tclStubsPtr->tcl_ObjInterfaceSetFnListIsSorted) /* 702 */ #define Tcl_ObjInterfaceSetFnListLength \ (tclStubsPtr->tcl_ObjInterfaceSetFnListLength) /* 703 */ #define Tcl_ObjInterfaceSetFnListRange \ (tclStubsPtr->tcl_ObjInterfaceSetFnListRange) /* 704 */ #define Tcl_ObjInterfaceSetFnListRangeEnd \ (tclStubsPtr->tcl_ObjInterfaceSetFnListRangeEnd) /* 705 */ #define Tcl_ObjInterfaceSetFnListReplace \ (tclStubsPtr->tcl_ObjInterfaceSetFnListReplace) /* 706 */ #define Tcl_ObjInterfaceSetFnListReplaceList \ (tclStubsPtr->tcl_ObjInterfaceSetFnListReplaceList) /* 707 */ #define Tcl_ObjInterfaceSetFnListReverse \ (tclStubsPtr->tcl_ObjInterfaceSetFnListReverse) /* 708 */ #define Tcl_ObjInterfaceSetFnListSet \ (tclStubsPtr->tcl_ObjInterfaceSetFnListSet) /* 709 */ #define Tcl_ObjInterfaceSetFnListSetDeep \ (tclStubsPtr->tcl_ObjInterfaceSetFnListSetDeep) /* 710 */ #define Tcl_ObjInterfaceSetFnStringIndex \ (tclStubsPtr->tcl_ObjInterfaceSetFnStringIndex) /* 711 */ #define Tcl_ObjInterfaceSetFnStringIndexEnd \ (tclStubsPtr->tcl_ObjInterfaceSetFnStringIndexEnd) /* 712 */ #define Tcl_ObjInterfaceSetFnStringLength \ (tclStubsPtr->tcl_ObjInterfaceSetFnStringLength) /* 713 */ #define Tcl_ObjInterfaceSetFnStringRange \ (tclStubsPtr->tcl_ObjInterfaceSetFnStringRange) /* 714 */ #define Tcl_ObjInterfaceSetFnStringRangeEnd \ (tclStubsPtr->tcl_ObjInterfaceSetFnStringRangeEnd) /* 715 */ #define Tcl_ObjTypeSetInterface \ (tclStubsPtr->tcl_ObjTypeSetInterface) /* 716 */ #define Tcl_ObjTypeSetName \ (tclStubsPtr->tcl_ObjTypeSetName) /* 717 */ #define Tcl_ObjInterfaceSetFnStringIsEmpty \ (tclStubsPtr->tcl_ObjInterfaceSetFnStringIsEmpty) /* 718 */ #define Tcl_ObjInterfaceSetFnListContains \ (tclStubsPtr->tcl_ObjInterfaceSetFnListContains) /* 719 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #undef TclUnusedStubEntry |
| ︙ | ︙ | |||
4021 4022 4023 4024 4025 4026 4027 |
#ifdef __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];}),
#else
# define TCLBOOLWARNING(boolPtr)
#endif
#if defined(USE_TCL_STUBS)
| | > | > | | < | > > > > > < < < | < < | < | | 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 |
#ifdef __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];}),
#else
# define TCLBOOLWARNING(boolPtr)
#endif
#if defined(USE_TCL_STUBS)
#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) \
(Tcl_GetBoolFromObj(interp, objPtr,\
(TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
#define Tcl_GetBoolean(interp, src, boolPtr) \
(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
#undef Tcl_GetByteArrayFromObj
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
(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
|
| ︙ | ︙ | |||
4068 4069 4070 4071 4072 4073 4074 | #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) | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 | #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 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) |
| ︙ | ︙ | |||
4135 4136 4137 4138 4139 4140 4141 |
*/
#define Tcl_EvalObj(interp, objPtr) \
Tcl_EvalObjEx(interp, objPtr, 0)
#define Tcl_GlobalEvalObj(interp, objPtr) \
Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)
| < | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 |
*/
#define Tcl_EvalObj(interp, objPtr) \
Tcl_EvalObjEx(interp, objPtr, 0)
#define Tcl_GlobalEvalObj(interp, objPtr) \
Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)
# undef Tcl_Close
# define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)
#undef TclUtfCharComplete
#undef TclUtfNext
#undef TclUtfPrev
#endif /* _TCLDECLS */
|
Changes to generic/tclDictObj.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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 © 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. */ /* * You may distribute and/or modify this program under the terms of the GNU * Affero General Public License as published by the Free Software Foundation, * either version 3 of the License, or (at your 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. */ |
| ︙ | ︙ | |||
57 58 59 60 61 62 63 | Tcl_Obj *keyPtr); static Tcl_NRPostProc FinalizeDictUpdate; static Tcl_NRPostProc FinalizeDictWith; static Tcl_ObjCmdProc DictForNRCmd; static Tcl_ObjCmdProc DictMapNRCmd; static Tcl_NRPostProc DictForLoopCallback; static Tcl_NRPostProc DictMapLoopCallback; | | > | | 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 |
Tcl_Obj *keyPtr);
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 },
|
| ︙ | ︙ | |||
139 140 141 142 143 144 145 | } Dict; /* * The structure below defines the dictionary object type by means of * functions that can be invoked by generic object code. */ | | > > > > > | < < < < < | < < < < < > > | | | | | | | 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 |
} Dict;
/*
* The structure below defines the dictionary object type by means of
* functions that can be invoked by generic object code.
*/
ObjInterface dictObjInterface;
static ObjectType tclDictObjectType = {
"dict",
FreeDictInternalRep, /* freeIntRepProc */
DupDictInternalRep, /* dupIntRepProc */
UpdateStringOfDict, /* updateStringProc */
SetDictFromAny, /* setFromAnyProc */
2,
NULL
};
Tcl_ObjType *tclDictTypePtr = (Tcl_ObjType *)&tclDictObjectType;
#define DictSetIntRep(objPtr, dictRepPtr) \
do { \
Tcl_ObjInternalRep ir; \
ir.twoPtrValue.ptr1 = (dictRepPtr); \
ir.twoPtrValue.ptr2 = NULL; \
Tcl_StoreInternalRep((objPtr), tclDictTypePtr, &ir); \
} while (0)
#define DictGetInternalRep(objPtr, dictRepPtr) \
do { \
const Tcl_ObjInternalRep *irPtr; \
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.
|
| ︙ | ︙ | |||
209 210 211 212 213 214 215 216 217 218 219 220 221 222 |
* 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;
/***** START OF FUNCTIONS IMPLEMENTING DICT CORE API *****/
/*
*----------------------------------------------------------------------
*
* AllocChainEntry --
| > > > > > > > > > | 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 |
* 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 --
|
| ︙ | ︙ | |||
405 406 407 408 409 410 411 |
newDict->chain = NULL;
newDict->refCount = 1;
/*
* Store in the object.
*/
| | | 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 |
newDict->chain = NULL;
newDict->refCount = 1;
/*
* Store in the object.
*/
DictSetIntRep(copyPtr, newDict);
}
/*
*----------------------------------------------------------------------
*
* FreeDictInternalRep --
*
|
| ︙ | ︙ | |||
612 613 614 615 616 617 618 |
/*
* 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.
*/
| | | 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 |
/*
* 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, tclListTypePtr)) {
Tcl_Size objc, i;
Tcl_Obj **objv;
/* Cannot fail, we already know the Tcl_ObjType is "list". */
TclListObjGetElementsM(NULL, objPtr, &objc, &objv);
if (objc & 1) {
goto missingValue;
|
| ︙ | ︙ | |||
720 721 722 723 724 725 726 |
* as possible to allow the conversion code, in particular
* Tcl_GetStringFromObj, to use that old internalRep.
*/
dict->epoch = 1;
dict->chain = NULL;
dict->refCount = 1;
| | | 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 |
* as possible to allow the conversion code, in particular
* Tcl_GetStringFromObj, to use that old internalRep.
*/
dict->epoch = 1;
dict->chain = NULL;
dict->refCount = 1;
DictSetIntRep(objPtr, dict);
return TCL_OK;
missingValue:
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing value to go with key", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", (void *)NULL);
|
| ︙ | ︙ | |||
899 900 901 902 903 904 905 |
DictGetInternalRep(dictObj, dict);
assert( dict != NULL);
do {
dict->refCount++;
TclInvalidateStringRep(dictObj);
TclFreeInternalRep(dictObj);
| | | 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 |
DictGetInternalRep(dictObj, dict);
assert( dict != NULL);
do {
dict->refCount++;
TclInvalidateStringRep(dictObj);
TclFreeInternalRep(dictObj);
DictSetIntRep(dictObj, dict);
dict->epoch++;
dictObj = dict->chain;
if (dictObj == NULL) {
break;
}
dict->chain = NULL;
|
| ︙ | ︙ | |||
954 955 956 957 958 959 960 |
return TCL_ERROR;
}
TclInvalidateStringRep(dictPtr);
hPtr = CreateChainEntry(dict, keyPtr, &isNew);
dict->refCount++;
TclFreeInternalRep(dictPtr)
| | | 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 |
return TCL_ERROR;
}
TclInvalidateStringRep(dictPtr);
hPtr = CreateChainEntry(dict, keyPtr, &isNew);
dict->refCount++;
TclFreeInternalRep(dictPtr)
DictSetIntRep(dictPtr, dict);
Tcl_IncrRefCount(valuePtr);
if (!isNew) {
Tcl_Obj *oldValuePtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
TclDecrRefCount(oldValuePtr);
}
Tcl_SetHashValue(hPtr, valuePtr);
|
| ︙ | ︙ | |||
1435 1436 1437 1438 1439 1440 1441 |
TclNewObj(dictPtr);
TclInvalidateStringRep(dictPtr);
dict = (Dict *)Tcl_Alloc(sizeof(Dict));
InitChainTable(dict);
dict->epoch = 1;
dict->chain = NULL;
dict->refCount = 1;
| | | 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 |
TclNewObj(dictPtr);
TclInvalidateStringRep(dictPtr);
dict = (Dict *)Tcl_Alloc(sizeof(Dict));
InitChainTable(dict);
dict->epoch = 1;
dict->chain = NULL;
dict->refCount = 1;
DictSetIntRep(dictPtr, dict);
return dictPtr;
#endif
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
1483 1484 1485 1486 1487 1488 1489 |
TclDbNewObj(dictPtr, file, line);
TclInvalidateStringRep(dictPtr);
dict = (Dict *)Tcl_Alloc(sizeof(Dict));
InitChainTable(dict);
dict->epoch = 1;
dict->chain = NULL;
dict->refCount = 1;
| | | 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 |
TclDbNewObj(dictPtr, file, line);
TclInvalidateStringRep(dictPtr);
dict = (Dict *)Tcl_Alloc(sizeof(Dict));
InitChainTable(dict);
dict->epoch = 1;
dict->chain = NULL;
dict->refCount = 1;
DictSetIntRep(dictPtr, dict);
return dictPtr;
}
#else /* !TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_DbNewDictObj(
TCL_UNUSED(const char *) /*file*/,
TCL_UNUSED(int) /*line*/)
|
| ︙ | ︙ | |||
1518 1519 1520 1521 1522 1523 1524 | * See the user documentation. * *---------------------------------------------------------------------- */ static int DictCreateCmd( | | | 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 |
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
DictCreateCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictObj;
int i;
|
| ︙ | ︙ | |||
1568 1569 1570 1571 1572 1573 1574 | * See the user documentation. * *---------------------------------------------------------------------- */ static int DictGetCmd( | | | 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 |
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
DictGetCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr = NULL;
int result;
|
| ︙ | ︙ | |||
1661 1662 1663 1664 1665 1666 1667 | * See the user documentation. * *---------------------------------------------------------------------- */ static int DictGetDefCmd( | | | 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 |
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
DictGetDefCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *keyPtr, *valuePtr, *defaultPtr;
Tcl_Obj *const *keyPath;
int numKeys;
|
| ︙ | ︙ | |||
1726 1727 1728 1729 1730 1731 1732 | * See the user documentation. * *---------------------------------------------------------------------- */ static int DictReplaceCmd( | | | 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 |
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
DictReplaceCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr;
int i;
|
| ︙ | ︙ | |||
1774 1775 1776 1777 1778 1779 1780 | * See the user documentation. * *---------------------------------------------------------------------- */ static int DictRemoveCmd( | | | 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 |
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
DictRemoveCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr;
int i;
|
| ︙ | ︙ | |||
1822 1823 1824 1825 1826 1827 1828 | * See the user documentation. * *---------------------------------------------------------------------- */ static int DictMergeCmd( | | | 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 |
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
DictMergeCmd(
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;
|
| ︙ | ︙ | |||
1909 1910 1911 1912 1913 1914 1915 | * See the user documentation. * *---------------------------------------------------------------------- */ static int DictKeysCmd( | | | 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 |
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
DictKeysCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *listPtr;
const char *pattern = NULL;
|
| ︙ | ︙ | |||
1988 1989 1990 1991 1992 1993 1994 | * See the user documentation. * *---------------------------------------------------------------------- */ static int DictValuesCmd( | | | 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 |
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
DictValuesCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *valuePtr = NULL, *listPtr;
Tcl_DictSearch search;
int done;
|
| ︙ | ︙ | |||
2048 2049 2050 2051 2052 2053 2054 | * See the user documentation. * *---------------------------------------------------------------------- */ static int DictSizeCmd( | | | 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 |
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
DictSizeCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
int result;
Tcl_Size size;
|
| ︙ | ︙ | |||
2087 2088 2089 2090 2091 2092 2093 | * See the user documentation. * *---------------------------------------------------------------------- */ static int DictExistsCmd( | | | 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 |
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
DictExistsCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr;
if (objc < 3) {
|
| ︙ | ︙ | |||
2129 2130 2131 2132 2133 2134 2135 | * See the user documentation. * *---------------------------------------------------------------------- */ static int DictInfoCmd( | | | 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 |
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
DictInfoCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
Dict *dict;
char *statsStr;
|
| ︙ | ︙ | |||
2173 2174 2175 2176 2177 2178 2179 | * See the user documentation. * *---------------------------------------------------------------------- */ static int DictIncrCmd( | | | 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 |
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
DictIncrCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
int code = TCL_OK;
Tcl_Obj *dictPtr, *valuePtr = NULL;
|
| ︙ | ︙ | |||
2294 2295 2296 2297 2298 2299 2300 | * See the user documentation. * *---------------------------------------------------------------------- */ static int DictLappendCmd( | | | 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 |
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
DictLappendCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
int i, allocatedDict = 0, allocatedValue = 0;
|
| ︙ | ︙ | |||
2381 2382 2383 2384 2385 2386 2387 | * See the user documentation. * *---------------------------------------------------------------------- */ static int DictAppendCmd( | | | 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 |
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
DictAppendCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
int allocatedDict = 0;
|
| ︙ | ︙ | |||
2483 2484 2485 2486 2487 2488 2489 | * See the user documentation. * *---------------------------------------------------------------------- */ static int DictForNRCmd( | | | 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 |
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
DictForNRCmd(
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;
|
| ︙ | ︙ | |||
2679 2680 2681 2682 2683 2684 2685 | * See the user documentation. * *---------------------------------------------------------------------- */ static int DictMapNRCmd( | | | 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 |
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
DictMapNRCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj **varv, *keyObj, *valueObj;
DictMapStorage *storagePtr;
|
| ︙ | ︙ | |||
2892 2893 2894 2895 2896 2897 2898 | * See the user documentation. * *---------------------------------------------------------------------- */ static int DictSetCmd( | | | 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 |
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
DictSetCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *resultPtr;
int result, allocatedDict = 0;
|
| ︙ | ︙ | |||
2952 2953 2954 2955 2956 2957 2958 | * See the user documentation. * *---------------------------------------------------------------------- */ static int DictUnsetCmd( | | | 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 |
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
DictUnsetCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *resultPtr;
int result, allocatedDict = 0;
|
| ︙ | ︙ | |||
3011 3012 3013 3014 3015 3016 3017 | * See the user documentation. * *---------------------------------------------------------------------- */ static int DictFilterCmd( | | | 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 |
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
DictFilterCmd(
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
|
| ︙ | ︙ | |||
3297 3298 3299 3300 3301 3302 3303 | * See the user documentation. * *---------------------------------------------------------------------- */ static int DictUpdateCmd( | | | 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 |
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
DictUpdateCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *dictPtr, *objPtr;
int i;
|
| ︙ | ︙ | |||
3456 3457 3458 3459 3460 3461 3462 | * See the user documentation. * *---------------------------------------------------------------------- */ static int DictWithCmd( | | | 3474 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 3487 3488 |
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
DictWithCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *dictPtr, *keysPtr, *pathPtr;
|
| ︙ | ︙ | |||
3811 3812 3813 3814 3815 3816 3817 3818 3819 | * * 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 intent is to have no side effects. */ | > > > > | > | > > | | > > | > | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | < | < | < < < < < < < < < | 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 |
*
* 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 intent is to have no side effects.
*
* Reviewer note: Currently, however there is the side effect that the
* string representation of the dictionary is generated if there isn't one
* already.
*/
static int
DictAsListLength(
TCL_UNUSED(Tcl_Interp *),
Tcl_Obj *objPtr,
Tcl_Size *lenPtr)
{
Tcl_Size estCount, length, llen;
const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length);
Tcl_Obj *elemPtr;
int status = TCL_OK;
/*
* Allocate enough space to hold a (Tcl_Obj *) for each
* (possible) list element.
*/
estCount = TclMaxListLength(nextElem, length, &limit);
estCount += (estCount == 0); /* Smallest list struct holds 1
* element. */
elemPtr = Tcl_NewObj();
llen = 0;
while (nextElem < limit) {
const char *elemStart;
char *check;
Tcl_Size elemSize;
int literal;
status = TclFindElement(NULL, nextElem, limit - nextElem,
&elemStart, &nextElem, &elemSize, &literal);
if (status != TCL_OK) {
Tcl_DecrRefCount(elemPtr);
*lenPtr = 0;
return TCL_OK;
}
if (elemStart == limit) {
break;
}
TclInvalidateStringRep(elemPtr);
check = Tcl_InitStringRep(elemPtr, literal ? elemStart : NULL,
elemSize);
if (elemSize && check == NULL) {
Tcl_DecrRefCount(elemPtr);
*lenPtr = 0;
return TCL_OK ;
}
if (!literal) {
Tcl_InitStringRep(elemPtr, NULL,
TclCopyAndCollapse(elemSize, elemStart, check));
}
llen++;
}
Tcl_DecrRefCount(elemPtr);
*lenPtr = llen;
return TCL_OK;
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Changes to generic/tclDisassemble.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 © 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 |
static const Tcl_ObjType instNameType = {
"instname", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfInstName, /* updateStringProc */
NULL, /* setFromAnyProc */
| < > | 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 */
0
};
#define InstNameSetInternalRep(objPtr, inst) \
do { \
Tcl_ObjInternalRep ir; \
ir.wideValue = (inst); \
Tcl_StoreInternalRep((objPtr), &instNameType, &ir); \
|
| ︙ | ︙ | |||
950 951 952 953 954 955 956 |
ByteCodeGetInternalRep(objPtr, &tclByteCodeType, codePtr);
/*
* Get the literals from the bytecode.
*/
TclNewObj(literals);
| | | 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 |
ByteCodeGetInternalRep(objPtr, &tclByteCodeType, codePtr);
/*
* Get the literals from the bytecode.
*/
TclNewObj(literals);
for (i=0 ; i<(int)codePtr->numLitObjects ; i++) {
Tcl_ListObjAppendElement(NULL, literals, codePtr->objArrayPtr[i]);
}
/*
* Get the variables from the bytecode.
*/
|
| ︙ | ︙ |
Changes to generic/tclEncoding.c.
1 | /* | < < < < > > > > > > > > > > > > > > > | 1 2 3 4 5 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 © 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 |
| ︙ | ︙ | |||
266 267 268 269 270 271 272 |
static const Tcl_ObjType encodingType = {
"encoding",
FreeEncodingInternalRep,
DupEncodingInternalRep,
NULL,
NULL,
| < > | 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 |
static const Tcl_ObjType encodingType = {
"encoding",
FreeEncodingInternalRep,
DupEncodingInternalRep,
NULL,
NULL,
0
};
#define EncodingSetInternalRep(objPtr, encoding) \
do { \
Tcl_ObjInternalRep ir; \
ir.twoPtrValue.ptr1 = (encoding); \
ir.twoPtrValue.ptr2 = NULL; \
|
| ︙ | ︙ | |||
603 604 605 606 607 608 609 |
type.encodingName = "utf-16be";
type.clientData = NULL;
Tcl_CreateEncoding(&type);
type.encodingName = "utf-16";
type.clientData = INT2PTR(leFlags);
Tcl_CreateEncoding(&type);
| < < < < < | 614 615 616 617 618 619 620 621 622 623 624 625 626 627 |
type.encodingName = "utf-16be";
type.clientData = NULL;
Tcl_CreateEncoding(&type);
type.encodingName = "utf-16";
type.clientData = INT2PTR(leFlags);
Tcl_CreateEncoding(&type);
/*
* Need the iso8859-1 encoding in order to process binary data, so force
* it to always be embedded. Note that this encoding *must* be a proper
* table encoding or some of the escape encodings crash! Hence the ugly
* code to duplicate the structure of a table encoding here.
*/
|
| ︙ | ︙ | |||
1104 1105 1106 1107 1108 1109 1110 |
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(
| | | 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 |
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_STRICT, dstPtr, NULL);
return Tcl_DStringValue(dstPtr);
}
/*
*-------------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
2481 2482 2483 2484 2485 2486 2487 |
charLimit = *dstCharsPtr;
}
dstStart = dst;
flags |= PTR2INT(clientData);
dstEnd = dst + dstLen - ((flags & ENCODING_UTF) ? TCL_UTF_MAX : 6);
| < | 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 |
charLimit = *dstCharsPtr;
}
dstStart = dst;
flags |= PTR2INT(clientData);
dstEnd = dst + dstLen - ((flags & ENCODING_UTF) ? TCL_UTF_MAX : 6);
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.
|
| ︙ | ︙ | |||
2529 2530 2531 2532 2533 2534 2535 |
*dst++ = 0;
src += 2;
}
} else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
/*
* Incomplete byte sequence.
| | | | | | 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 |
*dst++ = 0;
src += 2;
}
} else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
/*
* Incomplete byte sequence.
* Always check before using Tcl_UtfToUniChar. Not doing can so cause
* it to run beyond the end of the buffer! If we happen such an
* incomplete char its bytes are made to represent themselves
* unless the user has explicitly asked to be told.
*/
if (flags & ENCODING_INPUT) {
/* Incomplete bytes for modified UTF-8 target */
if (PROFILE_STRICT(profile)) {
result = (flags & TCL_ENCODING_CHAR_LIMIT)
? TCL_CONVERT_MULTIBYTE
|
| ︙ | ︙ | |||
2713 2714 2715 2716 2717 2718 2719 |
*dst++ = (ch & 0xFF);
} else {
dst += Tcl_UniCharToUtf(ch, dst);
}
src += 4;
}
| < < < < > > | 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 |
*dst++ = (ch & 0xFF);
} else {
dst += Tcl_UniCharToUtf(ch, dst);
}
src += 4;
}
if ((flags & TCL_ENCODING_END) && (result == TCL_CONVERT_MULTIBYTE)) {
/* We have a code fragment left-over at the end */
if (dst > dstEnd) {
result = TCL_CONVERT_NOSPACE;
} else {
/* destination is not full, so we really are at the end now */
if (PROFILE_STRICT(flags)) {
result = TCL_CONVERT_SYNTAX;
} else {
/* PROFILE_REPLACE or PROFILE_TCL8 */
result = TCL_OK;
dst += Tcl_UniCharToUtf(UNICODE_REPLACE_CHAR, dst);
numChars++;
|
| ︙ | ︙ | |||
3626 3627 3628 3629 3630 3631 3632 |
if (PROFILE_STRICT(flags)) {
result = TCL_CONVERT_UNKNOWN;
break;
}
/*
* Plunge on, using '?' as a fallback character.
*/
| < | 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 |
if (PROFILE_STRICT(flags)) {
result = TCL_CONVERT_UNKNOWN;
break;
}
/*
* Plunge on, using '?' as a fallback character.
*/
ch = (Tcl_UniChar) '?'; /* Profiles TCL8 and REPLACE */
}
if (dst > dstEnd) {
result = TCL_CONVERT_NOSPACE;
break;
}
|
| ︙ | ︙ |
Changes to generic/tclEnsemble.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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-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: */ |
| ︙ | ︙ | |||
78 79 80 81 82 83 84 |
static const Tcl_ObjType ensembleCmdType = {
"ensembleCommand", /* the type's name */
FreeEnsembleCmdRep, /* freeIntRepProc */
DupEnsembleCmdRep, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
| < > | 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 |
static const Tcl_ObjType ensembleCmdType = {
"ensembleCommand", /* the type's name */
FreeEnsembleCmdRep, /* freeIntRepProc */
DupEnsembleCmdRep, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
0
};
#define ECRSetInternalRep(objPtr, ecRepPtr) \
do { \
Tcl_ObjInternalRep ir; \
ir.twoPtrValue.ptr1 = (ecRepPtr); \
ir.twoPtrValue.ptr2 = NULL; \
|
| ︙ | ︙ | |||
308 309 310 311 312 313 314 |
if (nsPtr->parentPtr) {
Tcl_AppendStringsToObj(newCmd, "::", (void *)NULL);
}
Tcl_AppendObjToObj(newCmd, listv[0]);
Tcl_ListObjReplace(NULL, newList, 0, 1, 1, &newCmd);
if (patchedDict == NULL) {
| | > > > > > > > > > > | 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 |
if (nsPtr->parentPtr) {
Tcl_AppendStringsToObj(newCmd, "::", (void *)NULL);
}
Tcl_AppendObjToObj(newCmd, listv[0]);
Tcl_ListObjReplace(NULL, newList, 0, 1, 1, &newCmd);
if (patchedDict == NULL) {
patchedDict = TclDuplicatePureObj(
interp, objv[1], tclDictTypePtr);
if (!patchedDict) {
if (allocatedMapFlag) {
Tcl_DecrRefCount(mapObj);
}
Tcl_DecrRefCount(newList);
Tcl_DecrRefCount(newCmd);
Tcl_DecrRefCount(patchedDict);
return TCL_ERROR;
}
}
Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
newList);
}
Tcl_DictObjNext(&search, &subcmdWordsObj, &listObj,
&done);
} while (!done);
|
| ︙ | ︙ | |||
592 593 594 595 596 597 598 |
if (patchedDict) {
Tcl_DecrRefCount(patchedDict);
}
goto freeMapAndError;
}
cmd = TclGetString(listv[0]);
if (!(cmd[0] == ':' && cmd[1] == ':')) {
| | > > > > > > > | > > > > | 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 |
if (patchedDict) {
Tcl_DecrRefCount(patchedDict);
}
goto freeMapAndError;
}
cmd = TclGetString(listv[0]);
if (!(cmd[0] == ':' && cmd[1] == ':')) {
Tcl_Obj *newList = TclDuplicatePureObj(
interp, listObj, tclListTypePtr);
if (!newList) {
if (patchedDict) {
Tcl_DecrRefCount(patchedDict);
}
goto freeMapAndError;
}
Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace*)nsPtr);
if (nsPtr->parentPtr) {
Tcl_AppendStringsToObj(newCmd, "::", (void *)NULL);
}
Tcl_AppendObjToObj(newCmd, listv[0]);
Tcl_ListObjReplace(NULL, newList, 0, 1, 1,
&newCmd);
if (patchedDict == NULL) {
patchedDict = TclDuplicatePureObj(
interp, objv[1], tclListTypePtr);
if (!patchedDict) {
goto freeMapAndError;
}
}
Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
newList);
}
Tcl_DictObjNext(&search, &subcmdWordsObj, &listObj,
&done);
} while (!done);
|
| ︙ | ︙ | |||
1900 1901 1902 1903 1904 1905 1906 |
* Will be freed by the dispatch engine. */
Tcl_Obj **copyObjv;
Tcl_Size copyObjc, prefixObjc;
TclListObjLengthM(NULL, prefixObj, &prefixObjc);
if (objc == 2) {
| | > > > > | 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 |
* Will be freed by the dispatch engine. */
Tcl_Obj **copyObjv;
Tcl_Size copyObjc, prefixObjc;
TclListObjLengthM(NULL, prefixObj, &prefixObjc);
if (objc == 2) {
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,
|
| ︙ | ︙ | |||
2300 2301 2302 2303 2304 2305 2306 |
Tcl_Size i, prefixObjc;
Tcl_Obj **paramv, *unknownCmd, *ensObj;
/*
* Create the "unknown" command callback to determine what to do.
*/
| > | > > > | 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 |
Tcl_Size i, prefixObjc;
Tcl_Obj **paramv, *unknownCmd, *ensObj;
/*
* Create the "unknown" command callback to determine what to do.
*/
unknownCmd = TclDuplicatePureObj(
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]);
}
TclListObjGetElementsM(NULL, unknownCmd, ¶mc, ¶mv);
|
| ︙ | ︙ |
Changes to generic/tclEnv.c.
1 2 3 4 5 6 7 | /* * 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. | > > > > > > > > > > > > > > > > > < < < < < < | 1 2 3 4 5 6 7 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 © 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. */ #include "tclInt.h" TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */ #if defined(_WIN32) |
| ︙ | ︙ |
Changes to generic/tclEvent.c.
1 | /* | < < < < < < > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 © 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" /* * The data structure below is used to report background errors. One such * structure is allocated for each error; it holds information about the * interpreter and the error until an idle handler command can be invoked. |
| ︙ | ︙ | |||
230 231 232 233 234 235 236 | Tcl_Obj **prefixObjv, **tempObjv; /* * Note we copy the handler command prefix each pass through, so we do * support one handler setting another handler. */ | | > > > > | 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 |
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 = TclDuplicatePureObj(
interp, assocPtr->cmdPrefix, tclListTypePtr);
if (!copyObj) {
return;
}
errPtr = assocPtr->firstBgPtr;
TclListObjGetElementsM(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;
|
| ︙ | ︙ | |||
1090 1091 1092 1093 1094 1095 1096 | #endif #if defined(_MSC_VER) ".msvc-" STRINGIFY(_MSC_VER) #endif #ifdef USE_NMAKE ".nmake" #endif | < < < | 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 | #endif #if defined(_MSC_VER) ".msvc-" STRINGIFY(_MSC_VER) #endif #ifdef USE_NMAKE ".nmake" #endif #if !TCL_THREADS ".no-thread" #endif #ifndef TCL_CFG_OPTIMIZED ".no-optimize" #endif #ifdef __OBJC__ |
| ︙ | ︙ | |||
1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 |
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). */
subsystemsInitialized = 1;
}
TclpInitUnlock();
}
TclInitNotifier();
return stubInfo.version;
}
| > > > > | 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 |
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();
subsystemsInitialized = 1;
}
TclpInitUnlock();
}
TclInitNotifier();
return stubInfo.version;
}
|
| ︙ | ︙ |
Changes to generic/tclExecute.c.
1 | /* | < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 | /* * 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> |
| ︙ | ︙ | |||
446 447 448 449 450 451 452 | * 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) \ | | | | 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 |
* 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)) \
? (*(tPtr) = TCL_NUMBER_INT, \
*(ptrPtr) = (void *) \
(&((objPtr)->internalRep.wideValue)), TCL_OK) : \
TclHasInternalRep((objPtr), tclDoubleType) \
? (((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 : \
|
| ︙ | ︙ | |||
658 659 660 661 662 663 664 |
static const Tcl_ObjType exprCodeType = {
"exprcode",
FreeExprCodeInternalRep, /* freeIntRepProc */
DupExprCodeInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
| < > < > | 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 |
static const Tcl_ObjType exprCodeType = {
"exprcode",
FreeExprCodeInternalRep, /* freeIntRepProc */
DupExprCodeInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
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,
0
};
/*
*----------------------------------------------------------------------
*
* ReleaseDictIterator --
*
|
| ︙ | ︙ | |||
914 915 916 917 918 919 920 |
{
Tcl_MutexLock(&execMutex);
execInitialized = 0;
Tcl_MutexUnlock(&execMutex);
}
/*
| | | 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 |
{
Tcl_MutexLock(&execMutex);
execInitialized = 0;
Tcl_MutexUnlock(&execMutex);
}
/*
* 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 *)'.
*/
|
| ︙ | ︙ | |||
1477 1478 1479 1480 1481 1482 1483 | /* *---------------------------------------------------------------------- * * DupExprCodeInternalRep -- * * Part of the Tcl object type implementation for Tcl expression | | | | 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 | /* *---------------------------------------------------------------------- * * DupExprCodeInternalRep -- * * Part of the Tcl object type implementation for Tcl expression * 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 intrep, * like we do for lists and dicts. * * Results: * None. * * Side effects: * None. |
| ︙ | ︙ | |||
3373 3374 3375 3376 3377 3378 3379 |
lappendListDirect:
objResultPtr = varPtr->value.objPtr;
if (TclListObjLengthM(interp, objResultPtr, &len) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
if (Tcl_IsShared(objResultPtr)) {
| | > > > > > > > > > | 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 |
lappendListDirect:
objResultPtr = varPtr->value.objPtr;
if (TclListObjLengthM(interp, objResultPtr, &len) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
if (Tcl_IsShared(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) {
|
| ︙ | ︙ | |||
3432 3433 3434 3435 3436 3437 3438 |
if (!objResultPtr) {
valueToAssign = valuePtr;
} else if (TclListObjLengthM(interp, objResultPtr, &len)!=TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
} else {
if (Tcl_IsShared(objResultPtr)) {
| > | > > > > > | 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 |
if (!objResultPtr) {
valueToAssign = valuePtr;
} else if (TclListObjLengthM(interp, objResultPtr, &len)!=TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
} else {
if (Tcl_IsShared(objResultPtr)) {
DECACHE_STACK_INFO();
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) {
|
| ︙ | ︙ | |||
4400 4401 4402 4403 4404 4405 4406 |
origCmd = TclGetOriginalCommand(cmd);
if (origCmd == NULL) {
origCmd = cmd;
}
TclNewObj(objResultPtr);
Tcl_GetCommandFullName(interp, origCmd, objResultPtr);
| > | > > | | | | | | | | | | > | 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 |
origCmd = TclGetOriginalCommand(cmd);
if (origCmd == NULL) {
origCmd = cmd;
}
TclNewObj(objResultPtr);
Tcl_GetCommandFullName(interp, origCmd, objResultPtr);
{
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), (void *)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);
}
/*
* -----------------------------------------------------------------
|
| ︙ | ︙ | |||
4699 4700 4701 4702 4703 4704 4705 |
/*
* End of TclOO support instructions.
* -----------------------------------------------------------------
* Start of INST_LIST and related instructions.
*/
{
| | > | 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 |
/*
* End of TclOO support instructions.
* -----------------------------------------------------------------
* Start of INST_LIST and related instructions.
*/
{
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.
|
| ︙ | ︙ | |||
4728 4729 4730 4731 4732 4733 4734 |
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)));
| > > > > > > > > > > > > | > > > > | | > > | | > > > > > | > | | | | | > > > > > > > > | > > > > > > > > > > > > > > > > > > | | > < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 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 |
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);
}
} 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 */
TclListObjGetElementsM(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.
*/
objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
CACHE_STACK_INFO();
lindexDone:
if (!objResultPtr) {
TRACE_ERROR(interp);
goto gotError;
|
| ︙ | ︙ | |||
4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 |
/*
* Pop the list and get the index.
*/
valuePtr = OBJ_AT_TOS;
opnd = TclGetInt4AtPtr(pc+1);
TRACE(("\"%.30s\" %d => ", O2S(valuePtr), opnd));
/*
* Get the contents of the list, making sure that it really is a list
* in the process.
*/
| > > > > > > > > > > > > > > > > > > > > > > > > > > | | | > > | < < > | | < | | < > | > > > > > > | < < > | > > > > > > | | | | | < | | | > | 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 |
/*
* 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.
*/
if (!TclHasInternalRep(valuePtr, tclListTypePtr)
&& TclObjectHasInterface(valuePtr, list, index)) {
if (Tcl_ListObjLength(interp, valuePtr, &objc) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
if (TclIndexIsFromEnd(opnd) && !Tcl_LengthIsFinite(objc)) {
/* end-relative index, and list end is indeterminate */
if (TclObjectDispatchNoDefault(interp, dstatus, valuePtr, list, indexEnd,
interp, valuePtr, index, &objResultPtr) != TCL_OK
|| dstatus != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
} else {
index = TclIndexDecode(opnd, TclIndexLast(objc));
if (Tcl_ListObjIndex(interp, valuePtr, index, &objResultPtr)
!= TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
}
if (objResultPtr == NULL) {
TclNewObj(objResultPtr);
}
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);
} else {
if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
/* Decode end-offset index values. */
index = TclIndexDecode(opnd, TclIndexLast(objc));
pcAdjustment = 5;
}
lindexFastPath:
if (index >= 0 && index < objc) {
objResultPtr = objv[index];
} else {
TclNewObj(objResultPtr);
}
|
| ︙ | ︙ | |||
4922 4923 4924 4925 4926 4927 4928 | Tcl_DecrRefCount(valuePtr); /* This one should be done here */ /* * Compute the new variable value. */ DECACHE_STACK_INFO(); | < > | < < < | | | | | | | > | | 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 |
Tcl_DecrRefCount(valuePtr); /* This one should be done here */
/*
* Compute the new variable value.
*/
DECACHE_STACK_INFO();
{
int status;
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);
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.
|
| ︙ | ︙ | |||
4978 4979 4980 4981 4982 4983 4984 |
}
/*
* Set result.
*/
TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
| | | 5059 5060 5061 5062 5063 5064 5065 5066 5067 5068 5069 5070 5071 5072 5073 |
}
/*
* Set result.
*/
TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
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.
*/
|
| ︙ | ︙ | |||
5032 5033 5034 5035 5036 5037 5038 |
if (toIdx == TCL_INDEX_NONE) {
emptyList:
TclNewObj(objResultPtr);
TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
NEXT_INST_F(9, 1, 1);
}
| < < < < < | | < < | | < < > | | | | | | > > > | < | < > > > > > | | | > > > > > > > | > | > | > > | < | | > > | | | | | | | | | | < < | | | | | < > > | < > | | | < | | | | | | | | | | | | < < | < | | | | | 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 |
if (toIdx == TCL_INDEX_NONE) {
emptyList:
TclNewObj(objResultPtr);
TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
NEXT_INST_F(9, 1, 1);
}
toIdxAnchor = TclIndexIsFromEnd(toIdx);
fromIdxAnchor = TclIndexIsFromEnd(fromIdx);
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();
TRACE_ERROR(interp);
goto gotError;
}
} else {
toIdx = TclIndexDecode(toIdx, TclIndexLast(objc));
if (toIdx == TCL_INDEX_NONE) {
goto emptyList;
} else if (Tcl_LengthIsFinite(objc) && toIdx + 1 >= objc + 1) {
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 = Tcl_GetStringFromObj(valuePtr, &s1len);
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 (TclListObjLengthM(interp, value2Ptr, &length) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
match = 0;
if (length > 0) {
Tcl_Size i = 0;
Tcl_Obj *o;
/*
* An empty list doesn't match anything.
*/
do {
if (TclObjectHasInterface(valuePtr, list, index)) {
TCL_UNUSEDVAR(int status);
TclObjectDispatchNoDefault(interp, status, value2Ptr, list,
index, interp, value2Ptr, i, &o);
if (!o) {
TRACE_ERROR(interp);
goto gotError;
}
} else {
Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
}
if (o != NULL) {
s2 = Tcl_GetStringFromObj(o, &s2len);
} else {
s2 = "";
s2len = 0;
}
if (s1len == s2len) {
match = (memcmp(s1, s2, s1len) == 0);
}
TclBounceRefCount(o);
i++;
} while (i < length && match == 0);
}
}
if (*pc == INST_LIST_NOT_IN) {
match = !match;
}
TRACE_APPEND(("%d\n", match));
|
| ︙ | ︙ | |||
5200 5201 5202 5203 5204 5205 5206 |
if (TclGetIntForIndexM(
interp, fromIdxObj, length - end_indicator, &fromIdx)
!= TCL_OK) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
| | | | 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 |
if (TclGetIntForIndexM(
interp, fromIdxObj, length - end_indicator, &fromIdx)
!= TCL_OK) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
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 = toIdx - fromIdx + 1;
}
}
}
CACHE_STACK_INFO();
if (Tcl_IsShared(valuePtr)) {
|
| ︙ | ︙ | |||
5391 5392 5393 5394 5395 5396 5397 |
TRACE(("\"%.20s\" %.20s => ", O2S(valuePtr), O2S(value2Ptr)));
/*
* Get char length to calculate what 'end' means.
*/
slength = Tcl_GetCharLength(valuePtr);
| > > > > > > > > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 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 |
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();
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);
}
}
}
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;
|
| ︙ | ︙ | |||
5468 5469 5470 5471 5472 5473 5474 |
/* Every range of an empty value is an empty value */
if (slength == 0) {
TRACE_APPEND(("\n"));
NEXT_INST_F(9, 0, 0);
}
| > > > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > | > > > > > > > > > > > > > > > > > | | > > > > > | > > > | > | > | 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 |
/* 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. */
/*
assert ( toIdx != TCL_INDEX_NONE );
*
* Extra safety for legacy bytecodes:
*/
if (toIdx == TCL_INDEX_NONE) {
goto emptyRange;
}
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;
|
| ︙ | ︙ | |||
5804 5805 5806 5807 5808 5809 5810 |
case INST_EQ:
case INST_NEQ:
case INST_LT:
case INST_GT:
case INST_LE:
case INST_GE: {
| | | > > > > > > > > > > > > | 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 |
case INST_EQ:
case INST_NEQ:
case INST_LT:
case INST_GT:
case INST_LE:
case INST_GE: {
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.
*/
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.
*/
|
| ︙ | ︙ | |||
6436 6437 6438 6439 6440 6441 6442 |
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
| | | 6602 6603 6604 6605 6606 6607 6608 6609 6610 6611 6612 6613 6614 6615 6616 |
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 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);
|
| ︙ | ︙ | |||
6461 6462 6463 6464 6465 6466 6467 |
/*
* End of numeric operator instructions.
* -----------------------------------------------------------------
*/
case INST_TRY_CVT_TO_BOOLEAN:
valuePtr = OBJ_AT_TOS;
| | | 6627 6628 6629 6630 6631 6632 6633 6634 6635 6636 6637 6638 6639 6640 6641 |
/*
* End of numeric operator instructions.
* -----------------------------------------------------------------
*/
case INST_TRY_CVT_TO_BOOLEAN:
valuePtr = OBJ_AT_TOS;
if (TclHasInternalRep(valuePtr, tclBooleanType)) {
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);
|
| ︙ | ︙ | |||
6530 6531 6532 6533 6534 6535 6536 |
if (TclListObjLengthM(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)) {
| > | > > > > > | 6696 6697 6698 6699 6700 6701 6702 6703 6704 6705 6706 6707 6708 6709 6710 6711 6712 6713 6714 6715 6716 |
if (TclListObjLengthM(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 = 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;
|
| ︙ | ︙ | |||
6604 6605 6606 6607 6608 6609 6610 |
tmpPtr->internalRep.twoPtrValue.ptr1 =(void *)(iterNum + 1);
listTmpDepth = numLists + 1;
for (i = 0; i < numLists; i++) {
varListPtr = infoPtr->varLists[i];
numVars = varListPtr->numVars;
| < < | < < < | 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 |
tmpPtr->internalRep.twoPtrValue.ptr1 =(void *)(iterNum + 1);
listTmpDepth = numLists + 1;
for (i = 0; i < numLists; i++) {
varListPtr = infoPtr->varLists[i];
numVars = varListPtr->numVars;
listPtr = OBJ_AT_DEPTH(listTmpDepth);
DECACHE_STACK_INFO();
if (TclObjectHasInterface(listPtr, list, index)) {
status = Tcl_ListObjLength(interp, listPtr, &listLen);
elements = NULL;
} else {
status = TclListObjGetElementsM(
interp, listPtr, &listLen, &elements);
}
if (status != TCL_OK) {
CACHE_STACK_INFO();
goto gotError;
}
valIndex = (iterNum * numVars);
for (j = 0; j < numVars; j++) {
if (valIndex >= listLen) {
TclNewObj(valuePtr);
} else {
DECACHE_STACK_INFO();
if (elements) {
|
| ︙ | ︙ | |||
7167 7168 7169 7170 7171 7172 7173 |
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
| | | 7334 7335 7336 7337 7338 7339 7340 7341 7342 7343 7344 7345 7346 7347 7348 |
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 intrep of an iterator. We need
* to drop the refcount [Tcl Bug 9b352768e6].
*/
Tcl_DecrRefCount(dictPtr);
Tcl_Free(searchPtr);
TRACE_ERROR(interp);
goto gotError;
|
| ︙ | ︙ | |||
7780 7781 7782 7783 7784 7785 7786 |
iPtr->cmdFramePtr = bcFramePtr->nextPtr;
TclReleaseByteCode(codePtr);
TclStackFree(interp, TD); /* free my stack */
return result;
/*
| | | | | 7947 7948 7949 7950 7951 7952 7953 7954 7955 7956 7957 7958 7959 7960 7961 7962 7963 7964 |
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.
*
* 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:
|
| ︙ | ︙ | |||
8515 8516 8517 8518 8519 8520 8521 |
WIDE_RESULT(wResult);
}
}
overflowExpon:
if ((TclGetWideIntFromObj(NULL, value2Ptr, &w2) != TCL_OK)
| | | 8682 8683 8684 8685 8686 8687 8688 8689 8690 8691 8692 8693 8694 8695 8696 |
WIDE_RESULT(wResult);
}
}
overflowExpon:
if ((TclGetWideIntFromObj(NULL, value2Ptr, &w2) != TCL_OK)
|| (value2Ptr->typePtr != tclIntType)
|| (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);
|
| ︙ | ︙ |
Changes to generic/tclFCmd.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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 © 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: */ |
| ︙ | ︙ |
Changes to generic/tclFileName.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 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-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. |
| ︙ | ︙ |
Changes to generic/tclFileSystem.h.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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) 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 | /* | < < < < < < > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 © 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 -- * |
| ︙ | ︙ |
Changes to generic/tclGetDate.y.
1 2 3 4 5 6 7 8 | /* * 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. | > > > > > > > > > > > > > > > > > < < < < < < | 1 2 3 4 5 6 7 8 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 (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
|
| ︙ | ︙ | |||
30 31 32 33 34 35 36 37 38 39 40 41 42 43 | * 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. */ | > > > > > > > > > > | 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 | * 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. */ |
| ︙ | ︙ |
Changes to generic/tclHash.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 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 © 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. */ |
| ︙ | ︙ |
Changes to generic/tclHistory.c.
1 2 3 4 5 6 7 |
/*
* 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.
| > > > > > > > > > > > > > > > > > < < < < < < | 1 2 3 4 5 6 7 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.
*/
#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 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 © 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 |
| ︙ | ︙ | |||
333 334 335 336 337 338 339 |
static const Tcl_ObjType chanObjType = {
"channel", /* name for this type */
FreeChannelInternalRep, /* freeIntRepProc */
DupChannelInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
| < > | 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 |
static const Tcl_ObjType chanObjType = {
"channel", /* name for this type */
FreeChannelInternalRep, /* freeIntRepProc */
DupChannelInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
0
};
#define GetIso88591() \
(binaryEncoding ? Tcl_GetEncoding(NULL, "iso8859-1") : binaryEncoding)
#define ChanSetInternalRep(objPtr, resPtr) \
do { \
|
| ︙ | ︙ | |||
1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 |
strcpy(tmp, chanName);
} else {
tmp = (char *)Tcl_Alloc(7);
tmp[0] = '\0';
}
statePtr->channelName = tmp;
statePtr->flags = mask;
statePtr->maxPerms = mask; /* Save max privileges for close callback */
/*
* Set the channel to system default encoding.
*
* Note the strange bit of protection taking place here. If the system
* encoding name is reported back as "binary", something weird is
| > > > > | 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 |
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.
*
* Note the strange bit of protection taking place here. If the system
* encoding name is reported back as "binary", something weird is
|
| ︙ | ︙ | |||
5944 5945 5946 5947 5948 5949 5950 5951 5952 5953 5954 5955 5956 5957 |
#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.
*
* NOTE: See DoRead for argument that it's a bug (one we're keeping) to
| > | 5959 5960 5961 5962 5963 5964 5965 5966 5967 5968 5969 5970 5971 5972 5973 |
#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.
*
* NOTE: See DoRead for argument that it's a bug (one we're keeping) to
|
| ︙ | ︙ | |||
6044 6045 6046 6047 6048 6049 6050 6051 6052 6053 6054 6055 6056 6057 |
* 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))) {
goto finish;
}
}
if (copiedNow < 0) {
if (GotFlag(statePtr, CHANNEL_EOF)) {
break;
| > | 6060 6061 6062 6063 6064 6065 6066 6067 6068 6069 6070 6071 6072 6073 6074 |
* 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;
|
| ︙ | ︙ | |||
6123 6124 6125 6126 6127 6128 6129 6130 6131 6132 6133 6134 6135 6136 |
* like [read] can also return an error.
*/
ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR);
Tcl_SetErrno(EILSEQ);
copied = -1;
}
TclChannelRelease((Tcl_Channel)chanPtr);
return copied;
}
/*
*---------------------------------------------------------------------------
*
* ReadBytes --
| > > > | 6140 6141 6142 6143 6144 6145 6146 6147 6148 6149 6150 6151 6152 6153 6154 6155 6156 |
* 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 --
|
| ︙ | ︙ | |||
6255 6256 6257 6258 6259 6260 6261 |
* how many characters were produced by the previous pass.
*/
int factor = *factorPtr;
int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
(void) Tcl_GetStringFromObj(objPtr, &numBytes);
| | | 6275 6276 6277 6278 6279 6280 6281 6282 6283 6284 6285 6286 6287 6288 6289 |
* how many characters were produced by the previous pass.
*/
int factor = *factorPtr;
int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
(void) Tcl_GetStringFromObj(objPtr, &numBytes);
Tcl_AppendToObj(objPtr, NULL, dstLimit);
if (toRead == srcLen) {
Tcl_Size size;
dst = TclGetStringStorage(objPtr, &size) + numBytes;
dstLimit = (size - numBytes) > INT_MAX ? INT_MAX : (size - numBytes);
} else {
dst = TclGetString(objPtr) + numBytes;
|
| ︙ | ︙ | |||
8239 8240 8241 8242 8243 8244 8245 |
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]
| < < | 8259 8260 8261 8262 8263 8264 8265 8266 8267 8268 8269 8270 8271 8272 8273 |
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]
|| !strcmp(newValue+1, " {}")
))) {
if (GotFlag(statePtr, TCL_READABLE)) {
statePtr->inEofChar = newValue[0];
}
} else {
if (interp) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
| ︙ | ︙ |
Changes to generic/tclIO.h.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 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 (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. */ |
| ︙ | ︙ | |||
154 155 156 157 158 159 160 |
/* 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. */
| < < < < | 165 166 167 168 169 170 171 172 173 174 175 176 177 178 |
/* 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. */
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 | /* | < < < < > > > > > > > > > > > > > > > | 1 2 3 4 5 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. */ /* * tclIOCmd.c -- * * Contains the definitions of most of the Tcl commands relating to IO. */ #include "tclInt.h" #include "tclTomMath.h" /* * Callback structure for accept callback in a TCP server. */ |
| ︙ | ︙ | |||
302 303 304 305 306 307 308 |
}
TclChannelPreserve(chan);
TclNewObj(linePtr);
lineLen = Tcl_GetsObj(chan, linePtr);
if (lineLen == TCL_IO_FAILURE) {
if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
| < | 313 314 315 316 317 318 319 320 321 322 323 324 325 326 |
}
TclChannelPreserve(chan);
TclNewObj(linePtr);
lineLen = Tcl_GetsObj(chan, linePtr);
if (lineLen == TCL_IO_FAILURE) {
if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
/*
* 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.
*/
|
| ︙ | ︙ | |||
367 368 369 370 371 372 373 |
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? */
int mode; /* Mode in which channel is opened. */
| | > | 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 |
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? */
int mode; /* Mode in which channel is opened. */
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, "channelId ?numChars?");
|
| ︙ | ︙ | |||
429 430 431 432 433 434 435 |
}
}
TclNewObj(resultPtr);
TclChannelPreserve(chan);
charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
if (charactersRead == TCL_IO_FAILURE) {
| < < < < < < < < | > > > > | > > > > > | | 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 |
}
}
TclNewObj(resultPtr);
TclChannelPreserve(chan);
charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
if (charactersRead == TCL_IO_FAILURE) {
/*
* 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)));
}
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;
|
| ︙ | ︙ | |||
942 943 944 945 946 947 948 |
TclStackFree(interp, (void *) argv);
if (chan == NULL) {
return TCL_ERROR;
}
| < < < < < | 954 955 956 957 958 959 960 961 962 963 964 965 966 967 |
TclStackFree(interp, (void *) argv);
if (chan == NULL) {
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);
|
| ︙ | ︙ |
Changes to generic/tclIOGT.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 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 © 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 |
* interpreters. */
{
Tcl_Obj *resObj; /* See below, switch (transmit). */
Tcl_Size resLen = 0;
unsigned char *resBuf;
Tcl_InterpState state = NULL;
int res = TCL_OK;
| | > > > > | 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 = 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
|
| ︙ | ︙ |
Changes to generic/tclIORChan.c.
1 2 3 4 5 6 7 8 9 10 11 | /* * 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. | > > > > > > > > > > > > > > > > < < < < < | 1 2 3 4 5 6 7 8 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. */ #include "tclInt.h" #include "tclIO.h" #include <assert.h> #ifndef EINVAL |
| ︙ | ︙ | |||
2257 2258 2259 2260 2261 2262 2263 |
rcPtr->writeTimer = 0;
#if TCL_THREADS
rcPtr->thread = Tcl_GetCurrentThread();
#endif
rcPtr->mode = mode;
rcPtr->interest = 0; /* Initially no interest registered */
| > | > > | 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 |
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);
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);
|
| ︙ | ︙ | |||
2395 2396 2397 2398 2399 2400 2401 |
}
/*
* Insert method into the callback command, after the command prefix,
* before the channel id.
*/
| | > > > | 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 |
}
/*
* Insert method into the callback command, after the command prefix,
* before the channel id.
*/
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.
|
| ︙ | ︙ |
Changes to generic/tclIORTrans.c.
1 2 3 4 5 6 7 8 9 10 11 | /* * 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. | > > > > > > > > > > > > > > > > < < < < < | 1 2 3 4 5 6 7 8 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. */ #include "tclInt.h" #include "tclIO.h" #include <assert.h> #ifndef EINVAL |
| ︙ | ︙ |
Changes to generic/tclIOSock.c.
1 | /* | < < < < > > > > > > > > > > > > > > > | 1 2 3 4 5 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. */ /* * 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. */ |
| ︙ | ︙ |
Changes to generic/tclIOUtil.c.
1 2 3 4 5 6 7 8 | /* * 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. | > > > > > > > > > > > > > > > > > > < < < < < < < | 1 2 3 4 5 6 7 8 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. */ #include "tclInt.h" #ifdef _WIN32 # include "tclWinInt.h" #endif #include "tclFileSystem.h" |
| ︙ | ︙ | |||
1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 |
encodingName = "utf-8";
}
if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName)
!= TCL_OK) {
Tcl_CloseEx(interp,chan,0);
return result;
}
TclNewObj(objPtr);
Tcl_IncrRefCount(objPtr);
/*
* Read first character of stream to check for utf-8 BOM
*/
| > > > > > | 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 |
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);
/*
* Read first character of stream to check for utf-8 BOM
*/
|
| ︙ | ︙ | |||
1951 1952 1953 1954 1955 1956 1957 |
} else if (result == TCL_ERROR) {
/*
* Record information about where the error occurred.
*/
Tcl_Size length;
const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
| | | | | 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 |
} else if (result == TCL_ERROR) {
/*
* Record information about where the error occurred.
*/
Tcl_Size 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)));
}
Tcl_DecrRefCount(objPtr);
return result;
}
|
| ︙ | ︙ |
Changes to generic/tclIndexObj.c.
1 | /* | < < < < < < > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 © 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" #include <assert.h> /* * Prototypes for functions defined later in this file: */ |
| ︙ | ︙ | |||
33 34 35 36 37 38 39 | const Tcl_ArgvInfo *argTable); /* * The structure below defines the index Tcl object type by means of functions * that can be invoked by generic object code. */ | | < > | 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 |
const Tcl_ArgvInfo *argTable);
/*
* The structure below defines the index Tcl object type by means of functions
* that can be invoked by generic object code.
*/
static const Tcl_ObjType indexType = {
"index", /* name */
FreeIndex, /* freeIntRepProc */
DupIndex, /* dupIntRepProc */
UpdateStringOfIndex, /* updateStringProc */
NULL, /* setFromAnyProc */
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.
*
|
| ︙ | ︙ | |||
209 210 211 212 213 214 215 |
return TclIndexInvalidError(interp, "struct offset", offset);
}
/*
* See if there is a valid cached result from a previous lookup.
*/
if (objPtr && !(flags & TCL_INDEX_TEMP_TABLE)) {
| | | 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 |
return TclIndexInvalidError(interp, "struct offset", offset);
}
/*
* See if there is a valid cached result from a previous lookup.
*/
if (objPtr && !(flags & TCL_INDEX_TEMP_TABLE)) {
irPtr = TclFetchInternalRep(objPtr, &indexType);
if (irPtr) {
indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
if ((indexRep->tablePtr == tablePtr)
&& (indexRep->offset == offset)
&& (indexRep->index != TCL_INDEX_NONE)) {
index = indexRep->index;
goto uncachedDone;
|
| ︙ | ︙ | |||
278 279 280 281 282 283 284 |
/*
* 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)) {
| | | | 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 |
/*
* 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, &indexType);
if (irPtr) {
indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
} else {
Tcl_ObjInternalRep ir;
indexRep = (IndexRep*)Tcl_Alloc(sizeof(IndexRep));
ir.twoPtrValue.ptr1 = indexRep;
Tcl_StoreInternalRep(objPtr, &indexType, &ir);
}
indexRep->tablePtr = (void *) tablePtr;
indexRep->offset = offset;
indexRep->index = index;
}
uncachedDone:
|
| ︙ | ︙ | |||
381 382 383 384 385 386 387 |
*----------------------------------------------------------------------
*/
static void
UpdateStringOfIndex(
Tcl_Obj *objPtr)
{
| | | 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 |
*----------------------------------------------------------------------
*/
static void
UpdateStringOfIndex(
Tcl_Obj *objPtr)
{
IndexRep *indexRep = (IndexRep *)TclFetchInternalRep(objPtr, &indexType)->twoPtrValue.ptr1;
const char *indexStr = EXPAND_OF(indexRep);
Tcl_InitStringRep(objPtr, indexStr, strlen(indexStr));
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
413 414 415 416 417 418 419 |
DupIndex(
Tcl_Obj *srcPtr,
Tcl_Obj *dupPtr)
{
Tcl_ObjInternalRep ir;
IndexRep *dupIndexRep = (IndexRep *)Tcl_Alloc(sizeof(IndexRep));
| | | | 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 |
DupIndex(
Tcl_Obj *srcPtr,
Tcl_Obj *dupPtr)
{
Tcl_ObjInternalRep ir;
IndexRep *dupIndexRep = (IndexRep *)Tcl_Alloc(sizeof(IndexRep));
memcpy(dupIndexRep, TclFetchInternalRep(srcPtr, &indexType)->twoPtrValue.ptr1,
sizeof(IndexRep));
ir.twoPtrValue.ptr1 = dupIndexRep;
Tcl_StoreInternalRep(dupPtr, &indexType, &ir);
}
/*
*----------------------------------------------------------------------
*
* FreeIndex --
*
|
| ︙ | ︙ | |||
441 442 443 444 445 446 447 |
*----------------------------------------------------------------------
*/
static void
FreeIndex(
Tcl_Obj *objPtr)
{
| | | 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 |
*----------------------------------------------------------------------
*/
static void
FreeIndex(
Tcl_Obj *objPtr)
{
Tcl_Free(TclFetchInternalRep(objPtr, &indexType)->twoPtrValue.ptr1);
objPtr->typePtr = NULL;
}
/*
*----------------------------------------------------------------------
*
* TclInitPrefixCmd --
|
| ︙ | ︙ | |||
861 862 863 864 865 866 867 |
for (i=0 ; i<toPrint ; i++) {
/*
* Add the element, quoting it if necessary.
*/
const Tcl_ObjInternalRep *irPtr;
| | | 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 |
for (i=0 ; i<toPrint ; i++) {
/*
* Add the element, quoting it if necessary.
*/
const Tcl_ObjInternalRep *irPtr;
if ((irPtr = TclFetchInternalRep(origObjv[i], &indexType))) {
IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
elementStr = EXPAND_OF(indexRep);
elemLen = strlen(elementStr);
} else {
elementStr = Tcl_GetStringFromObj(origObjv[i], &elemLen);
}
|
| ︙ | ︙ | |||
908 909 910 911 912 913 914 | /* * If the object is an index type, use the index table which allows for * the correct error message even if the subcommand was abbreviated. * Otherwise, just use the string rep. */ const Tcl_ObjInternalRep *irPtr; | | | 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 |
/*
* If the object is an index type, use the index table which allows for
* the correct error message even if the subcommand was abbreviated.
* Otherwise, just use the string rep.
*/
const Tcl_ObjInternalRep *irPtr;
if ((irPtr = TclFetchInternalRep(objv[i], &indexType))) {
IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), (void *)NULL);
} else {
/*
* Quote the argument if it contains spaces (Bug 942757).
*/
|
| ︙ | ︙ | |||
1357 1358 1359 1360 1361 1362 1363 |
Tcl_Obj *value,
int *codePtr) /* Argument objects. */
{
static const char *const returnCodes[] = {
"ok", "error", "return", "break", "continue", NULL
};
| | | 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 |
Tcl_Obj *value,
int *codePtr) /* Argument objects. */
{
static const char *const returnCodes[] = {
"ok", "error", "return", "break", "continue", NULL
};
if (!TclHasInternalRep(value, &indexType)
&& TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) {
return TCL_OK;
}
if (Tcl_GetIndexFromObjStruct(NULL, value, returnCodes,
sizeof(char *), NULL, TCL_EXACT, codePtr) == TCL_OK) {
return TCL_OK;
}
|
| ︙ | ︙ |
Changes to generic/tclInt.decls.
1 2 3 4 5 6 7 | # 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 # | > > > > > > > > > > > > > > < < < < < < | 1 2 3 4 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 # library tcl # Define the unsupported generic interfaces. interface tclInt scspec EXTERN |
| ︙ | ︙ |
Changes to generic/tclInt.h.
1 | /* | < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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) 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 | #ifndef JOIN # define JOIN(a,b) JOIN1(a,b) # define JOIN1(a,b) a##b #endif #if defined(__cplusplus) # define TCL_UNUSED(T) T #elif defined(__GNUC__) && (__GNUC__ > 2) # define TCL_UNUSED(T) T JOIN(dummy, __LINE__) __attribute__((unused)) #else # define TCL_UNUSED(T) T JOIN(dummy, __LINE__) #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 | > > > | 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 |
* 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
/*
*----------------------------------------------------------------
* 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;
struct Namespace *nsPtr;
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > < < | 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 |
* 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;
struct Namespace *nsPtr;
struct Var *arrayPtr;
} TclVarHashTable;
/*
* This is for itcl - it likes to search our varTables directly :(
*/
#define TclVarHashFindVar(tablePtr, key) \
|
| ︙ | ︙ | |||
270 271 272 273 274 275 276 |
* 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
| < < < < | 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 |
* 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
size_t nsId; /* Unique id for the namespace. */
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
|
| ︙ | ︙ | |||
966 967 968 969 970 971 972 |
*/
typedef struct CompiledLocal {
struct CompiledLocal *nextPtr;
/* Next compiler-recognized local variable for
* this procedure, or NULL if this is the last
* local. */
| | | < < < < < | | 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 |
*/
typedef struct CompiledLocal {
struct CompiledLocal *nextPtr;
/* 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. */
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. */
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. */
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;
/*
|
| ︙ | ︙ | |||
1046 1047 1048 1049 1050 1051 1052 |
* 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. */
| < < < < | 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 |
* 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. */
Tcl_CmdObjTraceProc2 *proc; /* Procedure to call to trace command. */
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;
|
| ︙ | ︙ | |||
1093 1094 1095 1096 1097 1098 1099 | * TCL_TRACE_LEAVE_EXEC - triggers leave/leavestep traces. * - passed to Tcl_CreateObjTrace to set up * "leavestep" traces. */ #define TCL_TRACE_ENTER_EXEC 1 #define TCL_TRACE_LEAVE_EXEC 2 | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 | * TCL_TRACE_LEAVE_EXEC - triggers leave/leavestep traces. * - passed to Tcl_CreateObjTrace to set up * "leavestep" traces. */ #define TCL_TRACE_ENTER_EXEC 1 #define TCL_TRACE_LEAVE_EXEC 2 /* * 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. */ |
| ︙ | ︙ | |||
1971 1972 1973 1974 1975 1976 1977 |
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. */
| < < < < < < < < < < < | 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 |
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. */
void (*optimizer)(void *envPtr);
/*
* 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
|
| ︙ | ︙ | |||
2011 2012 2013 2014 2015 2016 2017 |
* 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. */
| < < < < < < | 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 |
* 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. */
/*
* 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 *)
|
| ︙ | ︙ | |||
2039 2040 2041 2042 2043 2044 2045 |
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. */
| < < < | 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 |
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. */
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
|
| ︙ | ︙ | |||
2079 2080 2081 2082 2083 2084 2085 |
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. */
| < < < | 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 |
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. */
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
|
| ︙ | ︙ | |||
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). */
| | | 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 |
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 ::errorCode variable. */
int returnLevel; /* [return -level] parameter. */
/*
* Resource limiting framework support (TIP#143).
*/
struct {
|
| ︙ | ︙ | |||
2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 | * 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 | > | 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 | * 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 |
| ︙ | ︙ | |||
2703 2704 2705 2706 2707 2708 2709 | /* * 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 TclListObjGetElementsM(interp_, listObj_, objcPtr_, objvPtr_) \ | | | | | | | | | > | < | | < < < < < < < < | | | | | | 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 |
/*
* 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 TclListObjGetElementsM(interp_, listObj_, objcPtr_, objvPtr_) \
(((listObj_)->typePtr == tclListTypePtr) \
? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \
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 TclListObjLengthM(interp_, listObj_, lenPtr_) \
(((listObj_)->typePtr == tclListTypePtr) \
? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \
: Tcl_ListObjLength((interp_), (listObj_), (lenPtr_)))
#define TclListObjIsCanonical(listObj_) \
(((listObj_)->typePtr == 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.
*/
#define TclGetBooleanFromObj(interp, objPtr, intPtr) \
(((objPtr)->typePtr == tclIntType \
|| (objPtr)->typePtr == tclBooleanType) \
? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \
: Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr)))
#ifdef TCL_WIDE_INT_IS_LONG
#define TclGetLongFromObj(interp, objPtr, longPtr) \
(((objPtr)->typePtr == tclIntType) \
? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
: Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
#else
#define TclGetLongFromObj(interp, objPtr, longPtr) \
(((objPtr)->typePtr == tclIntType \
&& (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) \
(((objPtr)->typePtr == tclIntType \
&& (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) \
((((objPtr)->typePtr == tclIntType) && ((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) \
(((objPtr)->typePtr == tclIntType) \
? (*(wideIntPtr) = \
((objPtr)->internalRep.wideValue), TCL_OK) : \
Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
/*
* Flag values for TclTraceDictPath().
*
|
| ︙ | ︙ | |||
3069 3070 3071 3072 3073 3074 3075 | MODULE_SCOPE Tcl_ScaleTimeProc *tclScaleTimeProcPtr; MODULE_SCOPE void *tclTimeClientData; /* * Variables denoting the Tcl object types defined in the core. */ | | | | | < | | | 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 | 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 tclByteCodeType; MODULE_SCOPE const Tcl_ObjType *tclDoubleType; MODULE_SCOPE const Tcl_ObjType *tclIntType; MODULE_SCOPE Tcl_ObjType * tclListTypePtr; MODULE_SCOPE Tcl_ObjType * tclDictTypePtr; 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; /* |
| ︙ | ︙ | |||
3218 3219 3220 3221 3222 3223 3224 | /* *---------------------------------------------------------------- * Procedures shared among Tcl modules but not used by the outside world: *---------------------------------------------------------------- */ | < > | | 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 | /* *---------------------------------------------------------------- * Procedures shared among Tcl modules but not used by the outside world: *---------------------------------------------------------------- */ MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr, const unsigned char *bytes, Tcl_Size len); 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 TclArgumentEnter(Tcl_Interp *interp, Tcl_Obj *objv[], int objc, CmdFrame *cf); MODULE_SCOPE void TclArgumentRelease(Tcl_Interp *interp, Tcl_Obj *objv[], int objc); MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp, Tcl_Obj *objv[], int 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_Interp *interp, Tcl_Obj *objPtr, int *res); MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp, Tcl_Channel chan); MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd; MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble; MODULE_SCOPE int TclCompareTwoNumbers(Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr); MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, Tcl_Size num, |
| ︙ | ︙ | |||
3274 3275 3276 3277 3278 3279 3280 | 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); | | > > | 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 | 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 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); /* TIP #280 - Modified token based evaluation, with line information. */ MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script, Tcl_Size numBytes, int flags, Tcl_Size line, |
| ︙ | ︙ | |||
3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 | MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr, Tcl_Size *sizePtr); MODULE_SCOPE int TclGetLoadedLibraries(Tcl_Interp *interp, const char *targetName, const char *packageName); MODULE_SCOPE int TclGetWideBitsFromObj(Tcl_Interp *, Tcl_Obj *, Tcl_WideInt *); 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; MODULE_SCOPE Tcl_ObjCmdProc TclInfoCoroutineCmd; MODULE_SCOPE Tcl_Obj * TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr); | > > | 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 | MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr, Tcl_Size *sizePtr); MODULE_SCOPE int TclGetLoadedLibraries(Tcl_Interp *interp, const char *targetName, const char *packageName); 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 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; MODULE_SCOPE Tcl_ObjCmdProc TclInfoCoroutineCmd; MODULE_SCOPE Tcl_Obj * TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr); |
| ︙ | ︙ | |||
3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 | 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); /* TIP #280 */ MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, Tcl_Size line, Tcl_Size n, Tcl_Size *lines, Tcl_Obj *const *elems); | > > | > | | > | < | > > > > | 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 | 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 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 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 * TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr, 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 * 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, int objc, Tcl_Obj *const objv[], Tcl_Namespace *nsPtr, int flags); MODULE_SCOPE int TclObjUnsetVar2(Tcl_Interp *interp, |
| ︙ | ︙ | |||
3448 3449 3450 3451 3452 3453 3454 | 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); | | | 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 |
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 void TclpAlertNotifier(void *clientData);
MODULE_SCOPE void *TclpNotifierData(void);
MODULE_SCOPE void TclpServiceModeHook(int mode);
|
| ︙ | ︙ | |||
3505 3506 3507 3508 3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 | 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 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, | > | 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 | 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, |
| ︙ | ︙ | |||
3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 | 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 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); | > > | 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 | 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); |
| ︙ | ︙ | |||
3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 | 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 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, | > | 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 | 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, |
| ︙ | ︙ | |||
4070 4071 4072 4073 4074 4075 4076 | const char *idxType, Tcl_Size idx); /* * Error message utility functions */ MODULE_SCOPE int TclCommandWordLimitError(Tcl_Interp *interp, Tcl_Size count); | < < | 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 | const char *idxType, Tcl_Size idx); /* * Error message utility functions */ MODULE_SCOPE int TclCommandWordLimitError(Tcl_Interp *interp, Tcl_Size count); /* Constants used in index value encoding routines. */ #define TCL_INDEX_END ((Tcl_Size)-2) #define TCL_INDEX_START ((Tcl_Size)0) /* *---------------------------------------------------------------------- * |
| ︙ | ︙ | |||
4553 4554 4555 4556 4557 4558 4559 | * string handling. The macro's expression result is 1 for the 1-byte case or * the result of Tcl_UtfToUniChar. The ANSI C "prototype" for this macro is: * * MODULE_SCOPE int TclUtfToUniChar(const char *string, Tcl_UniChar *ch); *---------------------------------------------------------------- */ | < < < < < < < | 4536 4537 4538 4539 4540 4541 4542 4543 4544 4545 4546 4547 4548 4549 4550 4551 4552 4553 | * string handling. The macro's expression result is 1 for the 1-byte case or * the result of Tcl_UtfToUniChar. The ANSI C "prototype" for this macro is: * * MODULE_SCOPE int TclUtfToUniChar(const char *string, Tcl_UniChar *ch); *---------------------------------------------------------------- */ #define TclUtfToUniChar(str, chPtr) \ (((UCHAR(*(str))) < 0x80) ? \ ((*(chPtr) = UCHAR(*(str))), 1) \ : Tcl_UtfToUniChar(str, chPtr)) /* *---------------------------------------------------------------- * Macro counterpart of the Tcl_NumUtfChars() function. To be used in speed- * -sensitive points where it pays to avoid a function call in the common case * of counting along a string of all one-byte characters. The ANSI C * "prototype" for this macro is: |
| ︙ | ︙ | |||
4607 4608 4609 4610 4611 4612 4613 | * * MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); *---------------------------------------------------------------- */ MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); #define TclIsPureDict(objPtr) \ | | | | 4583 4584 4585 4586 4587 4588 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 | * * MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); *---------------------------------------------------------------- */ MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); #define TclIsPureDict(objPtr) \ (((objPtr)->bytes==NULL) && ((objPtr)->typePtr==(void *)tclDictTypePtr)) #define TclHasInternalRep(objPtr, 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 |
| ︙ | ︙ | |||
4656 4657 4658 4659 4660 4661 4662 | */ 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; | | | > | 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 | */ 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 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); |
| ︙ | ︙ | |||
4688 4689 4690 4691 4692 4693 4694 |
*/
#define TclSetIntObj(objPtr, i) \
do { \
Tcl_ObjInternalRep ir; \
ir.wideValue = (Tcl_WideInt) i; \
TclInvalidateStringRep(objPtr); \
| | | | | | | | | | 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 |
*/
#define TclSetIntObj(objPtr, i) \
do { \
Tcl_ObjInternalRep ir; \
ir.wideValue = (Tcl_WideInt) i; \
TclInvalidateStringRep(objPtr); \
Tcl_StoreInternalRep(objPtr, tclIntType, &ir); \
} while (0)
#define TclSetDoubleObj(objPtr, d) \
do { \
Tcl_ObjInternalRep ir; \
ir.doubleValue = (double) d; \
TclInvalidateStringRep(objPtr); \
Tcl_StoreInternalRep(objPtr, tclDoubleType, &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 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; \
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; \
} \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
#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; \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
#define TclNewStringObj(objPtr, s, len) \
do { \
TclIncrObjsAllocated(); \
TclAllocObjStorage(objPtr); \
|
| ︙ | ︙ | |||
5016 5017 5018 5019 5020 5021 5022 |
#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) \
| | | 4993 4994 4995 4996 4997 4998 4999 5000 5001 5002 5003 5004 5005 5006 5007 |
#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))))
#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 | /* * 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. | > > > > > > > > > > > > > > > > < < < < < | 1 2 3 4 5 6 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. */ #ifndef _TCLINTDECLS #define _TCLINTDECLS #undef TCL_STORAGE_CLASS |
| ︙ | ︙ | |||
1265 1266 1267 1268 1269 1270 1271 | #if defined(USE_TCL_STUBS) #undef Tcl_StaticLibrary #define Tcl_StaticLibrary \ (tclIntStubsPtr->tclStaticLibrary) #endif /* defined(USE_TCL_STUBS) */ | < < < < < < < < < < < | 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) */ #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 | /* * 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. | > > > > > > > > > > > > > > < < < | 1 2 3 4 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. */ #ifndef _TCLINTPLATDECLS #define _TCLINTPLATDECLS #undef TCL_STORAGE_CLASS #ifdef BUILD_tcl |
| ︙ | ︙ | |||
26 27 28 29 30 31 32 | /* * 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. */ | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 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.
*/
/* !BEGIN!: Do not edit below this line. */
#ifdef __cplusplus
extern "C" {
#endif
/*
|
| ︙ | ︙ | |||
684 685 686 687 688 689 690 | (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ #define TclUnixOpenTemporaryFile \ (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ | < > > > > > > > > > | 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. */ #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 | #undef TclMacOSXSetFileAttribute /* 16 */ #undef TclMacOSXCopyFileAttributes /* 17 */ #undef TclMacOSXMatchType /* 18 */ #undef TclMacOSXNotifierAddRunLoopMode /* 19 */ #endif #if defined(_WIN32) | < < < | < | | | | | | < | | 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) # undef TclWinNToHS # undef TclWinGetServByName # undef TclWinGetSockOpt # undef TclWinSetSockOpt # undef TclWinGetPlatformId # undef TclWinResetInterfaces # undef TclWinSetInterfaces #else # undef TclpGetPid # define TclpGetPid(pid) ((size_t)(pid)) #endif #endif /* _TCLINTPLATDECLS */ |
Changes to generic/tclInterp.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 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 © 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. */ |
| ︙ | ︙ | |||
621 622 623 624 625 626 627 |
static const char *const options[] = {
"alias", "aliases", "bgerror", "cancel",
"children", "create", "debug", "delete",
"eval", "exists", "expose", "hide",
"hidden", "issafe", "invokehidden",
"limit", "marktrusted", "recursionlimit",
"share",
| < < < < | 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 |
static const char *const options[] = {
"alias", "aliases", "bgerror", "cancel",
"children", "create", "debug", "delete",
"eval", "exists", "expose", "hide",
"hidden", "issafe", "invokehidden",
"limit", "marktrusted", "recursionlimit",
"share",
"slaves",
"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,
OPT_SLAVES,
OPT_TARGET, OPT_TRANSFER
} index;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
1030 1031 1032 1033 1034 1035 1036 |
return TCL_ERROR;
}
childInterp = GetInterp(interp, objv[2]);
if (childInterp == NULL) {
return TCL_ERROR;
}
return ChildRecursionLimit(interp, childInterp, objc - 3, objv + 3);
| < < | 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 |
return TCL_ERROR;
}
childInterp = GetInterp(interp, objv[2]);
if (childInterp == NULL) {
return TCL_ERROR;
}
return ChildRecursionLimit(interp, childInterp, objc - 3, objv + 3);
case OPT_SLAVES:
case OPT_CHILDREN: {
InterpInfo *iiPtr;
Tcl_Obj *resultPtr;
Tcl_HashEntry *hPtr;
Tcl_HashSearch hashSearch;
char *string;
|
| ︙ | ︙ |
Changes to generic/tclLink.c.
1 | /* | < < < < < < < > > > > > > > > > | 1 2 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 © 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 |
| ︙ | ︙ | |||
111 112 113 114 115 116 117 |
static Tcl_ObjType invalidRealType = {
"invalidReal", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
| < > | 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 |
static Tcl_ObjType invalidRealType = {
"invalidReal", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
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
|
| ︙ | ︙ | |||
519 520 521 522 523 524 525 |
Tcl_Obj *objPtr,
double *dblPtr)
{
if (Tcl_GetDoubleFromObj(NULL, objPtr, dblPtr) == TCL_OK) {
return 0;
} else {
#ifdef ACCEPT_NAN
| | | 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);
if (irPtr != NULL) {
*dblPtr = irPtr->doubleValue;
return 0;
}
#endif /* ACCEPT_NAN */
return GetInvalidDoubleFromObj(objPtr, dblPtr) != TCL_OK;
|
| ︙ | ︙ |
Changes to generic/tclListObj.c.
1 2 3 4 5 | /* * tclListObj.c -- * * This file contains functions that implement the Tcl list object type. * | > > > > > > > > > > > > > > > > > < < < < | 1 2 3 4 5 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. * */ #include <assert.h> #include "tclInt.h" #include "tclTomMath.h" /* |
| ︙ | ︙ | |||
64 65 66 67 68 69 70 | #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_) \ | | | 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 |
#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_), 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.
|
| ︙ | ︙ | |||
126 127 128 129 130 131 132 | Tcl_Size objc, Tcl_Obj *const objv[], 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, | | | > | > > > > > > > > > > | | | < > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
Tcl_Size objc,
Tcl_Obj *const objv[],
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,
Tcl_Size fromIdx,
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);
static void UpdateStringOfList(Tcl_Obj *listPtr);
static int ListObjAppendElement(Tcl_Interp *interp,
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.
*/
static ObjectType tclListObjectType = {
"list",
FreeListInternalRep, /* freeIntRepProc */
DupListInternalRep, /* dupIntRepProc */
UpdateStringOfList, /* updateStringProc */
SetListFromAny, /* setFromAnyProc */
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++; \
} while (0)
|
| ︙ | ︙ | |||
198 199 200 201 202 203 204 |
* 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; \
| | | 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 |
* 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 = tclListTypePtr; \
} while (0)
#define ListObjOverwriteRep(objPtr_, repPtr_) \
do { \
ListRepIncrRefs(repPtr_); \
ListObjStompRep(objPtr_, repPtr_); \
} while (0)
|
| ︙ | ︙ | |||
1243 1244 1245 1246 1247 1248 1249 |
* if result is TCL_OK, or set to NULL on error.
*----------------------------------------------------------------------
*/
static int
TclListObjGetRep(
Tcl_Interp *interp, /* Used to report errors if not NULL. */
| | | | | | 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 |
* 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 *listPtr, /* List object for which an element array is
* to be returned. */
ListRep *repPtr) /* Location to store descriptor */
{
if (!TclHasInternalRep(listPtr, tclListTypePtr)) {
int result;
result = SetListFromAny(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(listPtr, repPtr);
LISTREP_CHECK(repPtr);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
1311 1312 1313 1314 1315 1316 1317 |
ListObjReplaceRepAndInvalidate(objPtr, &listRep);
} else {
TclFreeInternalRep(objPtr);
TclInvalidateStringRep(objPtr);
Tcl_InitStringRep(objPtr, NULL, 0);
}
}
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 |
ListObjReplaceRepAndInvalidate(objPtr, &listRep);
} else {
TclFreeInternalRep(objPtr);
TclInvalidateStringRep(objPtr);
Tcl_InitStringRep(objPtr, NULL, 0);
}
}
/*
*------------------------------------------------------------------------
*
* ListRepRange --
*
* Initializes a ListRep as a range within the passed ListRep.
|
| ︙ | ︙ | |||
1386 1387 1388 1389 1390 1391 1392 |
* in the source listObj instead of source listRep might simplify.
*
*------------------------------------------------------------------------
*/
static void
ListRepRange(
ListRep *srcRepPtr, /* Contains source of the range */
| | | | | | | | | | | | | | | | 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 |
* in the source listObj instead of source listRep might simplify.
*
*------------------------------------------------------------------------
*/
static void
ListRepRange(
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 (fromIdx < 0) {
fromIdx = 0;
}
if (toIdx >= numSrcElems) {
toIdx = numSrcElems - 1;
}
if (fromIdx > toIdx) {
/* Empty list of capacity 1. */
ListRepInit(1, NULL, LISTREP_PANIC_ON_FAIL, rangeRepPtr);
return;
}
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 (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 (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 - (toIdx + 1);
/* Assert: Because numSrcElems > toIdx earlier */
if (numAfterRangeEnd != 0) {
/* T:listrep-1.{8,9} */
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) + 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;
|
| ︙ | ︙ | |||
1492 1493 1494 1495 1496 1497 1498 |
}
} 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,
| | | 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 |
}
} 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[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.
|
| ︙ | ︙ | |||
1514 1515 1516 1517 1518 1519 1520 | 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 */ | | | | | | | | 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 |
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 (fromIdx != 0) {
/* T:listrep-1.4,3.15 */
ObjArrayDecrRefs(srcElems, 0, fromIdx);
}
/* Ditto for trailing */
numAfterRangeEnd = numSrcElems - (toIdx + 1);
/* Assert: Because numSrcElems > toIdx earlier */
if (numAfterRangeEnd != 0) {
/* T:listrep-3.17 */
ObjArrayDecrRefs(srcElems, toIdx + 1, numAfterRangeEnd);
}
memmove(&srcRepPtr->storePtr->slots[0],
&srcRepPtr->storePtr
->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} */
|
| ︙ | ︙ | |||
1569 1570 1571 1572 1573 1574 1575 | * * Side effects: * The possible conversion of the object referenced by listPtr * to a list object. * *---------------------------------------------------------------------- */ | > > | > | | > > > > > > > > > | > | > > > > > > > | | > > | | > | | | | | > | | | 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 |
*
* Side effects:
* The possible conversion of the object referenced by listPtr
* to a list object.
*
*----------------------------------------------------------------------
*/
int
TclListObjRange(tclObjTypeInterfaceArgsListRange)
{
int status;
Tcl_Size length;
status = TclListObjLengthM(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, status;
status = TclListObjGetRep(interp, listPtr, &listRep);
if (status != TCL_OK)
return status;
isShared = Tcl_IsShared(listPtr);
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(listPtr);
} /* T:listrep-1.{4.3,5.1,5.2} */
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 'tclListTypePtr' and that index is valid for the
* list.
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
TclListObjGetElement(
|
| ︙ | ︙ | |||
1648 1649 1650 1651 1652 1653 1654 | * * Side effects: * The possible conversion of the object referenced by listPtr * to a list object. * *---------------------------------------------------------------------- */ | > > | > > > > > > > > > > > > > > > > > > > > > > > > > > | < < > | | > | < | > < < < | | < | 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 |
*
* 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(tclObjTypeInterfaceArgsListAll)
{
return TclObjectDispatch(listPtr, ListObjInterfaceGetElements,
list, all, interp, listPtr, objcPtr, objvPtr);
}
int
ListObjInterfaceGetElements(tclObjTypeInterfaceArgsListAll)
{
ListRep listRep;
if (TclListObjGetRep(interp, listPtr, &listRep) != TCL_OK)
return TCL_ERROR;
ListRepElements(&listRep, *objcPtr, *objvPtr);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
1695 1696 1697 1698 1699 1700 1701 | * 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 | | < > | | > | | < > | > | > > > > > > > > > > | | | | > > > | < | | > > > | > > | 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 |
* 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(tclObjTypeInterfaceArgsListAppendList)
{
return TclObjectDispatch(listPtr, ListObjAppendList,
list, appendlist, interp, listPtr, elemListPtr);
}
int
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 (status != TCL_OK) {
return TCL_ERROR;
}
status = Tcl_ListObjAppendElement(interp, listPtr, itemObj);
return status;
} else {
Tcl_Obj **objv;
/*
* Pull the elements to append from elemListPtr.
*/
if (TCL_OK != TclListObjGetElementsM(interp, elemListPtr, &objc, &objv)) {
return TCL_ERROR;
}
return TclListObjAppendElements(interp, listPtr, objc, objv);
}
}
}
/*
*------------------------------------------------------------------------
*
* TclListObjAppendElements --
*
|
| ︙ | ︙ | |||
1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 |
* in 'listObj' to grow. Any preexisting string representation of
* 'listPtr' is invalidated.
*
*----------------------------------------------------------------------
*/
int
Tcl_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
| > > > > > > > > > > > > > > | 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 |
* 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
|
| ︙ | ︙ | |||
1940 1941 1942 1943 1944 1945 1946 | * * If 'listPtr' is not already of type 'tclListType', it is converted. * *---------------------------------------------------------------------- */ int Tcl_ListObjIndex( | | > > | | < > | > > | | < < < < < | | | | < | < | < < < > | | < < < < | | | < < < | | < < < < < < < < < | 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 |
*
* If 'listPtr' is not already of type 'tclListType', it is converted.
*
*----------------------------------------------------------------------
*/
int
Tcl_ListObjIndex(
tclObjTypeInterfaceArgsListIndex
)
{
return TclObjectDispatch(listPtr, ListObjIndex,
list, index, interp, listPtr, index, resPtrPtr);
}
int
ListObjIndex(tclObjTypeInterfaceArgsListIndex) {
Tcl_Obj **elemObjs;
Tcl_Size numElems;
/* Empty string => empty list. Avoid unnecessary shimmering */
if (listPtr->bytes == &tclEmptyString) {
*resPtrPtr = NULL;
return TCL_OK;
}
if (TclListObjGetElementsM(interp, listPtr, &numElems, &elemObjs)
!= TCL_OK) {
return TCL_ERROR;
}
if ((index < 0) || (index >= numElems)) {
*resPtrPtr = NULL;
} else {
*resPtrPtr = elemObjs[index];
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Tcl_ListObjLength --
*
* Returns the number of elements in a list object. If the object is not
* 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(tclObjTypeInterfaceArgsListLength)
{
return TclObjectDispatch(listPtr, ListObjInterfaceLength,
list, length, interp, listPtr, lenPtr);
}
int
ListObjInterfaceLength(tclObjTypeInterfaceArgsListLength) {
ListRep listRep;
if (TclListObjGetRep(interp, listPtr, &listRep) != TCL_OK) {
return TCL_ERROR;
}
*lenPtr = ListRepLength(&listRep);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Tcl_ListObjReplace --
*
* This function replaces zero or more elements of the list referenced by
|
| ︙ | ︙ | |||
2069 2070 2071 2072 2073 2074 2075 | * replaced objects are decremented. listObj is converted, if necessary, * to a list object. listObj's old string representation, if any, is * freed. * *---------------------------------------------------------------------- */ int | | > > > > > | > > > | > > > > | > > > > > > | > > > | > > > > > > | > > > > > > > > > > > > > > > > > < < < < < | 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 |
* 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(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 (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK)
return TCL_ERROR; /* Cannot be converted to a list */
/* Make limits sane */
origListLen = ListRepLength(&listRep);
if (first < 0) {
first = 0;
|
| ︙ | ︙ | |||
2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 |
}
}
LISTREP_CHECK(&listRep);
ListObjReplaceRepAndInvalidate(listObj, &listRep);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclLindexList --
*
| > > > > > > > > > > > | | 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 |
}
}
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 --
*
* 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:
|
| ︙ | ︙ | |||
2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 |
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;
/*
* 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.
*/
| > | | | | | | | | | | > | > > > > > > > > > > | < | 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 |
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, tclListTypePtr)
&& TclGetIntForIndexM(NULL, argObj, TCL_SIZE_MAX - 1, &index)
== TCL_OK) {
/*
* argPtr designates a single index.
*/
return TclLindexFlat(interp, listObj, 1, &argObj);
}
/*
* 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);
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 = TclListObjGetElementsM(
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);
}
listObj = TclLindexFlat(interp, listObj, numIndexObjs, indexObjs);
Tcl_DecrRefCount(indexListCopy);
return listObj;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
2647 2648 2649 2650 2651 2652 2653 |
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;
| < < < < < < < < < < < < < < < < < < < < < < < < | 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 |
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;
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);
|
| ︙ | ︙ | |||
2703 2704 2705 2706 2707 2708 2709 |
return NULL;
}
}
Tcl_DecrRefCount(listObj);
TclNewObj(listObj);
Tcl_IncrRefCount(listObj);
} else {
| | > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | | | | | | | | | | | | | < | | | | > | 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 |
return NULL;
}
}
Tcl_DecrRefCount(listObj);
TclNewObj(listObj);
Tcl_IncrRefCount(listObj);
} else {
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 = SetListFromAny(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
*/
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;
|
| ︙ | ︙ | |||
2770 2771 2772 2773 2774 2775 2776 |
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_Obj **indices = NULL; /* Vector of indices in the index list. */
| | | | | < < < < < < < | | < | > > > | < | > | | | | | | < > > | | | | | | | | | | > | | | | < | < < < < < | | | < < < | < | < | < < < < < < < < < < < < < > | > | < > | | > | | > > | | < < | | < < < < < < | | > > > > > | 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 |
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_Obj **indices = NULL; /* Vector of indices in the index list. */
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, tclListTypePtr)
&& TclGetIntForIndexM(NULL, indexArgObj, TCL_SIZE_MAX - 1, &index)
== TCL_OK) {
/* 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 */
/* to do: have TclLsetList return a standard return value instead */
TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj, &resPtr);
return resPtr;
}
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);
return resPtr;
}
if (TCL_OK != TclListObjGetElementsM(
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.
*/
TclLsetFlat(interp, listObj, indexCount, indices, valueObj, &resPtr);
Tcl_DecrRefCount(indexListCopy);
return resPtr;
}
/*
*----------------------------------------------------------------------
*
* TclLsetFlat --
*
* Core engine of the 'lset' command.
* It also handles 'lpop' when given a NULL value.
*
* Results:
* 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.
*
* Side effects:
* If the initial value of the list was shared, and this function must
* modify the value, the result is a new object having a reference count
* of 0.
*
*----------------------------------------------------------------------
*/
int
TclLsetFlat(tclObjTypeInterfaceArgsListSetDeep)
{
int status;
status = TclObjectDispatch(listObj, LsetFlat,
list, setDeep, interp, listObj, indexCount, indexArray, valueObj, resPtrPtr);
return status;
}
int
LsetFlat(tclObjTypeInterfaceArgsListSetDeep)
{
Tcl_Size index, len;
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) {
*resPtrPtr = valueObj;
return TCL_OK;
}
/*
* If the list is shared, make a copy to modify (copy-on-write). The string
* representation and internal representation of listObj remains unchanged.
*/
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;
|
| ︙ | ︙ | |||
2984 2985 2986 2987 2988 2989 2990 | (void *)NULL); } result = TCL_ERROR; break; } /* | | | | < | > > > > > > > | > > > > > > > > > > | 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 |
(void *)NULL);
}
result = TCL_ERROR;
break;
}
/*
* 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.
*/
if (--indexCount) {
parentList = subListObj;
if (index == elemCount) {
TclNewObj(subListObj);
} else {
subListObj = elemPtrs[index];
}
if (Tcl_IsShared(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;
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
|
| ︙ | ︙ | |||
3084 3085 3086 3087 3088 3089 3090 |
* Error return; message is already in interp. Clean up any excess
* memory.
*/
if (retValueObj != listObj) {
Tcl_DecrRefCount(retValueObj);
}
| > | | 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 |
* Error return; message is already in interp. Clean up any excess
* memory.
*/
if (retValueObj != listObj) {
Tcl_DecrRefCount(retValueObj);
}
*resPtrPtr = 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).
*/
|
| ︙ | ︙ | |||
3106 3107 3108 3109 3110 3111 3112 |
/* 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);
}
| | | | 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 |
/* 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);
}
*resPtrPtr = retValueObj;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclListObjSetElement --
*
|
| ︙ | ︙ | |||
3136 3137 3138 3139 3140 3141 3142 | * 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 | | < > | | > | < | | | 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 |
* 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(tclObjTypeInterfaceArgsListSet)
{
return TclObjectDispatch(listObj, ListObjSetElement,
list, set, interp, listObj, index, valueObj);
}
int
ListObjSetElement(tclObjTypeInterfaceArgsListSet)
{
ListRep listRep;
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. */
|
| ︙ | ︙ | |||
3200 3201 3202 3203 3204 3205 3206 |
*/
Tcl_IncrRefCount(valueObj);
Tcl_DecrRefCount(elemPtrs[index]);
elemPtrs[index] = valueObj;
/* Internal rep may be cloned so replace */
ListObjReplaceRepAndInvalidate(listObj, &listRep);
| < | 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 |
*/
Tcl_IncrRefCount(valueObj);
Tcl_DecrRefCount(elemPtrs[index]);
elemPtrs[index] = valueObj;
/* Internal rep may be cloned so replace */
ListObjReplaceRepAndInvalidate(listObj, &listRep);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* FreeListInternalRep --
|
| ︙ | ︙ | |||
3299 3300 3301 3302 3303 3304 3305 |
* 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).
*/
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | 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 |
* 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);
} 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
|
| ︙ | ︙ | |||
3339 3340 3341 3342 3343 3344 3345 |
while (!done) {
*elemPtrs++ = keyPtr;
*elemPtrs++ = valuePtr;
Tcl_IncrRefCount(keyPtr);
Tcl_IncrRefCount(valuePtr);
Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
}
| < < < < < < < < < < < < < < < < < < < < < < < < < < | 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 |
while (!done) {
*elemPtrs++ = keyPtr;
*elemPtrs++ = valuePtr;
Tcl_IncrRefCount(keyPtr);
Tcl_IncrRefCount(valuePtr);
Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
}
} else {
Tcl_Size estCount, length;
const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length);
/*
* Allocate enough space to hold a (Tcl_Obj *) for each
* (possible) list element.
|
| ︙ | ︙ | |||
3446 3447 3448 3449 3450 3451 3452 |
* 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;
| | | 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 |
* 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 = tclListTypePtr;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ |
Changes to generic/tclLiteral.c.
1 2 3 4 5 6 7 8 | /* * 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. | > > > > > > > > > > > > > > > > > < < < < < < | 1 2 3 4 5 6 7 8 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. */ #include "tclInt.h" #include "tclCompile.h" /* * When there are this many entries per bucket, on average, rebuild a |
| ︙ | ︙ |
Changes to generic/tclLoad.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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-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 |
| ︙ | ︙ |
Changes to generic/tclLoadNone.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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-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 | /* * 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. | > > > > > > > > > > > > > > > > > > < < < < < < < | 1 2 3 4 5 6 7 8 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. */ /* * 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. */ |
| ︙ | ︙ |
Changes to generic/tclNamesp.c.
1 | /* | < < < < < < < < > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 | /* * 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. |
| ︙ | ︙ | |||
127 128 129 130 131 132 133 |
static const Tcl_ObjType nsNameType = {
"nsName", /* the type's name */
FreeNsNameInternalRep, /* freeIntRepProc */
DupNsNameInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
SetNsNameFromAny, /* setFromAnyProc */
| < > | 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 */
0
};
#define NsNameSetInternalRep(objPtr, nnPtr) \
do { \
Tcl_ObjInternalRep ir; \
(nnPtr)->refCount++; \
ir.twoPtrValue.ptr1 = (nnPtr); \
|
| ︙ | ︙ | |||
391 392 393 394 395 396 397 |
}
if (framePtr->varTablePtr != NULL) {
TclDeleteVars(iPtr, framePtr->varTablePtr);
Tcl_Free(framePtr->varTablePtr);
framePtr->varTablePtr = NULL;
}
| | | 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 |
}
if (framePtr->varTablePtr != NULL) {
TclDeleteVars(iPtr, framePtr->varTablePtr);
Tcl_Free(framePtr->varTablePtr);
framePtr->varTablePtr = NULL;
}
if (framePtr->numCompiledLocals + 1 > 1) {
TclDeleteCompiledLocalVars(iPtr, framePtr);
if (framePtr->localCachePtr->refCount-- <= 1) {
TclFreeLocalCache(interp, framePtr->localCachePtr);
}
framePtr->localCachePtr = NULL;
}
|
| ︙ | ︙ | |||
3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 |
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;
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);
| > > > > > | | 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 |
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 (isEmpty == TCL_EMPTYSTRING_YES ) {
Tcl_DecrRefCount(resultPtr);
namespaceOriginError:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"invalid command name \"%s\"", TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
TclGetString(objv[1]), (void *)NULL);
return TCL_ERROR;
|
| ︙ | ︙ |
Changes to generic/tclNotify.c.
1 | /* | < < < < < < < < > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 | /* * 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). */ |
| ︙ | ︙ |
Changes to generic/tclOO.c.
1 | /* | < < < < > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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-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" /* |
| ︙ | ︙ | |||
134 135 136 137 138 139 140 | /* * Scripted parts of TclOO. First, the main script (cannot be outside this * file). */ static const char initScript[] = | < < < | 145 146 147 148 149 150 151 152 153 154 155 156 157 158 |
/*
* Scripted parts of TclOO. First, the main script (cannot be outside this
* file).
*/
static const char initScript[] =
"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;"; */
/*
|
| ︙ | ︙ | |||
256 257 258 259 260 261 262 |
* to be fully provided.
*/
if (Tcl_EvalEx(interp, initScript, TCL_INDEX_NONE, 0) != TCL_OK) {
return TCL_ERROR;
}
| < < < < | 264 265 266 267 268 269 270 271 272 273 274 275 276 277 |
* to be fully provided.
*/
if (Tcl_EvalEx(interp, initScript, TCL_INDEX_NONE, 0) != TCL_OK) {
return TCL_ERROR;
}
return Tcl_PkgProvideEx(interp, "tcl::oo", TCLOO_PATCHLEVEL,
&tclOOStubs);
}
/*
* ----------------------------------------------------------------------
*
|
| ︙ | ︙ |
Changes to generic/tclOO.decls.
1 2 3 4 5 6 7 | # 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. # | > > > > > > > > > > > > < < < < | 1 2 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. # library tclOO ###################################################################### # Public API, exposed for general users of TclOO. # |
| ︙ | ︙ |
Changes to generic/tclOO.h.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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) 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 | * 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); | < < < < | 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); typedef int (Tcl_MethodCallProc2)(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext objectContext, Tcl_Size objc, Tcl_Obj *const *objv); 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 |
* 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;
| < < < < | 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;
typedef struct {
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;
/*
* 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.
*/
|
| ︙ | ︙ |
Changes to generic/tclOOBasic.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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-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" |
| ︙ | ︙ |
Changes to generic/tclOOCall.c.
1 2 3 4 5 6 | /* * 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. | > > > > > > > > > > > > > > > > < < < < < | 1 2 3 4 5 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. */ #ifdef HAVE_CONFIG_H #include "config.h" #endif #include "tclInt.h" #include "tclOOInt.h" |
| ︙ | ︙ | |||
149 150 151 152 153 154 155 |
static const Tcl_ObjType methodNameType = {
"TclOO method name",
FreeMethodNameRep,
DupMethodNameRep,
NULL,
NULL,
| < > | 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 |
static const Tcl_ObjType methodNameType = {
"TclOO method name",
FreeMethodNameRep,
DupMethodNameRep,
NULL,
NULL,
0
};
/*
* ----------------------------------------------------------------------
*
* TclOODeleteContext --
|
| ︙ | ︙ |
Changes to generic/tclOODecls.h.
1 2 3 4 5 6 7 8 9 10 | /* * This file is (mostly) automatically generated from tclOO.decls. */ #ifndef _TCLOODECLS #define _TCLOODECLS #ifndef TCLAPI # ifdef BUILD_tcl # define TCLAPI extern DLLEXPORT | > > > > > > > > > > | 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 | #define Tcl_NewMethod2 \ (tclOOStubsPtr->tcl_NewMethod2) /* 34 */ #endif /* defined(USE_TCLOO_STUBS) */ /* !END!: Do not edit above this line. */ | < < < < < < < < < < | 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. */ #endif /* _TCLOODECLS */ |
Changes to generic/tclOODefineCmds.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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 © 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" /* |
| ︙ | ︙ |
Changes to generic/tclOOInfo.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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 © 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 inline Class * GetClassFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr); |
| ︙ | ︙ |
Changes to generic/tclOOInt.h.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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) 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" /* |
| ︙ | ︙ |
Changes to generic/tclOOIntDecls.h.
1 2 3 4 5 6 7 8 9 10 | /* * This file is (mostly) automatically generated from tclOO.decls. */ #ifndef _TCLOOINTDECLS #define _TCLOOINTDECLS /* !BEGIN!: Do not edit below this line. */ #ifdef __cplusplus | > > > > > > > > > > | 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 | /* | < < < < > > > > > > > > > > > > > > > | 1 2 3 4 5 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-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" |
| ︙ | ︙ |
Changes to generic/tclOOScript.h.
1 | /* | < < < < < < > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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) 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 | /* * 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" | > > > > > > > > > | 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 | /* * ORIGINAL SOURCE: tk/generic/tkStubLib.c, version 1.9 2004/03/17 */ #include "tclOOInt.h" MODULE_SCOPE const TclOOStubs *tclOOStubsPtr; | > > > > > > > > > | 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 | /* | < < < < < > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 |
/*
* 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;
|
| ︙ | ︙ | |||
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 | 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); /* * 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); /* * 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. */ | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | > | > > > > | > | | > > > > | > > > | > | > > | 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 |
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 ObjectType tclBooleanObjType= {
"boolean", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
TclSetBooleanFromAny, /* setFromAnyProc */
2,
(Tcl_ObjInterface *)&tclScalarInterface
};
MODULE_SCOPE const Tcl_ObjType *tclBooleanType = (Tcl_ObjType *)&tclBooleanObjType;
const ObjectType tclDoubleObjType= {
"double", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfDouble, /* updateStringProc */
SetDoubleFromAny, /* setFromAnyProc */
2,
(Tcl_ObjInterface *)&tclScalarInterface
};
MODULE_SCOPE const Tcl_ObjType *tclDoubleType = (Tcl_ObjType *)&tclDoubleObjType;
const ObjectType tclIntObjType = {
"int", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfInt, /* updateStringProc */
SetIntFromAny, /* setFromAnyProc */
2,
(Tcl_ObjInterface *)&tclScalarInterface
};
MODULE_SCOPE const Tcl_ObjType *tclIntType = (Tcl_ObjType *)&tclIntObjType;
const ObjectType tclBignumObjType = {
"bignum", /* name */
FreeBignum, /* freeIntRepProc */
DupBignum, /* dupIntRepProc */
UpdateStringOfBignum, /* updateStringProc */
NULL, /* setFromAnyProc */
2,
(Tcl_ObjInterface *)&tclScalarInterface
};
MODULE_SCOPE const Tcl_ObjType *tclBignumType = (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 |
Tcl_ObjType tclCmdNameType = {
"cmdName", /* name */
FreeCmdNameInternalRep, /* freeIntRepProc */
DupCmdNameInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
SetCmdNameFromAny, /* setFromAnyProc */
| < > | 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 |
Tcl_ObjType tclCmdNameType = {
"cmdName", /* name */
FreeCmdNameInternalRep, /* freeIntRepProc */
DupCmdNameInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
SetCmdNameFromAny, /* setFromAnyProc */
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.
|
| ︙ | ︙ | |||
373 374 375 376 377 378 379 |
TclInitObjSubsystem(void)
{
Tcl_MutexLock(&tableMutex);
typeTableInitialized = 1;
Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS);
Tcl_MutexUnlock(&tableMutex);
| | | | | 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 |
TclInitObjSubsystem(void)
{
Tcl_MutexLock(&tableMutex);
typeTableInitialized = 1;
Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS);
Tcl_MutexUnlock(&tableMutex);
Tcl_RegisterObjType(tclDoubleType);
Tcl_RegisterObjType(&tclStringType);
Tcl_RegisterObjType(tclListTypePtr);
Tcl_RegisterObjType(tclDictTypePtr);
Tcl_RegisterObjType(&tclByteCodeType);
Tcl_RegisterObjType(&tclCmdNameType);
Tcl_RegisterObjType(&tclRegexpType);
Tcl_RegisterObjType(&tclProcBodyType);
#ifdef TCL_COMPILE_STATS
Tcl_MutexLock(&tclObjMutex);
|
| ︙ | ︙ | |||
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 |
Tcl_Free(Tcl_GetHashValue(hPtr));
Tcl_DeleteHashEntry(hPtr);
}
Tcl_DeleteHashTable(tsdPtr->lineCLPtr);
Tcl_Free(tsdPtr->lineCLPtr);
tsdPtr->lineCLPtr = NULL;
}
/*
*--------------------------------------------------------------
*
* 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.
*
*--------------------------------------------------------------
*/
void
Tcl_RegisterObjType(
const Tcl_ObjType *typePtr) /* Information about object type; storage must
* be statically allocated (must live
* forever). */
{
int isNew;
Tcl_MutexLock(&tableMutex);
Tcl_SetHashValue(
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | 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 |
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, name, &isNew), typePtr);
Tcl_MutexUnlock(&tableMutex);
}
/*
*----------------------------------------------------------------------
*
* Tcl_AppendAllObjTypes --
|
| ︙ | ︙ | |||
937 938 939 940 941 942 943 |
const Tcl_ObjType *typePtr) /* The target type. */
{
if (objPtr->typePtr == typePtr) {
return TCL_OK;
}
/*
| | | 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 |
const Tcl_ObjType *typePtr) /* The target type. */
{
if (objPtr->typePtr == typePtr) {
return TCL_OK;
}
/*
* 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(
|
| ︙ | ︙ | |||
1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 | /* *---------------------------------------------------------------------- * * Tcl_DuplicateObj -- * * Create and return a new object that is a duplicate of the argument * object. * * 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 | > > > > > > > > | 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 | /* *---------------------------------------------------------------------- * * 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 |
| ︙ | ︙ | |||
1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 |
{
Tcl_Obj *dupPtr;
TclNewObj(dupPtr);
SetDuplicateObj(dupPtr, objPtr);
return dupPtr;
}
void
TclSetDuplicateObj(
Tcl_Obj *dupPtr,
Tcl_Obj *objPtr)
{
if (Tcl_IsShared(dupPtr)) {
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
{
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)) {
|
| ︙ | ︙ | |||
1655 1656 1657 1658 1659 1660 1661 | * Side effects: * May call the object's updateStringProc to update the string * representation from the internal representation. * *---------------------------------------------------------------------- */ | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | 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 |
* Side effects:
* May call the object's updateStringProc to update the string
* representation from the internal representation.
*
*----------------------------------------------------------------------
*/
char *
Tcl_GetStringFromObj(
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
* 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
|
| ︙ | ︙ | |||
1994 1995 1996 1997 1998 1999 2000 | * * Side effects: * The internalrep of *objPtr may be changed. * *---------------------------------------------------------------------- */ | < | 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 |
*
* Side effects:
* The internalrep of *objPtr may be changed.
*
*----------------------------------------------------------------------
*/
int
Tcl_GetBoolFromObj(
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. */
{
|
| ︙ | ︙ | |||
2017 2018 2019 2020 2021 2022 2023 |
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 {
| | | | | 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 |
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 (objPtr->typePtr == tclIntType || objPtr->typePtr == tclBooleanType) {
result = (objPtr->internalRep.wideValue != 0);
goto boolEnd;
}
if (objPtr->typePtr == tclDoubleType) {
/*
* 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 (objPtr->typePtr == tclBignumType) {
result = 1;
boolEnd:
if (charPtr != NULL) {
flags &= (TCL_NULL_OK-2);
if (flags) {
if (flags == (int)sizeof(int)) {
*(int *)charPtr = result;
|
| ︙ | ︙ | |||
2064 2065 2066 2067 2068 2069 2070 |
}
} while ((ParseBoolean(objPtr) == TCL_OK) || (TCL_OK ==
TclParseNumber(interp, objPtr, (flags & TCL_NULL_OK)
? "boolean value or \"\"" : "boolean value", NULL,-1,NULL,0)));
return TCL_ERROR;
}
| < | 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 |
}
} while ((ParseBoolean(objPtr) == TCL_OK) || (TCL_OK ==
TclParseNumber(interp, objPtr, (flags & TCL_NULL_OK)
? "boolean value or \"\"" : "boolean value", NULL,-1,NULL,0)));
return TCL_ERROR;
}
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. */
{
return Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof(int), (char *)(void *)intPtr);
|
| ︙ | ︙ | |||
2106 2107 2108 2109 2110 2111 2112 |
/*
* 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) {
| | | | | 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 |
/*
* 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 (objPtr->typePtr == tclIntType) {
if ((Tcl_WideUInt)objPtr->internalRep.wideValue < 2) {
return TCL_OK;
}
goto badBoolean;
}
if (objPtr->typePtr == tclBignumType) {
goto badBoolean;
}
if (objPtr->typePtr == tclDoubleType) {
goto badBoolean;
}
}
if (ParseBoolean(objPtr) == TCL_OK) {
return TCL_OK;
}
|
| ︙ | ︙ | |||
2248 2249 2250 2251 2252 2253 2254 |
* as possible to allow the conversion code, in particular
* Tcl_GetStringFromObj, to use that old internalRep.
*/
goodBoolean:
TclFreeInternalRep(objPtr);
objPtr->internalRep.wideValue = newBool;
| | | | 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 |
* 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;
return TCL_OK;
numericBoolean:
TclFreeInternalRep(objPtr);
objPtr->internalRep.wideValue = newBool;
objPtr->typePtr = tclIntType;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Tcl_NewDoubleObj --
|
| ︙ | ︙ | |||
2346 2347 2348 2349 2350 2351 2352 |
Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
/* Optimized TclInvalidateStringRep() */
objPtr->bytes = NULL;
objPtr->internalRep.doubleValue = dblValue;
| | | 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 |
Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
/* Optimized TclInvalidateStringRep() */
objPtr->bytes = NULL;
objPtr->internalRep.doubleValue = dblValue;
objPtr->typePtr = tclDoubleType;
return objPtr;
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_DbNewDoubleObj(
|
| ︙ | ︙ | |||
2419 2420 2421 2422 2423 2424 2425 |
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. */
{
do {
| | | | | 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 |
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. */
{
do {
if (objPtr->typePtr == tclDoubleType) {
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",
(void *)NULL);
}
return TCL_ERROR;
}
*dblPtr = (double) objPtr->internalRep.doubleValue;
return TCL_OK;
}
if (objPtr->typePtr == tclIntType) {
*dblPtr = (double) objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == tclBignumType) {
mp_int big;
TclUnpackBignum(objPtr, big);
*dblPtr = TclBignumToDouble(&big);
return TCL_OK;
}
} while (SetDoubleFromAny(interp, objPtr) == TCL_OK);
|
| ︙ | ︙ | |||
2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 |
}
return TCL_ERROR;
}
*intPtr = (int) l;
return TCL_OK;
#endif
}
/*
*----------------------------------------------------------------------
*
* SetIntFromAny --
*
| > > > > > > > > > > > | 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 |
}
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 --
*
|
| ︙ | ︙ | |||
2650 2651 2652 2653 2654 2655 2656 |
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. */
{
do {
#ifdef TCL_WIDE_INT_IS_LONG
| | | | | | 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 |
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. */
{
do {
#ifdef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == tclIntType) {
*longPtr = objPtr->internalRep.wideValue;
return TCL_OK;
}
#else
if (objPtr->typePtr == tclIntType) {
/*
* 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 (objPtr->typePtr == tclDoubleType) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"",
TclGetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL);
}
return TCL_ERROR;
}
if (objPtr->typePtr == tclBignumType) {
/*
* 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.
*/
|
| ︙ | ︙ | |||
2911 2912 2913 2914 2915 2916 2917 |
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)
/* Place to store resulting long. */
{
do {
| | | | | 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 |
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)
/* Place to store resulting long. */
{
do {
if (objPtr->typePtr == tclIntType) {
*wideIntPtr = objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == tclDoubleType) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"",
TclGetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL);
}
return TCL_ERROR;
}
if (objPtr->typePtr == tclBignumType) {
/*
* 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;
|
| ︙ | ︙ | |||
2996 2997 2998 2999 3000 3001 3002 |
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)
/* Place to store resulting long. */
{
do {
| | | | | 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 |
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)
/* Place to store resulting long. */
{
do {
if (objPtr->typePtr == tclIntType) {
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", (void *)NULL);
}
return TCL_ERROR;
}
*wideUIntPtr = (Tcl_WideUInt)objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == tclDoubleType) {
goto wideUIntOutOfRange;
}
if (objPtr->typePtr == tclBignumType) {
/*
* 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;
|
| ︙ | ︙ | |||
3080 3081 3082 3083 3084 3085 3086 |
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. */
{
do {
| | | | | 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 |
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. */
{
do {
if (objPtr->typePtr == tclIntType) {
*wideIntPtr = objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == tclDoubleType) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"",
TclGetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL);
}
return TCL_ERROR;
}
if (objPtr->typePtr == tclBignumType) {
mp_int big;
mp_err err;
Tcl_WideUInt value = 0, scratch;
size_t numBytes;
unsigned char *bytes = (unsigned char *) &scratch;
|
| ︙ | ︙ | |||
3206 3207 3208 3209 3210 3211 3212 |
DupBignum(
Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr)
{
mp_int bignumVal;
mp_int bignumCopy;
| | | 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 |
DupBignum(
Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr)
{
mp_int bignumVal;
mp_int bignumCopy;
copyPtr->typePtr = tclBignumType;
TclUnpackBignum(srcPtr, bignumVal);
if (mp_init_copy(&bignumCopy, &bignumVal) != MP_OKAY) {
Tcl_Panic("initialization failure in DupBignum");
}
PACK_BIGNUM(bignumCopy, copyPtr);
}
|
| ︙ | ︙ | |||
3376 3377 3378 3379 3380 3381 3382 |
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 {
| | | 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 |
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 (objPtr->typePtr == tclBignumType) {
if (copy || Tcl_IsShared(objPtr)) {
mp_int temp;
TclUnpackBignum(objPtr, temp);
if (mp_init_copy(bignumValue, &temp) != MP_OKAY) {
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
3401 3402 3403 3404 3405 3406 3407 |
*/
if (objPtr->bytes == NULL) {
TclInitEmptyStringRep(objPtr);
}
}
return TCL_OK;
}
| | | | 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 |
*/
if (objPtr->bytes == NULL) {
TclInitEmptyStringRep(objPtr);
}
}
return TCL_OK;
}
if (objPtr->typePtr == tclIntType) {
if (mp_init_i64(bignumValue,
objPtr->internalRep.wideValue) != MP_OKAY) {
return TCL_ERROR;
}
return TCL_OK;
}
if (objPtr->typePtr == tclDoubleType) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"",
TclGetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL);
}
return TCL_ERROR;
|
| ︙ | ︙ | |||
3568 3569 3570 3571 3572 3573 3574 |
void
TclSetBignumInternalRep(
Tcl_Obj *objPtr,
void *big)
{
mp_int *bignumValue = (mp_int *)big;
| | | 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 |
void
TclSetBignumInternalRep(
Tcl_Obj *objPtr,
void *big)
{
mp_int *bignumValue = (mp_int *)big;
objPtr->typePtr = tclBignumType;
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.
|
| ︙ | ︙ | |||
3591 3592 3593 3594 3595 3596 3597 | *---------------------------------------------------------------------- * * Tcl_GetNumberFromObj -- * * Extracts a number (of any possible numeric type) from an object. * * Results: | | | < | | | | | | | 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 |
*----------------------------------------------------------------------
*
* Tcl_GetNumberFromObj --
*
* Extracts a number (of any possible numeric type) from an object.
*
* Results:
* 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
* at the address given by clientDataPtr.
*
* Side effects:
* 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)
{
do {
if (objPtr->typePtr == tclDoubleType) {
if (isnan(objPtr->internalRep.doubleValue)) {
*typePtr = TCL_NUMBER_NAN;
} else {
*typePtr = TCL_NUMBER_DOUBLE;
}
*clientDataPtr = &objPtr->internalRep.doubleValue;
return TCL_OK;
}
if (objPtr->typePtr == tclIntType) {
*typePtr = TCL_NUMBER_INT;
*clientDataPtr = &objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == tclBignumType) {
static Tcl_ThreadDataKey bignumKey;
mp_int *bigPtr = (mp_int *)Tcl_GetThreadData(&bignumKey,
sizeof(mp_int));
TclUnpackBignum(objPtr, *bigPtr);
*typePtr = TCL_NUMBER_BIG;
*clientDataPtr = bigPtr;
|
| ︙ | ︙ | |||
4468 4469 4470 4471 4472 4473 4474 4475 4476 4477 4478 4479 4480 4481 |
ResolvedCmdName *resPtr = (ResolvedCmdName *)srcPtr->internalRep.twoPtrValue.ptr1;
copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;
copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
resPtr->refCount++;
copyPtr->typePtr = &tclCmdNameType;
}
/*
*----------------------------------------------------------------------
*
* SetCmdNameFromAny --
*
* Generate an cmdName internal form for the Tcl object "objPtr".
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
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".
|
| ︙ | ︙ | |||
4580 4581 4582 4583 4584 4585 4586 4587 4588 |
/*
* Value is a bignum with a refcount of 14, object pointer at 0x12345678,
* internal representation 0x45671234:0x98765432, string representation
* "1872361827361287"
*/
descObj = Tcl_ObjPrintf("value is a %s with a refcount of %" TCL_Z_MODIFIER "u,"
" object pointer at %p",
| > | | | 4786 4787 4788 4789 4790 4791 4792 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 4807 |
/*
* 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_Z_MODIFIER "u,"
" object pointer at %p",
name,
objv[1]->refCount, objv[1]);
if (objv[1]->typePtr) {
if (objv[1]->typePtr == tclDoubleType) {
Tcl_AppendPrintfToObj(descObj, ", internal representation %g",
objv[1]->internalRep.doubleValue);
} else {
Tcl_AppendPrintfToObj(descObj, ", internal representation %p:%p",
(void *) objv[1]->internalRep.twoPtrValue.ptr1,
(void *) objv[1]->internalRep.twoPtrValue.ptr2);
}
|
| ︙ | ︙ | |||
4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 |
} else {
Tcl_AppendToObj(descObj, ", no string representation", -1);
}
Tcl_SetObjResult(interp, descObj);
return TCL_OK;
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* tab-width: 8
* indent-tabs-mode: nil
* End:
*/
| > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
} 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 | /* | < < < < > > > > > > > > > > > > > > > | 1 2 3 4 5 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 © 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. */ |
| ︙ | ︙ |
Changes to generic/tclPanic.c.
1 | /* | < < < < < < > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 © 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 | /* | < < < < < < > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 © 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. |
| ︙ | ︙ |
Changes to generic/tclParse.h.
1 2 3 4 5 6 7 | /* * Minimal set of shared macro definitions and declarations so that multiple * source files can make use of the parsing table in tclParse.c */ #define TYPE_NORMAL 0 #define TYPE_SPACE 0x1 | > > > > > > > > > | 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 macro definitions and declarations so that multiple * source files can make use of the parsing table in tclParse.c */ #define TYPE_NORMAL 0 #define TYPE_SPACE 0x1 |
| ︙ | ︙ |
Changes to generic/tclPathObj.c.
1 2 3 4 5 6 | /* * 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. | > > > > > > > > > > > > > > > > < < < < < | 1 2 3 4 5 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. */ #include "tclInt.h" #include "tclFileSystem.h" #include <assert.h> /* |
| ︙ | ︙ | |||
41 42 43 44 45 46 47 |
static const Tcl_ObjType fsPathType = {
"path", /* name */
FreeFsPathInternalRep, /* freeIntRepProc */
DupFsPathInternalRep, /* dupIntRepProc */
UpdateStringOfFsPath, /* updateStringProc */
SetFsPathFromAny, /* setFromAnyProc */
| < > | 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 */
0
};
/*
* struct FsPath --
*
* Internal representation of a Tcl_Obj of fsPathType
*/
|
| ︙ | ︙ |
Changes to generic/tclPipe.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ /* * You may distribute and/or modify this program under the terms of the GNU * Affero General Public License as published by the Free Software Foundation, * either version 3 of the License, or (at your 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 | /* | < < < < < > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 © 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" |
| ︙ | ︙ |
Changes to generic/tclPkgConfig.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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 © 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 | /* * tclPlatDecls.h -- * * Declarations of platform specific Tcl APIs. | > > > > > > > > > > > > > > < < < | 1 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. */ #ifndef _TCLPLATDECLS #define _TCLPLATDECLS #undef TCL_STORAGE_CLASS #ifdef BUILD_tcl |
| ︙ | ︙ | |||
44 45 46 47 48 49 50 | # ifdef __cplusplus # define MODULE_SCOPE extern "C" # else # define MODULE_SCOPE extern # endif #endif | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | | 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
/* !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,
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, 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 | (tclPlatStubsPtr->tcl_MacOSXNotifierAddRunLoopMode) /* 2 */ #define Tcl_WinConvertError \ (tclPlatStubsPtr->tcl_WinConvertError) /* 3 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ | < < < > > > > > > > > > > | < | 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. */ #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__)) #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 | /* * tclPort.h -- * * This header file handles porting issues that occur because * of differences between systems. It reads in platform specific * portability files. | > > > > > > > > > > > > > > > > < < < < < | 1 2 3 4 5 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. */ #ifndef _TCLPORT #define _TCLPORT #ifdef HAVE_TCL_CONFIG_H #include "tclConfig.h" |
| ︙ | ︙ |
Changes to generic/tclPosixStr.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 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 © 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 -- * |
| ︙ | ︙ |
Changes to generic/tclPreserve.c.
1 | /* | < < < < < < > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 © 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 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 © 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. */ /* * You may distribute and/or modify this program under the terms of the GNU * Affero General Public License as published by the Free Software Foundation, * either version 3 of the License, or (at your 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 |
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. */
| < > | 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 |
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. */
0
};
#define ProcSetInternalRep(objPtr, procPtr) \
do { \
Tcl_ObjInternalRep ir; \
(procPtr)->refCount++; \
ir.twoPtrValue.ptr1 = (procPtr); \
|
| ︙ | ︙ | |||
91 92 93 94 95 96 97 |
*
* Uses the default behaviour throughout, and never disposes of the string
* rep; it's just a cache type.
*/
static const Tcl_ObjType levelReferenceType = {
"levelReference",
| | < > | 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 |
*
* Uses the default behaviour throughout, and never disposes of the string
* rep; it's just a cache type.
*/
static const Tcl_ObjType levelReferenceType = {
"levelReference",
NULL, NULL, NULL, NULL, 0
};
/*
* 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 */
0
};
#define LambdaSetInternalRep(objPtr, procPtr, nsObjPtr) \
do { \
Tcl_ObjInternalRep ir; \
ir.twoPtrValue.ptr1 = (procPtr); \
ir.twoPtrValue.ptr2 = (nsObjPtr); \
|
| ︙ | ︙ |
Changes to generic/tclProcess.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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 © 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). */ |
| ︙ | ︙ |
Changes to generic/tclRegexp.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 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 © 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 |
const Tcl_ObjType tclRegexpType = {
"regexp", /* name */
FreeRegexpInternalRep, /* freeIntRepProc */
DupRegexpInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
SetRegexpFromAny, /* setFromAnyProc */
| < > | 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 */
0
};
#define RegexpSetInternalRep(objPtr, rePtr) \
do { \
Tcl_ObjInternalRep ir; \
(rePtr)->refCount++; \
ir.twoPtrValue.ptr1 = (rePtr); \
|
| ︙ | ︙ |
Changes to generic/tclRegexp.h.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 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 (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 | /* * 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. | > > > > > > > > > > > > > > > > < < < < < | 1 2 3 4 5 6 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. */ #include "tclInt.h" /* * Declarations for functions local to this file: */ |
| ︙ | ︙ |
Changes to generic/tclResult.c.
1 | /* | < < < < > > > > > > > > > > > > > > > | 1 2 3 4 5 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. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ /* * You may distribute and/or modify this program under the terms of the GNU * Affero General Public License as published by the Free Software Foundation, * either version 3 of the License, or (at your 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. */ |
| ︙ | ︙ |
Changes to generic/tclScan.c.
1 | /* | < < < < > > > > > > > > > > > > > > > | 1 2 3 4 5 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. */ /* * 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. */ |
| ︙ | ︙ | |||
1042 1043 1044 1045 1046 1047 1048 |
Tcl_DecrRefCount(objPtr);
string = end;
} else {
double dvalue;
if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) {
#ifdef ACCEPT_NAN
const Tcl_ObjInternalRep *irPtr
| | | 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 |
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);
if (irPtr) {
dvalue = irPtr->doubleValue;
} else
#endif
{
Tcl_DecrRefCount(objPtr);
goto done;
|
| ︙ | ︙ |
Changes to generic/tclStrToD.c.
1 2 3 4 5 6 7 8 | /* * 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. | > > > > > > > > > > > > > > > > < < < < < | 1 2 3 4 5 6 7 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. */ #include "tclInt.h" #include "tclTomMath.h" #include <float.h> #include <math.h> |
| ︙ | ︙ | |||
545 546 547 548 549 550 551 |
/*
* 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) {
| | | | 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 |
/*
* 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, tclDictTypePtr)) {
/* A dict can never be a (single) number */
return TCL_ERROR;
}
if (TclHasInternalRep(objPtr, tclListTypePtr)) {
Tcl_Size length;
/* A list can only be a (single) number if its length == 1 */
TclListObjLengthM(NULL, objPtr, &length);
if (length != 1) {
return TCL_ERROR;
}
}
|
| ︙ | ︙ | |||
1381 1382 1383 1384 1385 1386 1387 |
}
if (!octalSignificandOverflow) {
if ((err == MP_OKAY) && (octalSignificandWide > (MOST_BITS + signum))) {
err = mp_init_u64(&octalSignificandBig,
octalSignificandWide);
octalSignificandOverflow = 1;
} else {
| | | 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 |
}
if (!octalSignificandOverflow) {
if ((err == MP_OKAY) && (octalSignificandWide > (MOST_BITS + signum))) {
err = mp_init_u64(&octalSignificandBig,
octalSignificandWide);
octalSignificandOverflow = 1;
} else {
objPtr->typePtr = tclIntType;
if (signum) {
objPtr->internalRep.wideValue =
(Tcl_WideInt)(-octalSignificandWide);
} else {
objPtr->internalRep.wideValue =
(Tcl_WideInt)octalSignificandWide;
}
|
| ︙ | ︙ | |||
1417 1418 1419 1420 1421 1422 1423 |
returnInteger:
if (!significandOverflow) {
if ((err == MP_OKAY) && (significandWide > MOST_BITS+signum)) {
err = mp_init_u64(&significandBig,
significandWide);
significandOverflow = 1;
} else {
| | | 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 |
returnInteger:
if (!significandOverflow) {
if ((err == MP_OKAY) && (significandWide > MOST_BITS+signum)) {
err = mp_init_u64(&significandBig,
significandWide);
significandOverflow = 1;
} else {
objPtr->typePtr = tclIntType;
if (signum) {
objPtr->internalRep.wideValue =
(Tcl_WideInt)(-significandWide);
} else {
objPtr->internalRep.wideValue =
(Tcl_WideInt)significandWide;
}
|
| ︙ | ︙ | |||
1449 1450 1451 1452 1453 1454 1455 | * 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. */ | | | 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 |
* 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;
if (exponentSignum) {
/*
* At this point exponent>=0, so the following calculation
* cannot underflow.
*/
exponent = -exponent;
}
|
| ︙ | ︙ | |||
1500 1501 1502 1503 1504 1505 1506 |
case sINF:
case sINFINITY:
if (signum) {
objPtr->internalRep.doubleValue = -HUGE_VAL;
} else {
objPtr->internalRep.doubleValue = HUGE_VAL;
}
| | | | 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 |
case sINF:
case sINFINITY:
if (signum) {
objPtr->internalRep.doubleValue = -HUGE_VAL;
} else {
objPtr->internalRep.doubleValue = HUGE_VAL;
}
objPtr->typePtr = tclDoubleType;
break;
#ifdef IEEE_FLOATING_POINT
case sNAN:
case sNANFINISH:
objPtr->internalRep.doubleValue = MakeNaN(signum, significandWide);
objPtr->typePtr = tclDoubleType;
break;
#endif
case INITIAL:
/* This case only to silence compiler warning. */
Tcl_Panic("TclParseNumber: state INITIAL can't happen here");
}
}
|
| ︙ | ︙ |
Changes to generic/tclStringObj.c.
1 2 3 4 5 6 7 | /* * 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. | > > > > > > > > > > > > > > > > > | 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-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. |
| ︙ | ︙ | |||
20 21 22 23 24 25 26 | * 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. | < < < < < < | 37 38 39 40 41 42 43 44 45 46 47 48 49 50 | * 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. */ #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 | 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 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); | > > < < < < > | 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);
/*
* 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 */
0
};
/*
* TCL STRING GROWTH ALGORITHM
*
* When growing strings (during an append, for example), the following growth
* algorithm is used:
|
| ︙ | ︙ | |||
368 369 370 371 372 373 374 | * * Side effects: * Frees old internal rep. Allocates memory for new "String" internal * rep. * *---------------------------------------------------------------------- */ | < > > > > > > > > > > > > > > > > > > > | > | > | > | 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 |
*
* 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 */
*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);
*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;
}
*length = numChars;
return TCL_OK;
}
Tcl_Size
TclGetCharLength(
Tcl_Obj *objPtr) /* The String object to get the num chars
* of. */
{
|
| ︙ | ︙ | |||
477 478 479 480 481 482 483 | * Side effects: * None. * *---------------------------------------------------------------------- */ int TclCheckEmptyString( | > | > > > | > | > | | > > > | > > | > > > | > > > > > > > | > | > | > | 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 |
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
TclCheckEmptyString(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
int *res
)
{
int status;
Tcl_Size length = 0;
if (objPtr->bytes == &tclEmptyString) {
*res = TCL_EMPTYSTRING_YES;
return TCL_OK;
}
if (TclIsPureByteArray(objPtr)
&& Tcl_GetCharLength(objPtr) == 0) {
*res = TCL_EMPTYSTRING_YES;
return TCL_OK;
}
if (TclListObjIsCanonical(objPtr)) {
status = TclListObjLengthM(interp, objPtr, &length);
if (status) {
return status;
} else {
*res = length == 0;
return TCL_OK;
}
}
if (TclIsPureDict(objPtr)) {
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 {
*res = TCL_EMPTYSTRING_UNKNOWN;
return TCL_OK;
}
}
*res = objPtr->length == 0;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetUniChar --
*
|
| ︙ | ︙ | |||
642 643 644 645 646 647 648 | * Side effects: * Converts the object to have the String internal rep. * *---------------------------------------------------------------------- */ #undef Tcl_GetUnicodeFromObj | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 697 698 699 700 701 702 703 704 705 706 707 708 709 710 |
* Side effects:
* Converts the object to have the String internal rep.
*
*----------------------------------------------------------------------
*/
#undef Tcl_GetUnicodeFromObj
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. */
|
| ︙ | ︙ | |||
718 719 720 721 722 723 724 | * Changes the internal rep of "objPtr" to the String type. * *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_GetRange( | | | | > > > > > > > > > | 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 |
* Changes the internal rep of "objPtr" to the String type.
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
Tcl_GetRange(
Tcl_Obj *objPtr,
Tcl_Size first,
Tcl_Size last)
{
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;
}
|
| ︙ | ︙ | |||
743 744 745 746 747 748 749 |
unsigned char *bytes = Tcl_GetBytesFromObj(NULL, objPtr, &length);
if (last < 0 || last >= length) {
last = length - 1;
}
if (last < first) {
TclNewObj(newObjPtr);
| | > | > > | | > | > | > | > > | > > | 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 |
unsigned char *bytes = Tcl_GetBytesFromObj(NULL, objPtr, &length);
if (last < 0 || last >= length) {
last = length - 1;
}
if (last < first) {
TclNewObj(newObjPtr);
*resPtrPtr = newObjPtr;
return TCL_OK;
}
*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(
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);
*resPtrPtr = newObjPtr;
return TCL_OK;
}
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;
*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);
*resPtrPtr = newObjPtr;
return TCL_OK;
}
*resPtrPtr = Tcl_NewUnicodeObj(
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. */
|
| ︙ | ︙ | |||
1247 1248 1249 1250 1251 1252 1253 |
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_AppendLimitedToObj");
}
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
| < < < < < < | 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 |
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_AppendLimitedToObj");
}
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode && (stringPtr->numChars) > 0) {
AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
} else {
AppendUtfToUtfRep(objPtr, bytes, toCopy);
}
if (length <= limit) {
|
| ︙ | ︙ | |||
1380 1381 1382 1383 1384 1385 1386 1387 |
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;
| > > > > > > > | > > > > | | 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 |
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 (isEmpty == TCL_EMPTYSTRING_YES) {
return;
}
status = TclCheckEmptyString(NULL, objPtr, &isEmpty);
if (status) {
Tcl_Panic("%s: TclCheckEmptyString failed, %s", "Tcl_AppendObjToObj", "objPtr");
}
if (isEmpty == TCL_EMPTYSTRING_YES) {
TclSetDuplicateObj(objPtr, appendObjPtr);
return;
}
if (
TclIsPureByteArray(appendObjPtr)
&& (TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString)
|
| ︙ | ︙ | |||
1452 1453 1454 1455 1456 1457 1458 |
/*
* Must append as strings.
*/
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
| < < < < < < < | 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 |
/*
* Must append as strings.
*/
SetStringFromAny(NULL, 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) {
/*
|
| ︙ | ︙ | |||
3084 3085 3086 3087 3088 3089 3090 |
Tcl_Size objc,
Tcl_Obj * const objv[],
int flags)
{
Tcl_Obj *objResultPtr, * const *ov;
int binary = 1;
Tcl_Size oc, length = 0;
| | | 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 |
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;
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);
/* assert ( objc >= 0 ) */
if (objc <= 1) {
|
| ︙ | ︙ | |||
3126 3127 3128 3129 3130 3131 3132 |
if (objPtr->length) {
/*
* Non-empty string rep. Not a pure bytearray, so we won't
* create a pure bytearray.
*/
binary = 0;
| < < | | 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 |
if (objPtr->length) {
/*
* Non-empty string rep. Not a pure bytearray, so we won't
* create a pure bytearray.
*/
binary = 0;
if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
/* Prevent shimmer of non-string types. */
allowUniChar = 0;
}
}
} else {
/* assert (objPtr->typePtr != NULL) -- stork! */
binary = 0;
|
| ︙ | ︙ | |||
3178 3179 3180 3181 3182 3183 3184 |
if (length > (TCL_SIZE_MAX-numBytes)) {
goto overflow;
}
length += numBytes;
}
}
} while (--oc);
| | | 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 |
if (length > (TCL_SIZE_MAX-numBytes)) {
goto overflow;
}
length += numBytes;
}
}
} while (--oc);
} else if ((allowUniChar && requestUniChar)) {
/*
* Result will be pure Tcl_UniChar array. Pre-size it.
*/
ov = objv;
oc = objc;
do {
|
| ︙ | ︙ | |||
3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 |
/*
* Loop until a possibly non-empty value is reached.
* Keep string rep generation pending when possible.
*/
do {
/* assert ( pendingPtr == NULL ) */
/* assert ( length == 0 ) */
Tcl_Obj *objPtr = *ov++;
if (objPtr->bytes == NULL
| > > > > > | | 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 |
/*
* Loop until a possibly non-empty value is reached.
* Keep string rep generation pending when possible.
*/
do {
int isEmpty, status;
/* assert ( pendingPtr == NULL ) */
/* assert ( length == 0 ) */
Tcl_Obj *objPtr = *ov++;
status = TclCheckEmptyString(NULL, objPtr, &isEmpty);
if (status) {
return NULL;
}
if (objPtr->bytes == NULL
&& isEmpty != TCL_EMPTYSTRING_YES) {
/* No string rep; Take the chance we can avoid making it */
pendingPtr = objPtr;
} else {
(void)Tcl_GetStringFromObj(objPtr, &length); /* PANIC? */
}
} while (--oc && (length == 0) && (pendingPtr == NULL));
|
| ︙ | ︙ | |||
3335 3336 3337 3338 3339 3340 3341 |
if (TclIsPureByteArray(objPtr)) {
Tcl_Size more = 0;
unsigned char *src = Tcl_GetBytesFromObj(NULL, objPtr, &more);
memcpy(dst, src, more);
dst += more;
}
}
| | | 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 |
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)) {
/* Efficiently produce a pure Tcl_UniChar array result */
Tcl_UniChar *dst;
if (inPlace) {
Tcl_Size start;
objResultPtr = *objv++; objc--;
|
| ︙ | ︙ | |||
3474 3475 3476 3477 3478 3479 3480 |
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;
| | | 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 |
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, 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
|
| ︙ | ︙ | |||
3545 3546 3547 3548 3549 3550 3551 |
}
} else {
memCmpFn = (memCmpFn_t)(void *)TclUniCharNcmp;
}
}
}
} else {
| | > > > > > > > > > | | | 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 |
}
} else {
memCmpFn = (memCmpFn_t)(void *)TclUniCharNcmp;
}
}
}
} else {
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 (empty2) {
case -1:
s1 = 0;
s1len = 0;
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 (empty2 > 0) {
switch (empty) {
case -1:
s2 = 0;
s2len = 0;
s1 = Tcl_GetStringFromObj(value1Ptr, &s1len);
break;
case 0:
|
| ︙ | ︙ | |||
3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 |
goto firstEnd;
}
}
firstEnd:
TclNewIndexObj(obj, value);
return obj;
}
/*
*---------------------------------------------------------------------------
*
* TclStringLast --
*
* Implements the [string last] operation.
| > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
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 | /* * 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. | > > > > > > > > > > > > > > > > > < < < < < < | 1 2 3 4 5 6 7 8 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. */ #ifndef _TCLSTRINGREP #define _TCLSTRINGREP /* |
| ︙ | ︙ |
Changes to generic/tclStringTrim.h.
1 | /* | < < < < < < > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 (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 | /* | < < > > > > > > > > > > > > > | 1 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. */ /* * 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 dlerror() "" |
| ︙ | ︙ |
Changes to generic/tclStubInit.c.
1 | /* | < < < < > > > > > > > > > > > > > > > | 1 2 3 4 5 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-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 | #undef Tcl_ListObjGetElements #undef Tcl_ListObjLength #undef Tcl_DictObjSize #undef Tcl_SplitList #undef Tcl_SplitPath #undef Tcl_FSSplitPath #undef Tcl_ParseArgsObjv #undef TclStaticLibrary #define TclStaticLibrary Tcl_StaticLibrary #undef Tcl_UniCharToUtfDString #undef Tcl_UtfToUniCharDString #undef Tcl_UtfToUniChar #undef Tcl_UniCharLen #undef TclObjInterpProc #if !defined(_WIN32) && !defined(__CYGWIN__) # undef Tcl_WinConvertError # define Tcl_WinConvertError 0 #endif | > > > > > > < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 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 | #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 Tcl_UniCharToUtfDString #undef Tcl_UtfToUniCharDString #undef Tcl_UtfToUniChar #undef Tcl_UniCharLen #undef TclObjInterpProc #if !defined(_WIN32) && !defined(__CYGWIN__) # undef Tcl_WinConvertError # define Tcl_WinConvertError 0 #endif # undef TclGetStringFromObj # undef TclGetBytesFromObj # undef TclGetUnicodeFromObj # define TclGetStringFromObj 0 # define TclGetBytesFromObj 0 # define TclGetUnicodeFromObj 0 #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 # define TclListObjGetElements 0 # define TclListObjLength 0 # define TclDictObjSize 0 # define TclSplitList 0 # define TclSplitPath 0 # define TclFSSplitPath 0 # define TclParseArgsObjv 0 #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 |
| ︙ | ︙ | |||
1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 |
Tcl_RemoveChannelMode, /* 682 */
Tcl_GetEncodingNulLength, /* 683 */
Tcl_GetWideUIntFromObj, /* 684 */
Tcl_DStringToObj, /* 685 */
0, /* 686 */
0, /* 687 */
TclUnusedStubEntry, /* 688 */
};
/* !END!: Do not edit above this line. */
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
Tcl_RemoveChannelMode, /* 682 */
Tcl_GetEncodingNulLength, /* 683 */
Tcl_GetWideUIntFromObj, /* 684 */
Tcl_DStringToObj, /* 685 */
0, /* 686 */
0, /* 687 */
TclUnusedStubEntry, /* 688 */
Tcl_NewObjInterface, /* 689 */
Tcl_NewObjType, /* 690 */
Tcl_ObjInterfaceSetVersion, /* 691 */
Tcl_ObjTypeSetFreeInternalRepProc, /* 692 */
Tcl_ObjTypeSetDupInternalRepProc, /* 693 */
Tcl_ObjTypeSetUpdateStringProc, /* 694 */
Tcl_ObjTypeSetSetFromAnyProc, /* 695 */
Tcl_ObjTypeSetVersion, /* 696 */
Tcl_ObjInterfaceSetFnListAll, /* 697 */
Tcl_ObjInterfaceSetFnListAppend, /* 698 */
Tcl_ObjInterfaceSetFnListAppendList, /* 699 */
Tcl_ObjInterfaceSetFnListIndex, /* 700 */
Tcl_ObjInterfaceSetFnListIndexEnd, /* 701 */
Tcl_ObjInterfaceSetFnListIsSorted, /* 702 */
Tcl_ObjInterfaceSetFnListLength, /* 703 */
Tcl_ObjInterfaceSetFnListRange, /* 704 */
Tcl_ObjInterfaceSetFnListRangeEnd, /* 705 */
Tcl_ObjInterfaceSetFnListReplace, /* 706 */
Tcl_ObjInterfaceSetFnListReplaceList, /* 707 */
Tcl_ObjInterfaceSetFnListReverse, /* 708 */
Tcl_ObjInterfaceSetFnListSet, /* 709 */
Tcl_ObjInterfaceSetFnListSetDeep, /* 710 */
Tcl_ObjInterfaceSetFnStringIndex, /* 711 */
Tcl_ObjInterfaceSetFnStringIndexEnd, /* 712 */
Tcl_ObjInterfaceSetFnStringLength, /* 713 */
Tcl_ObjInterfaceSetFnStringRange, /* 714 */
Tcl_ObjInterfaceSetFnStringRangeEnd, /* 715 */
Tcl_ObjTypeSetInterface, /* 716 */
Tcl_ObjTypeSetName, /* 717 */
Tcl_ObjInterfaceSetFnStringIsEmpty, /* 718 */
Tcl_ObjInterfaceSetFnListContains, /* 719 */
};
/* !END!: Do not edit above this line. */
|
Changes to generic/tclStubLib.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 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-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; |
| ︙ | ︙ |
Changes to generic/tclStubLibTbl.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 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 (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 | /* | < < < < < < < > > > > | > > > | > > > > > > > > > > | | 1 2 3 4 5 6 7 8 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 | /* * 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. * 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 # define USE_TCL_STUBS #endif #include "tclInt.h" #ifdef TCL_WITH_EXTERNAL_TOMMATH # include "tommath.h" #else # include "tclTomMath.h" |
| ︙ | ︙ | |||
509 510 511 512 513 514 515 | #endif #ifdef PURIFY ".purify" #endif #ifdef STATIC_BUILD ".static" #endif | < < < | 519 520 521 522 523 524 525 526 527 528 529 530 531 532 |
#endif
#ifdef PURIFY
".purify"
#endif
#ifdef STATIC_BUILD
".static"
#endif
;
int
Tcltest_Init(
Tcl_Interp *interp) /* Interpreter for application. */
{
Tcl_CmdInfo info;
|
| ︙ | ︙ | |||
540 541 542 543 544 545 546 |
}
#endif
if (Tcl_OOInitStubs(interp) == NULL) {
return TCL_ERROR;
}
if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
| < < | 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 |
}
#endif
if (Tcl_OOInitStubs(interp) == NULL) {
return TCL_ERROR;
}
if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
if (info.isNativeObjectProc == 2) {
Tcl_CreateObjCommand2(interp, "::tcl::test::build-info",
info.objProc2, (void *)version, NULL);
} else
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;
}
|
| ︙ | ︙ | |||
723 724 725 726 727 728 729 730 731 732 733 734 735 736 |
Tcl_CreateObjCommand(interp, "testapplylambda", TestApplyLambdaObjCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testlutil", TestLutilCmd,
NULL, NULL);
if (TclObjTest_Init(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;
| > > > > > > | 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 |
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;
|
| ︙ | ︙ | |||
806 807 808 809 810 811 812 |
{
Tcl_CmdInfo info;
if (Tcl_InitStubs(interp, "8.7-", 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
| < < | 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 |
{
Tcl_CmdInfo info;
if (Tcl_InitStubs(interp, "8.7-", 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
if (info.isNativeObjectProc == 2) {
Tcl_CreateObjCommand2(interp, "::tcl::test::build-info",
info.objProc2, (void *)version, NULL);
} else
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);
|
| ︙ | ︙ | |||
2055 2056 2057 2058 2059 2060 2061 | /* * The procedure below is used as a special freeProc to test how well * Tcl_DStringGetResult handles freeProc's other than free. */ static void SpecialFree( | < < < < | 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 |
/*
* The procedure below is used as a special freeProc to test how well
* Tcl_DStringGetResult handles freeProc's other than free.
*/
static void SpecialFree(
void *blockPtr /* Block to free. */
) {
Tcl_Free(((char *)blockPtr) - 16);
}
/*
*------------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
3846 3847 3848 3849 3850 3851 3852 |
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 */
| | | 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 |
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 */
const char* subcommands[] = {
"new",
"describe",
"config",
"validate",
NULL
};
enum {
|
| ︙ | ︙ | |||
5760 5761 5762 5763 5764 5765 5766 |
TestbytestringObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
struct {
| < < < < > > > > > | 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 |
TestbytestringObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
struct {
Tcl_Size n;
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", (void *)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 |
/*
* 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.
* 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_ObjInterfaceListSetDeepProc my_LStringObjSetElemR;
static Tcl_DupInternalRepProc DupLStringRep;
static Tcl_ObjInterfaceListlengthProc my_LStringObjLength;
static Tcl_ObjInterfaceListIndexProc my_LStringObjIndex;
static Tcl_ObjInterfaceListRangeProc my_LStringObjRange;
static Tcl_ObjInterfaceListReverseProc my_LStringObjReverse;
static Tcl_ObjInterfaceListReplaceProc my_LStringReplace;
static Tcl_ObjInterfaceListAllProc my_LStringGetElements;
static void lstringFreeElements(Tcl_Obj* lstringObj);
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 ObjectType lstringTypes[11] = {
{/*0*/
"lstring",
freeRep,
DupLStringRep,
UpdateStringOfLString,
NULL,
2,
NULL
},
{/*1*/
"lstring",
freeRep,
DupLStringRep,
UpdateStringOfLString,
NULL,
2,
NULL
},
{/*2*/
"lstring",
freeRep,
DupLStringRep,
UpdateStringOfLString,
NULL,
2,
NULL
},
{/*3*/
"lstring",
freeRep,
DupLStringRep,
UpdateStringOfLString,
NULL,
2,
NULL
},
{/*4*/
"lstring",
freeRep,
DupLStringRep,
UpdateStringOfLString,
NULL,
2,
NULL
},
{/*5*/
"lstring",
freeRep,
DupLStringRep,
UpdateStringOfLString,
NULL,
2,
NULL
},
{/*6*/
"lstring",
freeRep,
DupLStringRep,
UpdateStringOfLString,
NULL,
2,
NULL
},
{/*7*/
"lstring",
freeRep,
DupLStringRep,
UpdateStringOfLString,
NULL,
2,
NULL
},
{/*8*/
"lstring",
freeRep,
DupLStringRep,
UpdateStringOfLString,
NULL,
2,
NULL
},
{/*9*/
"lstring",
freeRep,
DupLStringRep,
UpdateStringOfLString,
NULL,
2,
NULL
},
{/*10*/
"lstring",
freeRep,
DupLStringRep,
UpdateStringOfLString,
NULL,
2,
NULL
}
};
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
296 297 298 299 300 301 302 | * * Side effects: * None. * *---------------------------------------------------------------------- */ | | | | > | 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 |
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
my_LStringObjLength(TCL_UNUSED(Tcl_Interp *), Tcl_Obj *lstringObjPtr, Tcl_Size *lenPtr )
{
LString *lstringRepPtr = (LString *)lstringObjPtr->internalRep.twoPtrValue.ptr1;
*lenPtr = lstringRepPtr->strlen;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* DupLStringRep --
|
| ︙ | ︙ | |||
343 344 345 346 347 348 349 | return; } /* *---------------------------------------------------------------------- * | | | | | | > | | > | | > | | | | > | | | | > | | > | 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_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 int
my_LStringObjSetElemR(
Tcl_Interp *interp,
Tcl_Obj *lstringObj,
Tcl_Size numIndicies,
Tcl_Obj *const indices[],
Tcl_Obj *valueObj,
Tcl_Obj **resPtrPtr)
{
LString *lstringRepPtr = (LString*)lstringObj->internalRep.twoPtrValue.ptr1;
Tcl_Size index;
int status;
Tcl_Obj *resPtr;
if (numIndicies > 1) {
Tcl_SetObjResult(interp,
Tcl_ObjPrintf("Multiple indices not supported by lstring."));
*resPtrPtr = NULL;
return TCL_ERROR;
}
status = Tcl_GetIntForIndex(interp, indices[0], lstringRepPtr->strlen, &index);
if (status != TCL_OK) {
resPtrPtr = NULL;
return TCL_ERROR;
}
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(resPtr);
*resPtrPtr = resPtr;
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.
*
*----------------------------------------------------------------------
*/
int my_LStringObjRange(
Tcl_Interp *interp,
Tcl_Obj *lstringObj,
Tcl_Size fromIdx,
Tcl_Size toIdx,
Tcl_Obj **resPtrPtr)
{
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();
} 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;
}
*resPtrPtr = newObjPtr;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* my_LStringObjReverse --
|
| ︙ | ︙ | |||
489 490 491 492 493 494 495 | * Side effects: * A new Obj is created. * *---------------------------------------------------------------------- */ static int | | < < < | > | > > > > < < < < < | > | < | < < < < < < < < | 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)
{
LString *srcRep = (LString*)srcObj->internalRep.twoPtrValue.ptr1;
Tcl_Size len;
char *srcp, *endp;
char temp;
(void)interp;
if (Tcl_IsShared(srcObj)) {
Tcl_Panic("%s called with shared object", "my_LStringObjReverse");
}
len = srcRep->strlen;
srcp = srcRep->string;
endp = &srcRep->string[len];
endp--;
while (srcp < endp) {
temp = *endp;
*endp-- = *srcp;
*srcp++ = temp;
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* my_LStringReplace --
|
| ︙ | ︙ | |||
636 637 638 639 640 641 642 |
return TCL_OK;
}
static const Tcl_ObjType *
my_SetAbstractProc(int ptype)
{
| | | | 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 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 (Tcl_ObjType *)typePtr;
}
/*
*----------------------------------------------------------------------
*
* my_NewLStringObj --
|
| ︙ | ︙ | |||
679 680 681 682 683 684 685 |
static const char* procTypeNames[] = {
"FREEREP", "DUPREP", "UPDATESTRING", "SETFROMANY",
"LENGTH", "INDEX", "SLICE", "REVERSE", "GETELEMENTS",
"SETELEMENT", "REPLACE", NULL
};
int i = 0;
int ptype;
| | | 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 = (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 |
*/
static void
UpdateStringOfLString(Tcl_Obj *objPtr)
{
# define LOCAL_SIZE 64
int localFlags[LOCAL_SIZE], *flagPtr = NULL;
| < | > | | > | > | 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;
char *p;
int bytesNeeded = 0;
int status;
Tcl_Size i ,llen;
/*
* Handle empty list case first, so rest of the routine is simpler.
*/
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);
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 |
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);
| | | 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);
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 |
}
return elemObj;
}
/*
* Abstract List Length function
*/
| | | | > | 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 int
lgenSeriesObjLength(TCL_UNUSED(Tcl_Interp *), Tcl_Obj *objPtr, Tcl_Size *lenPtr)
{
LgenSeries *lgenSeriesRepPtr = (LgenSeries *)objPtr->internalRep.twoPtrValue.ptr1;
*lenPtr = lgenSeriesRepPtr->len;
return TCL_OK;
}
/*
* Abstract List Index function
*/
static int
lgenSeriesObjIndex(
|
| ︙ | ︙ | |||
1086 1087 1088 1089 1090 1091 1092 | static void DupLgenSeriesRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); /* * Abstract List ObjType definition */ | | > < < < > | < < < < < > > > | | 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 ObjectType lgenObjectType = {
"lgenseries",
FreeLgenInternalRep,
DupLgenSeriesRep,
UpdateStringOfLgen,
NULL, /* SetFromAnyProc */
0,
NULL
};
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 = 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 |
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;
| | | 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 = 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 |
*----------------------------------------------------------------------
*/
int Tcl_ABSListTest_Init(Tcl_Interp *interp) {
if (Tcl_InitStubs(interp, "8.7-", 0) == NULL) {
return TCL_ERROR;
}
Tcl_CreateObjCommand(interp, "lstring", lLStringObjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "lgen", lGenObjCmd, NULL, NULL);
Tcl_PkgProvide(interp, "abstractlisttest", "1.0.0");
return TCL_OK;
}
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | /* | < < < < < < < > > > > | > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 | /* * 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. * 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 #include "tclInt.h" #ifdef TCL_WITH_EXTERNAL_TOMMATH # include "tommath.h" #else # include "tclTomMath.h" |
| ︙ | ︙ | |||
41 42 43 44 45 46 47 48 49 50 51 52 53 54 |
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;
#define VARPTR_KEY "TCLOBJTEST_VARPTR"
#define NUMBER_OF_OBJECT_VARS 20
static void VarPtrDeleteProc(void *clientData, TCL_UNUSED(Tcl_Interp *))
{
int i;
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
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, TCL_UNUSED(Tcl_Interp *))
{
int i;
|
| ︙ | ︙ | |||
67 68 69 70 71 72 73 | } /* *---------------------------------------------------------------------- * * TclObjTest_Init -- * | | | | | | | 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 |
}
/*
*----------------------------------------------------------------------
*
* TclObjTest_Init --
*
* Creates additional commands that are used to test
* Tcl_Obj support.
*
* Results:
* Returns a standard Tcl completion code, and if an error occurs, leaves an
* error message in the interp result.
*
* Side effects:
* Creates new commands used by tests.
*
*----------------------------------------------------------------------
*/
int
TclObjTest_Init(
Tcl_Interp *interp)
|
| ︙ | ︙ | |||
100 101 102 103 104 105 106 107 108 109 110 111 112 113 |
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_CreateObjCommand(interp, "testbignumobj", TestbignumobjCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testbooleanobj", TestbooleanobjCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testdoubleobj", TestdoubleobjCmd,
NULL, NULL);
| > > > > > > > > > > > > > | 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 |
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);
|
| ︙ | ︙ | |||
148 149 150 151 152 153 154 |
static int
TestbignumobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Argument count */
Tcl_Obj *const objv[]) /* Argument vector */
{
| | | 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 |
static int
TestbignumobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Argument count */
Tcl_Obj *const objv[]) /* Argument vector */
{
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;
|
| ︙ | ︙ | |||
882 883 884 885 886 887 888 |
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 */
| | | 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 |
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 */
const char* const subcommands[] = {
"set",
"get",
"replace",
"indexmemcheck",
"getelementsmemcheck",
"index",
NULL
|
| ︙ | ︙ | |||
915 916 917 918 919 920 921 |
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",
| | | 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 |
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",
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 {
|
| ︙ | ︙ | |||
973 974 975 976 977 978 979 |
}
for (i = 0; i < len; ++i) {
Tcl_Obj *objP;
if (Tcl_ListObjIndex(interp, varPtr[varIndex], i, &objP)
!= TCL_OK) {
return TCL_ERROR;
}
| > > | | | | | | | 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 |
}
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 */
}
Tcl_BounceRefCount(objP);
}
break;
case LISTOBJ_GETELEMENTSMEMCHECK:
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
|
| ︙ | ︙ | |||
1047 1048 1049 1050 1051 1052 1053 | * * Side effects: * Creates and frees objects. * *---------------------------------------------------------------------- */ | > > | > > > > > > > | | | | | | < < > | < | < < < | > > > | < < < | | | 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 |
*
* Side effects:
* Creates and frees objects.
*
*----------------------------------------------------------------------
*/
void v2UpdateString(Tcl_Obj *objPtr) {
char *val, *newval;
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 TestListObjLength(
TCL_UNUSED(Tcl_Interp *)
,TCL_UNUSED(Tcl_Obj *)
,Tcl_Size *size
) {
*size = 100;
return TCL_OK;
}
static int TestStringObjIsEmpty(
TCL_UNUSED(Tcl_Interp *)
,TCL_UNUSED(Tcl_Obj*)
,int *res)
{
*res = 1;
return TCL_OK;
}
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;
const char *subcommands[] = {
"freeallvars", "bug3598580", "buge58d7e19e9",
"types", "objtype", "newobj", "set",
"assign", "convert", "duplicate",
"invalidateStringRep", "refcount", "type",
NULL
};
enum testobjCmdIndex {
|
| ︙ | ︙ | |||
1140 1141 1142 1143 1144 1145 1146 |
Tcl_SetObjResult(interp, listObjPtr);
}
return TCL_OK;
case TESTOBJ_BUGE58D7E19E9:
if (objc != 3) {
goto wrongNumArgs;
} else {
| > > | > > | > > > > > > > > | 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 |
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_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 | /* * 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. | > > > > > > > > > > > > > > > > < < < < < | 1 2 3 4 5 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. */ #undef BUILD_tcl #undef STATIC_BUILD #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif |
| ︙ | ︙ |
Changes to generic/tclThread.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 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 © 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. * |
| ︙ | ︙ |
Changes to generic/tclThreadAlloc.c.
1 | /* | < < < < < < > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 | /* * 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. */ |
| ︙ | ︙ |
Changes to generic/tclThreadJoin.c.
1 2 3 4 5 6 7 | /* * 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. | > > > > > > > > > > > > > > > > < < < < < | 1 2 3 4 5 6 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. */ #include "tclInt.h" #ifdef _WIN32 /* |
| ︙ | ︙ |
Changes to generic/tclThreadStorage.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 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 © 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: |
| ︙ | ︙ |
Changes to generic/tclThreadTest.c.
1 2 3 4 5 6 7 | /* * 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. | > > > > > > > > > > > > > > > > > < < < < < < | 1 2 3 4 5 6 7 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. */ #undef BUILD_tcl #undef STATIC_BUILD #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif |
| ︙ | ︙ |
Changes to generic/tclTimer.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ /* * You may distribute and/or modify this program under the terms of the GNU * Affero General Public License as published by the Free Software Foundation, * either version 3 of the License, or (at your 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). */ |
| ︙ | ︙ |
Changes to generic/tclTomMath.decls.
1 2 3 4 5 6 7 8 9 | # 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 # | > > > > > > > > > > > > < < < < | 1 2 3 4 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 # library tcl # Define the unsupported generic interfaces. interface tclTomMath scspec EXTERN |
| ︙ | ︙ |
Changes to generic/tclTomMath.h.
1 2 3 4 5 6 7 |
#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;
| > > > > > > > > > | 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 | /* *---------------------------------------------------------------------- * * tclTomMathDecls.h -- * * This file contains the declarations for the 'libtommath' * functions that are exported by the Tcl library. | > > > > > > > > > > > > > > > > < < < < < | 1 2 3 4 5 6 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. */ #ifndef _TCLTOMMATHDECLS #define _TCLTOMMATHDECLS #include "tcl.h" #include <string.h> |
| ︙ | ︙ |
Changes to generic/tclTomMathInt.h.
1 2 3 | #include "tclInt.h" #include "tclTomMath.h" #include "tommath_class.h" | > > > > > > > > | 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 | /* *---------------------------------------------------------------------- * * tclTomMathInterface.c -- * * This file contains procedures that are used as a 'glue' layer between * Tcl and libtommath. | > > > > > > > > > > > > > > > > < < < < < | 1 2 3 4 5 6 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. */ #include "tclInt.h" #include "tclTomMath.h" MODULE_SCOPE const TclTomMathStubs tclTomMathStubs; |
| ︙ | ︙ |
Changes to generic/tclTomMathStubLib.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 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-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 | /* | < < < < > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 © 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 {
|
| ︙ | ︙ |
Changes to generic/tclUniData.c.
1 2 3 4 5 6 | /* * 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. | > > > > > > > > > > > > > > < < < | 1 2 3 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. */ /* * 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 |
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
| < | 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
,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, 3296, 3296, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 7776, 4704, 11552, 11584, 11616, 3296,
3296, 11648, 11680, 11712, 11744, 4736, 11776, 3296, 11808, 11840,
|
| ︙ | ︙ | |||
565 566 567 568 569 570 571 |
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,
15488
| < | 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,
15488
};
/*
* 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 |
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 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, 92, 92, 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
| < | 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 |
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 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, 92, 92, 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
,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,
|
| ︙ | ︙ | |||
1648 1649 1650 1651 1652 1653 1654 |
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, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 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
| < | 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 |
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, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 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
};
/*
* 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.
|
| ︙ | ︙ | |||
1696 1697 1698 1699 1700 1701 1702 |
-2750143, -976319, -2746047, 2763650, 2762882, -2759615, -2751679,
-2760383, -2760127, -2768575, 1859714, -9044927, -10823615, -12158,
-10830783, -10833599, -10832575, -10830015, -10817983, -10824127,
-10818751, 237633, -12223, -10830527, -9058239, 237698, 9949314,
18, 17, 10305, 10370, 10049, 10114, 8769, 8834
};
| < | < < < | 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 |
-2750143, -976319, -2746047, 2763650, 2762882, -2759615, -2751679,
-2760383, -2760127, -2768575, 1859714, -9044927, -10823615, -12158,
-10830783, -10833599, -10832575, -10830015, -10817983, -10824127,
-10818751, 237633, -12223, -10830527, -9058239, 237698, 9949314,
18, 17, 10305, 10370, 10049, 10114, 8769, 8834
};
# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= 0x323C0)
/*
* The following constants are used to determine the category of a
* Unicode character.
*/
enum {
|
| ︙ | ︙ | |||
1755 1756 1757 1758 1759 1760 1761 | #define GetDelta(info) ((info) >> 8) /* * This macro extracts the information about a character from the * Unicode character tables. */ | < | < < < | 1758 1759 1760 1761 1762 1763 1764 1765 | #define GetDelta(info) ((info) >> 8) /* * This macro extracts the information about a character from the * Unicode character tables. */ # define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0x1FFFFF) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]]) |
Changes to generic/tclUtf.c.
1 | /* | < < < < > > > > > > > > > > > > > > > | 1 2 3 4 5 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-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" |
| ︙ | ︙ | |||
228 229 230 231 232 233 234 |
if (ch <= 0x7FF) {
buf[1] = (char) (0x80 | (0x3F & ch));
buf[0] = (char) (0xC0 | (ch >> 6));
return 2;
}
if (ch <= 0xFFFF) {
if (
| | | > | 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 |
if (ch <= 0x7FF) {
buf[1] = (char) (0x80 | (0x3F & ch));
buf[0] = (char) (0xC0 | (ch >> 6));
return 2;
}
if (ch <= 0xFFFF) {
if (
(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)));
|
| ︙ | ︙ | |||
1201 1202 1203 1204 1205 1206 1207 | } /* *--------------------------------------------------------------------------- * * Tcl_UtfAtIndex -- * | | | | 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 | } /* *--------------------------------------------------------------------------- * * Tcl_UtfAtIndex -- * * Returns a pointer to the specified character (not byte) position in the * UTF-8 string. * * Results: * As above. * * Side effects: * None. * |
| ︙ | ︙ |
Changes to generic/tclUtil.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 © 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> |
| ︙ | ︙ | |||
125 126 127 128 129 130 131 |
static const Tcl_ObjType endOffsetType = {
"end-offset", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
| < < | < < < < < | | 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 |
static const Tcl_ObjType endOffsetType = {
"end-offset", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
0
};
/*
* * 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
|
| ︙ | ︙ | |||
1974 1975 1976 1977 1978 1979 1980 |
*/
for (i = 0; i < objc; i++) {
Tcl_Size length;
objPtr = objv[i];
if (TclListObjIsCanonical(objPtr) ||
| | | | > > > > | 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 |
*/
for (i = 0; i < objc; i++) {
Tcl_Size length;
objPtr = objv[i];
if (TclListObjIsCanonical(objPtr) ||
TclObjectHasInterface(objPtr,list,index)) {
continue;
}
(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) &&
!TclObjectHasInterface(objPtr, list, index)) {
continue;
}
if (resPtr) {
Tcl_Obj *elemPtr = NULL;
Tcl_ListObjIndex(NULL, objPtr, 0, &elemPtr);
if (elemPtr == NULL) {
continue;
}
if (Tcl_GetString(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 = TclDuplicatePureObj(
NULL, objPtr, tclListTypePtr);
if (!resPtr) {
return NULL;
}
}
}
if (!resPtr) {
TclNewObj(resPtr);
}
return resPtr;
}
|
| ︙ | ︙ | |||
3513 3514 3515 3516 3517 3518 3519 |
if (*bytes != 'e') {
int numType;
const char *opPtr;
int t1 = 0, t2 = 0;
/* Value doesn't start with "e" */
| < < < < | | > | 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 |
if (*bytes != 'e') {
int numType;
const char *opPtr;
int t1 = 0, t2 = 0;
/* Value doesn't start with "e" */
/*
* 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)
|
| ︙ | ︙ | |||
3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 |
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 */
| > | 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 |
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 */
|
| ︙ | ︙ | |||
3862 3863 3864 3865 3866 3867 3868 | /* * On 64-bit systems, indices in the range INT_MAX:TCL_SIZE_MAX are * valid indices but are not in the encodable range. Thus an * error is raised. On 32-bit systems, indices in that range indicate * the position after the end and so do not raise an error. */ if ((sizeof(int) != sizeof(Tcl_Size)) && | | | 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 |
/*
* On 64-bit systems, indices in the range INT_MAX:TCL_SIZE_MAX are
* valid indices but are not in the encodable range. Thus an
* error is raised. On 32-bit systems, indices in that range indicate
* the position after the end and so do not raise an error.
*/
if ((sizeof(int) != sizeof(Tcl_Size)) &&
(wide > INT_MAX) && (wide < WIDE_MAX-1)) {
/* 2(a,b) on 64-bit systems*/
goto rangeerror;
}
if (wide > INT_MAX) {
/*
* 3(a,b) on 64-bit systems and 2(a,b), 3(a,b) on 32-bit systems
* Because of the check above, this case holds for indices
|
| ︙ | ︙ | |||
3892 3893 3894 3895 3896 3897 3898 | * On 64-bit systems, indices in the range end-LIST_MAX:end-INT_MAX * are valid indices (with max size strings/lists) but are not in * the encodable range. Thus an error is raised. On 32-bit systems, * indices in that range indicate the position before the beginning * and so do not raise an error. */ if ((sizeof(int) != sizeof(Tcl_Size)) && | | | 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 |
* On 64-bit systems, indices in the range end-LIST_MAX:end-INT_MAX
* are valid indices (with max size strings/lists) but are not in
* the encodable range. Thus an error is raised. On 32-bit systems,
* indices in that range indicate the position before the beginning
* and so do not raise an error.
*/
if ((sizeof(int) != sizeof(Tcl_Size)) &&
(wide > (ENDVALUE - LIST_MAX)) && (wide <= INT_MAX)) {
/* 1(c), 4(a,b) on 64-bit systems */
goto rangeerror;
}
if (wide > ENDVALUE) {
/*
* 2(c) (32-bit systems), 3(c)
* All end+positive or end-negative expressions
|
| ︙ | ︙ | |||
3918 3919 3920 3921 3922 3923 3924 |
}
}
*indexPtr = idx;
return TCL_OK;
rangeerror:
if (interp) {
| | < > | | 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 |
}
}
*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", (void *)NULL);
}
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 |
}
endValue += encoded - TCL_INDEX_END;
if (endValue >= 0) {
return endValue;
}
return TCL_INDEX_NONE;
}
/*
*------------------------------------------------------------------------
*
* TclIndexInvalidError --
*
* Generates an error message including the invalid index.
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
}
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.
|
| ︙ | ︙ |
Changes to generic/tclVar.c.
1 | /* | < < < < < < < < > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 © 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 |
* 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,
| < > | 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,
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 |
(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,
| < > | 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,
0
};
#define ParsedSetInternalRep(objPtr, arrayPtr, elem) \
do { \
Tcl_ObjInternalRep ir; \
Tcl_Obj *ptr1 = (arrayPtr); \
Tcl_Obj *ptr2 = (elem); \
|
| ︙ | ︙ | |||
842 843 844 845 846 847 848 |
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;
| | | | 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 |
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 = Tcl_GetStringFromObj(varNamePtr, &varLen);
varPtr = NULL;
varNsPtr = NULL; /* Set non-NULL if a nonlocal variable. */
*indexPtr = -3;
if (flags & TCL_GLOBAL_ONLY) {
|
| ︙ | ︙ | |||
3131 3132 3133 3134 3135 3136 3137 |
ArrayPopulateSearch(interp, arrayNameObj, varPtr, searchPtr);
/*
* Make sure that these objects (which we need throughout the body of the
* loop) don't vanish.
*/
| | | 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 |
ArrayPopulateSearch(interp, arrayNameObj, varPtr, searchPtr);
/*
* Make sure that these objects (which we need throughout the body of the
* loop) don't vanish.
*/
varListObj = TclDuplicatePureObj(interp, objv[1], tclListTypePtr);
if (!varListObj) {
return TCL_ERROR;
}
scriptObj = objv[3];
Tcl_IncrRefCount(scriptObj);
/*
|
| ︙ | ︙ | |||
4030 4031 4032 4033 4034 4035 4036 |
}
/*
* Install the contents of the dictionary or list into the array.
*/
arrayElemObj = objv[2];
| | | 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054 4055 |
}
/*
* Install the contents of the dictionary or list into the array.
*/
arrayElemObj = objv[2];
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 | /* * 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. */ | | > | 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 |
/*
* 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 =
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);
|
| ︙ | ︙ |
Changes to generic/tclZipfs.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 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 © 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: |
| ︙ | ︙ | |||
1374 1375 1376 1377 1378 1379 1380 | * * 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 | | | 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 | * * 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. * * 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. * *------------------------------------------------------------------------- |
| ︙ | ︙ | |||
1472 1473 1474 1475 1476 1477 1478 |
* 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.
*/
| | | 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 |
* 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.
*/
if (!(cdirZipOffset <= 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");
|
| ︙ | ︙ | |||
1577 1578 1579 1580 1581 1582 1583 | * to memory map that file. Otherwise it is read into an allocated memory * 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 | | | 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 | * to memory map that file. Otherwise it is read into an allocated memory * 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. * * 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. * *------------------------------------------------------------------------- |
| ︙ | ︙ | |||
1755 1756 1757 1758 1759 1760 1761 |
int fd = PTR2INT(handle);
/*
* Determine the file size.
*/
zf->length = lseek(fd, 0, SEEK_END);
| | | 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 |
int fd = PTR2INT(handle);
/*
* Determine the file size.
*/
zf->length = lseek(fd, 0, SEEK_END);
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) {
Tcl_SetErrno(EINVAL);
ZIPFS_POSIX_ERROR(interp, "truncated file");
return TCL_ERROR;
|
| ︙ | ︙ | |||
1814 1815 1816 1817 1818 1819 1820 | * 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 | | | 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 | * 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!! * * Side effects: * Will acquire and release the write lock. * *------------------------------------------------------------------------- */ |
| ︙ | ︙ |
Changes to generic/tclZlib.c.
1 | /* | < < < < > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 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 |
| ︙ | ︙ |
Changes to library/auto.tcl.
1 2 3 4 5 6 7 8 9 10 | # 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. | | > > > > > > | 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. # |
| ︙ | ︙ |
Changes to library/clock.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 |
# 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} } {
|
| ︙ | ︙ |
Changes to library/cookiejar/cookiejar.tcl.
1 2 3 4 5 | # 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). | > > > > > > > > > > < < < | 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). # 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 | # 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). | > > > > > > > > > > > > | | < < < < < | 1 2 3 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.
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 16 17 18 19 20 21 22 | # 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 | # 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. | > > > > > > > > > > < < < | 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.
package require Tcl 8.6-
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
package provide http 2.10b1
namespace eval http {
|
| ︙ | ︙ | |||
1780 1781 1782 1783 1784 1785 1786 |
##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} \
| | < < < | 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 |
##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) -profile strict
##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
|
| ︙ | ︙ | |||
2201 2202 2203 2204 2205 2206 2207 |
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] \
| | < < < | 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 |
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) -profile strict
# 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} {
|
| ︙ | ︙ | |||
2594 2595 2596 2597 2598 2599 2600 |
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] \
| | < < < | 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 |
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) -profile strict
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
|
| ︙ | ︙ | |||
4589 4590 4591 4592 4593 4594 4595 |
# 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"} {
| < | < | < | 4587 4588 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 |
# 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"} {
set 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
|
| ︙ | ︙ | |||
4676 4677 4678 4679 4680 4681 4682 |
set res $value
}
}
set enc [CharsetToEncoding $res]
if {$enc eq "binary"} {
return 0
}
| < | < < < | 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 |
set res $value
}
}
set enc [CharsetToEncoding $res]
if {$enc eq "binary"} {
return 0
}
set state(body) [encoding convertfrom -profile strict $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
}
|
| ︙ | ︙ | |||
4761 4762 4763 4764 4765 4766 4767 |
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]
| < | < < < | 4752 4753 4754 4755 4756 4757 4758 4759 4760 4761 4762 4763 4764 4765 4766 |
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]
set string [encoding convertto -profile strict $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 24 25 26 27 28 29 |
# 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.
# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your 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.
# This test intentionally written in pre-7.5 Tcl
if {[info commands package] == ""} {
error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
}
package require -exact tcl 9.0a4
|
| ︙ | ︙ |
Changes to library/install.tcl.
1 2 3 4 5 6 7 |
###
# Installer actions built into tclsh and invoked
# if the first command line argument is "install"
###
if {[llength $argv] < 2} {
exit 0
}
| > > > > > > > | 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 20 21 22 23 24 25 26 | # 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/opt/optparse.tcl.
1 2 3 4 5 6 7 | # 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 | > > > > > > > | 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 | # 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 | > > > > > > > | 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 | # 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. | | > > > > > > | 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 | # 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. | | > > > > > > | 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 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. # ### ### ### ######### ######### ######### ## 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 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. # ### ### ### ######### ######### ######### ## 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 | # 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. | > > > > > > > > > > > > | < < < < < < < | 1 2 3 4 5 6 7 8 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.
# 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.8
# Create the safe namespace
namespace eval ::safe {
# Exported API:
|
| ︙ | ︙ |
Changes to library/tcltest/pkgIndex.tcl.
1 2 3 4 5 6 7 | # 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 | > > > > > > > | 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 | # 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. | > > > > > > > > > > > > > < < < < < < | 1 2 3 4 5 6 7 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.
package require Tcl 8.5- ;# -verbose line uses [info frame]
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.
|
| ︙ | ︙ | |||
397 398 399 400 401 402 403 |
stderr -
stdout {
set outputChannel $filename
}
default {
set outputChannel [open $filename a]
if {[package vsatisfies [package provide Tcl] 8.7-]} {
| | | 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 |
stderr -
stdout {
set outputChannel $filename
}
default {
set outputChannel [open $filename a]
if {[package vsatisfies [package provide Tcl] 8.7-]} {
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 \
|
| ︙ | ︙ | |||
444 445 446 447 448 449 450 |
stderr -
stdout {
set errorChannel $filename
}
default {
set errorChannel [open $filename a]
if {[package vsatisfies [package provide Tcl] 8.7-]} {
| | | 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 |
stderr -
stdout {
set errorChannel $filename
}
default {
set errorChannel [open $filename a]
if {[package vsatisfies [package provide Tcl] 8.7-]} {
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 \
|
| ︙ | ︙ | |||
789 790 791 792 793 794 795 |
return [AcceptReadable $file]
}
proc ReadLoadScript {args} {
variable Option
if {$Option(-loadfile) eq {}} {return}
set tmp [open $Option(-loadfile) r]
if {[package vsatisfies [package provide Tcl] 8.7-]} {
| | | 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 |
return [AcceptReadable $file]
}
proc ReadLoadScript {args} {
variable Option
if {$Option(-loadfile) eq {}} {return}
set tmp [open $Option(-loadfile) r]
if {[package vsatisfies [package provide Tcl] 8.7-]} {
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
|
| ︙ | ︙ | |||
1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 |
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.
#
| > | 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 |
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.
#
|
| ︙ | ︙ | |||
1369 1370 1371 1372 1373 1374 1375 |
set code
}
ConstraintInitializer stdio {
set code 0
if {![catch {set f [open "|[list [interpreter]]" w]}]} {
if {[package vsatisfies [package provide Tcl] 8.7-]} {
| | | 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 |
set code
}
ConstraintInitializer stdio {
set code 0
if {![catch {set f [open "|[list [interpreter]]" w]}]} {
if {[package vsatisfies [package provide Tcl] 8.7-]} {
fconfigure $f -encoding utf-8
}
if {![catch {puts $f exit}]} {
if {![catch {close $f}]} {
set code 1
}
}
}
|
| ︙ | ︙ | |||
2219 2220 2221 2222 2223 2224 2225 |
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 {[package vsatisfies [package provide Tcl] 8.7-]} {
| | | 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 |
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 {[package vsatisfies [package provide Tcl] 8.7-]} {
fconfigure $testFd -encoding utf-8
}
set testLine [expr {[lsearch -regexp \
[split [read $testFd] "\n"] \
"^\[ \t\]*test [string map {. \\.} $name] "] + 1}]
close $testFd
}
}
|
| ︙ | ︙ | |||
2250 2251 2252 2253 2254 2255 2256 |
puts [outputChannel] "---- errorCode(setup): $errorCodeRes(setup)"
}
}
if {$processTest && $scriptFailure} {
if {$scriptCompare} {
puts [outputChannel] "---- Error testing result: $scriptMatch"
} else {
| < | < < < | 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 |
puts [outputChannel] "---- errorCode(setup): $errorCodeRes(setup)"
}
}
if {$processTest && $scriptFailure} {
if {$scriptCompare} {
puts [outputChannel] "---- Error testing result: $scriptMatch"
} else {
puts [outputChannel] "---- Result was:\n[Asciify $actualAnswer]"
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'"
|
| ︙ | ︙ | |||
2935 2936 2937 2938 2939 2940 2941 |
lappend childargv $opt $value
}
set cmd [linsert $childargv 0 | $shell $file]
if {[catch {
incr numTestFiles
set pipeFd [open $cmd "r"]
if {[package vsatisfies [package provide Tcl] 8.7-]} {
| | | 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 |
lappend childargv $opt $value
}
set cmd [linsert $childargv 0 | $shell $file]
if {[catch {
incr numTestFiles
set pipeFd [open $cmd "r"]
if {[package vsatisfies [package provide Tcl] 8.7-]} {
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}
|
| ︙ | ︙ | |||
3135 3136 3137 3138 3139 3140 3141 |
DebugPuts 3 "[lindex [info level 0] 0]:\
putting ``$contents'' into $fullName"
set fd [open $fullName w]
fconfigure $fd -translation lf
if {[package vsatisfies [package provide Tcl] 8.7-]} {
| | | 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 |
DebugPuts 3 "[lindex [info level 0] 0]:\
putting ``$contents'' into $fullName"
set fd [open $fullName w]
fconfigure $fd -translation lf
if {[package vsatisfies [package provide Tcl] 8.7-]} {
fconfigure $fd -encoding utf-8
}
if {[string index $contents end] eq "\n"} {
puts -nonewline $fd $contents
} else {
puts $fd $contents
}
close $fd
|
| ︙ | ︙ | |||
3286 3287 3288 3289 3290 3291 3292 |
FillFilesExisted
if {[llength [info level 0]] == 2} {
set directory [temporaryDirectory]
}
set fullName [file join $directory $name]
set f [open $fullName]
if {[package vsatisfies [package provide Tcl] 8.7-]} {
| | | 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 |
FillFilesExisted
if {[llength [info level 0]] == 2} {
set directory [temporaryDirectory]
}
set fullName [file join $directory $name]
set f [open $fullName]
if {[package vsatisfies [package provide Tcl] 8.7-]} {
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 14 15 16 17 | # You may distribute and/or modify this program under the terms of the GNU # Affero General Public License as published by the Free Software Foundation, # either version 3 of the License, or (at your 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 19 20 21 22 23 24 25 |
# 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/win32/libtommath.dll.
cannot compute difference between binary files
Changes to libtommath/win64-arm/libtommath.dll.
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
Changes to macosx/GNUmakefile.
|
| < < < < < < | > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 |
# 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 18 19 20 21 22 23 | // 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 | // // Tcl-Debug.xcconfig -- // // This file contains the Xcode build settings for all Debug // project configurations in Tcl.xcodeproj. // | > > > > > > > > > > > < < < < | 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. // #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 | <?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. --> <plist version="1.0"> <dict> <key>CFBundleDevelopmentRegion</key> <string>English</string> <key>CFBundleExecutable</key> <string>@TCL_LIB_FILE@</string> <key>CFBundleGetInfoString</key> | > > > > > > > > | 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 18 19 20 21 22 23 | // 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 | <?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. --> <plist version="1.0"> <dict> <key>CFBundleDevelopmentRegion</key> <string>English</string> <key>CFBundleExecutable</key> <string>tclsh@TCL_VERSION@</string> <key>CFBundleGetInfoString</key> | > > > > > > > > | 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 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 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 © 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 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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 © 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 |
| ︙ | ︙ | |||
85 86 87 88 89 90 91 |
static const Tcl_ObjType tclOSTypeType = {
"osType", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfOSType, /* updateStringProc */
SetOSTypeFromAny, /* setFromAnyProc */
| < > | 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 |
static const Tcl_ObjType tclOSTypeType = {
"osType", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfOSType, /* updateStringProc */
SetOSTypeFromAny, /* setFromAnyProc */
0
};
enum {
kIsInvisible = 0x4000,
};
#define kFinfoIsInvisible (OSSwapHostToBigConstInt16(kIsInvisible))
|
| ︙ | ︙ |
Changes to macosx/tclMacOSXNotify.c.
1 | /* | < < < < < < > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 © 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. */ |
| ︙ | ︙ |
Changes to tests-perf/clock.perf.tcl.
1 2 3 4 5 6 7 8 9 10 | #!/usr/bin/tclsh # ------------------------------------------------------------------------ # # test-performance.tcl -- # # This file provides common performance tests for comparison of tcl-speed # degradation by switching between branches. # (currently for clock ensemble only) # # ------------------------------------------------------------------------ | > > > > > > > > > > > > > < < < < < < | 1 2 3 4 5 6 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)
#
# ------------------------------------------------------------------------
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:
|
| ︙ | ︙ |
Changes to tests-perf/comparePerf.tcl.
1 2 3 4 5 6 7 8 9 | #!/usr/bin/tclsh # ------------------------------------------------------------------------ # # comparePerf.tcl -- # # Script to compare performance data from multiple runs. # # ------------------------------------------------------------------------ # | > > > > > > > > > > > < < < | 1 2 3 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. # # ------------------------------------------------------------------------ # # 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 | #!/usr/bin/tclsh # ------------------------------------------------------------------------ # # listPerf.tcl -- # # This file provides performance tests for list operations. Run # tclsh listPerf.tcl help # for options. # ------------------------------------------------------------------------ # | > > > > > > > > > > > < < < | 1 2 3 4 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.
# ------------------------------------------------------------------------
#
# 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 | # ------------------------------------------------------------------------ # # 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". # # ------------------------------------------------------------------------ | > > > > > > > > > > > > > > < < < < < < | 1 2 3 4 5 6 7 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".
#
# ------------------------------------------------------------------------
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 | #!/usr/bin/tclsh # ------------------------------------------------------------------------ # # timer-event.perf.tcl -- # # This file provides performance tests for comparison of tcl-speed # of timer events (event-driven tcl-handling). # # ------------------------------------------------------------------------ | > > > > > > > > > > > > < < < < < < < | 1 2 3 4 5 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).
#
# ------------------------------------------------------------------------
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 20 21 22 23 24 25 26 |
# 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 14 15 16 17 18 19 20 21 |
# 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 |
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 \
| | | 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 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 |
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}
| | | | 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 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 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 19 20 21 22 23 24 25 |
# 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 20 21 22 23 24 25 26 27 |
# 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 |
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]]
| | | | | 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 1
test append-3.8 {append \xC0 \x80} -constraints testbytestring -body {
set x [testbytestring \xC0]
string length $x[testbytestring \x80]
} -result 1
test append-3.9 {append \xC0 \x80} -constraints testbytestring -body {
set x [testbytestring \x80]
string length [testbytestring \xC0]$x
} -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 20 21 22 23 24 25 26 |
# 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 21 22 23 24 25 26 27 |
# 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 18 19 20 21 22 23 24 |
# 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 |
proc ulam1 {n} {
set max $n
while {$n != 1} {
if {$n > $max} {
set max $n
}
if {$n % 2} {
| > > > > > > > | 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 20 21 22 23 24 25 26 |
# 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 20 21 22 23 24 25 26 |
# 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 18 19 20 21 22 23 24 25 |
# 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:
|
| ︙ | ︙ |
Changes to tests/basic.test.
1 2 3 4 5 6 7 8 9 10 | # 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. | > > > > > > > > > > > > > < < < < < < | 1 2 3 4 5 6 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.
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 19 20 21 22 23 24 25 26 |
# 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 19 20 21 22 23 24 25 26 |
# 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 |
} \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
| | | | 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
test binary-53.21 {Tcl_BinaryObjCmd: float Inf} {} {
binary format r Inf
} \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 16 17 18 19 20 21 22 |
# 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 |
} -returnCodes error -result "wrong # args: should be \"chan configure channelId ?-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}
| | | 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 |
} -returnCodes error -result "wrong # args: should be \"chan configure channelId ?-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} -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 22 23 24 25 26 27 28 29 30 |
# 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 {
|
| ︙ | ︙ | |||
1088 1089 1090 1091 1092 1093 1094 |
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 ""
| | | 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 |
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 {
set f [open $path(test1) w]
chan configure $f -encoding 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
|
| ︙ | ︙ | |||
5283 5284 5285 5286 5287 5288 5289 |
} -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 ""
| | | | 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 |
} -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 -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} -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
|
| ︙ | ︙ | |||
6718 6719 6720 6721 6722 6723 6724 |
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]
| | | > | | 6727 6728 6729 6730 6731 6732 6733 6734 6735 6736 6737 6738 6739 6740 6741 6742 6743 6744 6745 6746 6747 6748 6749 |
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 -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 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 lf -encoding iso8859-1 -blocking 0
chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0
|
| ︙ | ︙ | |||
6819 6820 6821 6822 6823 6824 6825 |
} -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\]
| | | | > | | 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 |
} -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 -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 -encoding utf-8 -translation lf
chan gets $f1
chan puts $f1 ready
chan flush $f1
set f2 [open $path(test1) w]
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 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
|
| ︙ | ︙ |
Changes to tests/clock.test.
1 2 3 4 5 6 7 | # clock.test -- # # This test file covers the 'clock' command that manipulates time. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. | > > > > > > > > > > > > | < < < < | 1 2 3 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 © 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.
# clock.test --
#
# This test file covers the 'clock' command that manipulates time.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
if {[testConstraint win]} {
|
| ︙ | ︙ |
Changes to tests/cmdAH.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 |
# 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
|
| ︙ | ︙ | |||
312 313 314 315 316 317 318 |
set system [encoding system]
} -body {
encoding system iso8859-1
encoding system
} -cleanup {
encoding system $system
} -result iso8859-1
| < | 320 321 322 323 324 325 326 327 328 329 330 331 332 333 |
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 17 18 19 20 21 22 23 24 |
# 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 | # 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. # | > > > > > > > > > > > > > > < < < < < < | 1 2 3 4 5 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.
#
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 20 21 22 23 24 25 26 |
# 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 | # 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. | > > > > > > > > > > > > > < < < < < < | 1 2 3 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.
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 17 18 19 20 21 22 23 |
# 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 | # 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. # | > > > > > > > > > > > > > < < < < < | 1 2 3 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.
#
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 20 21 22 23 24 25 26 |
# 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 21 22 23 24 25 26 |
# 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 | # 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. | > > > > > > > > > > > > < < < < < | 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.
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 20 21 22 23 24 25 26 |
# 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 | # 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. | > > > > > > > > > > > < < < < | 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.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
catch {
|
| ︙ | ︙ |
Changes to tests/dstring.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 |
# 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 17 18 19 20 21 22 23 |
# 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 |
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 {
| > | 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 |
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
| | | 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\"}"
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 |
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 -encoding iso8859-1
| | | 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 -encoding iso8859-1
puts -nonewline $f "ab\x8c\xc1g"
close $f
set f [open [file join [temporaryDirectory] dummy] r]
fconfigure $f -translation binary -encoding shiftjis
set x [read $f]
close $f
file delete [file join [temporaryDirectory] dummy]
return $x
|
| ︙ | ︙ | |||
222 223 224 225 226 227 228 |
close $f
set f [open [file join [temporaryDirectory] dummy] r]
fconfigure $f -translation binary -encoding iso8859-1
set x [read $f]
close $f
file delete [file join [temporaryDirectory] dummy]
return $x
| | | | | | | 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 -encoding iso8859-1
set x [read $f]
close $f
file delete [file join [temporaryDirectory] dummy]
return $x
} "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
} 。
test encoding-11.3 {LoadEncodingFile: double-byte} {
encoding convertfrom jis0208 8C
} 乎
test encoding-11.4 {LoadEncodingFile: multi-byte} {
encoding convertfrom shiftjis \x8c\xc1
} 乎
test encoding-11.5 {LoadEncodingFile: escape file} {
encoding convertto iso2022 乎
} \x1b\$B8C\x1b(B
test encoding-11.5.1 {LoadEncodingFile: escape file} {
encoding convertto iso2022-jp 乎
} \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 |
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 😹
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > > > > > > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > > > | | > > > > > > | | | | | | > > > > > > > | | > > > | | | | | | | | | | | | | | | | | | | | 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 |
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
test encoding-11.11 {encoding: extended Unicode UTF-32} {
encoding convertto utf-32be 😹
} \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"
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
test encoding-15.1 {UtfToUtfProc} {
encoding convertto utf-8 £
} "\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]
list [string length $x] $y
} -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]
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]
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]
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é]
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]
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é]
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 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]
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]
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]
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]
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]
list [string length $x] $y
} "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]
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]
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]
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]
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 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
} -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
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xF1'}
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"]
list $val [format %x [scan $val %c]]
} -result "\U460dc 460dc"
test encoding-16.3 {Utf16ToUtfProc} -body {
set val [encoding convertfrom -profile tcl8 utf-16 "\xdc\xdc"]
list $val [format %x [scan $val %c]]
} -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"]
list $val [format %x [scan $val %c]]
} -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"
test encoding-16.9 {Utf32ToUtfProc} -body {
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
test encoding-16.11 {Utf32ToUtfProc} -body {
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
test encoding-16.13 {Utf16ToUtfProc} -body {
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
test encoding-16.15 {Utf16ToUtfProc} -body {
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
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]
} -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} {
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.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"
} -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
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
} -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
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x00'}
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
test encoding-17.1 {UtfToUtf16Proc} -body {
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"
test encoding-17.3 {UtfToUtf16Proc} -body {
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"
test encoding-17.5 {UtfToUtf32Proc} -body {
encoding convertto utf-32le "\U460dc"
} -result "\xdc\x60\x04\x00"
test encoding-17.6 {UtfToUtf32Proc} -body {
encoding convertto utf-32be "\U460dc"
} -result "\x00\x04\x60\xDC"
test encoding-17.7 {UtfToUtf16Proc} -body {
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"
} -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"
} -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
test encoding-17.11 {Utf32ToUtfProc} -body {
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"
} -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
|
| ︙ | ︙ | |||
661 662 663 664 665 666 667 |
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
| | | | | | 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 |
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"
set iso2022uniData [encoding convertfrom iso2022-jp $iso2022encData]
set iso2022uniData2 "私どもでは、チップご購入時にご登録いただいたご住所をキャッシュアウトの際の
小切手送付先として使用しております。恐れ入りますが、正しい住所をご登録しなお
お願いいたします。また、大変恐縮ですが、住所変更のあと、日本語サービス部(
casino_japanese@___.com )までご住所変更済の連絡をいただけないで
しょうか?"
|
| ︙ | ︙ | |||
740 741 742 743 744 745 746 |
runInSubprocess {
encoding system cp1252; # Bug #2891556 crash revelator
fconfigure stdout -encoding iso2022-jp
puts ab乎棙g
set env(TCL_FINALIZE_ON_EXIT) 1
exit
}
| | | | | | | | | | | > > > | | | | | | | > > > | > > > > > > > > > | | | | | | | | | | > > > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 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 |
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"
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"
} -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
} \x00
test encoding-24.5 {Parse valid or invalid utf-8} {
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"]
} 2
test encoding-24.7 {Parse valid or invalid utf-8} {
string length [encoding convertfrom utf-8 "\xc2\x80"]
} 1
test encoding-24.8 {Parse valid or invalid utf-8} {
string length [encoding convertfrom -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"]
} 3
test encoding-24.10 {Parse valid or invalid utf-8} {
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"]
} 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.tcl8 {Parse invalid utf-8} -body {
encoding convertfrom -profile tcl8 utf-8 "\xC0\x81"
} -result \xC0\x81
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.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.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"
} -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
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"
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"
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
test encoding-24.19.2 {Parse valid or invalid utf-8} -body {
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"
} -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"
} -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"
} -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"
} -result \U40000
test encoding-24.27 {Parse invalid utf-8 with -profile strict} -body {
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"
} -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
test encoding-24.30 {Parse noncharacter with -profile strict} -body {
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.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
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
test encoding-24.35 {Parse invalid utf-8} -body {
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
} -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
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} -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
} -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
test encoding-24.41 {Parse invalid utf-8 with -profile strict} -body {
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
test encoding-24.43 {Parse invalid utf-8, fallback to cp1252 [885c86a9a0]} -body {
encoding convertfrom -profile tcl8 utf-8 \x80
} -result \u20ac
test encoding-24.44 {Try to generate invalid ucs-2 with -profile strict} -body {
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]
|
| ︙ | ︙ | |||
957 958 959 960 961 962 963 |
}
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 \
| | | 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 |
}
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"
}
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))}]
|
| ︙ | ︙ | |||
1070 1071 1072 1073 1074 1075 1076 |
} -result 91
runtests
test encoding-bug-183a1adcc0-1 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
testencoding
} -body {
| | | | | | | 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 |
} -result 91
runtests
test encoding-bug-183a1adcc0-1 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
testencoding
} -body {
# 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
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
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
list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 3} result] $result
} -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]]
|
| ︙ | ︙ | |||
1118 1119 1120 1121 1122 1123 1124 |
[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
| | | | | | | | | | | 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 |
[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]]
} -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]]
} -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
test encoding-bug-6a3e2cb0f0-2 {Bug [6a3e2cb0f0] - invalid bytes in escape encodings} -body {
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
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
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
# cleanup
namespace delete ::tcl::test::encoding
::tcltest::cleanupTests
return
# Local Variables:
# mode: tcl
# End:
|
Changes to tests/encodingVectors.tcl.
1 2 3 4 5 6 7 8 | # 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. | > > > > > > > < | 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 20 21 22 23 24 25 26 |
# 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 20 21 22 23 24 25 26 |
# 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 20 21 22 23 24 25 26 |
# 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 18 19 20 21 22 23 24 |
# 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 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-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 |
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\""
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 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\""
# ----------------------------------------------------------------------
# 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 | # 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. | > > > > > > > > > > > > > < < < < < < | 1 2 3 4 5 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.
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 | # 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. # | > > > > > > > > > > > > > > < < < < < < | 1 2 3 4 5 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.
#
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 19 20 21 22 23 24 25 |
# 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 19 20 21 22 23 24 25 |
# 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 19 20 21 22 23 24 25 |
# 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 | # 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. | > > > > > > > > > > > > < < < < < | 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.
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 | #! /usr/bin/env tclsh | | > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 |
#! /usr/bin/env tclsh
# 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 | # 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. | > > > > > > > > > > > > > < < < < < < | 1 2 3 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.
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 | # 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. | > > > > > > > > > > > > | < < < < | 1 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.
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 19 20 21 22 23 24 25 |
# 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 19 20 21 22 23 24 25 |
# 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::*
}
# %u output depends on word length, so this test is 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 19 20 21 22 23 24 25 |
# 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 20 21 22 23 24 25 26 |
# 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 20 21 22 23 24 25 26 |
# 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 16 17 18 19 20 21 22 |
# 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 17 18 19 20 21 22 23 |
# 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 21 22 23 24 25 26 27 |
# 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 | # httpTest.tcl # # Test HTTP/1.1 concurrent requests including # queueing, pipelining and retries. # | > > > > > > > > > > > > < < < < | 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.
#
# ------------------------------------------------------------------------------
# "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 | # httpTestScript.tcl # # Test HTTP/1.1 concurrent requests including # queueing, pipelining and retries. # | > > > > > > > > > > > > < < < < | 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. # # ------------------------------------------------------------------------------ # "Package" httpTestScript for executing test scripts written in a convenient # shorthand. # ------------------------------------------------------------------------------ # ------------------------------------------------------------------------------ |
| ︙ | ︙ |
Changes to tests/httpcookie.test.
1 2 3 4 5 | # 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. | > > > > > > > > > > > > < < < < < | 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.
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 17 18 19 20 21 | # 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 17 18 19 20 21 22 23 |
# 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 | # This file is automatically generated by ucm2tests.tcl. # Edits will be overwritten on next generation. # # Generates tests comparing Tcl encodings to ICU. # The generated file is NOT standalone. It should be sourced into a test script. | > > > > > > | 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. # # Generates tests comparing Tcl encodings to ICU. # The generated 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 | # 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. | > > > > > > > > > > > > > > < < < < < < < | 1 2 3 4 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.
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 19 20 21 22 23 24 25 |
# 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 | # 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. | > > > > > > > > > > > > > > < < < < < < < | 1 2 3 4 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.
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 | # 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. | > > > > > > < < < < < < | 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.
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 17 18 19 20 21 22 23 |
# 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 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 |
# 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 |
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"}
}
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}
| > > > > > > > > > > | 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 |
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
| | | | | | | | | | 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 [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 [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 [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 [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 [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 [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 |
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
}
| | | | | 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 [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 [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 [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 |
proc bar {} {info frame 0}
}
test info-24.0 {info frame, interaction, namespace eval} -body {
reduce [foo::bar]
} -cleanup {
namespace delete foo
| | | | | | | | | | 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 [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 [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 [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 [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 [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 [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 [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 [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 |
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]
| | | | | | | | 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 [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 [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 [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 [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 [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 [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 |
foo
{proc bar {} {info frame 0}}
}
test info-33.0 {{*}, literal, direct} -body {
reduce [foo::bar]
} -cleanup {
namespace delete foo
| | | | | 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 [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 [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 [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 |
if {*}"
{1}
{info frame 0}
"
}
test info-33.3 {{*}, literal, simple, bytecompiled} {
reduce [foo::bar]
| | | 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 [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 |
apply {
{x y}
{info frame 0}
} 0 0
}
test info-35.0 {apply, literal} {
reduce [foo]
| | | | 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 [expr {$offset + 1231}] file info.test cmd {info frame 0} lambda {
{x y}
{info frame 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 |
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]
| | | | | 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 [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 [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 [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 |
c}
set cmd [list foreach $foo {x y} {
set res [join [lrange [etrace] 0 2] \n]
break
}]
eval $cmd
return $res
| | | | 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 [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}
# -------------------------------------------------------------------------
# 6 cases.
## DV. direct-var - unchanged
## DPV direct-proc-var - ditto
## PPV proc-proc-var - ditto
|
| ︙ | ︙ | |||
1355 1356 1357 1358 1359 1360 1361 |
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
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 |
[info frame 0] }
}
}
set res {}
lappend res [a {key }]
lappend res [a {1alpha}]
set res "\n[join $res \n]"
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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([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(\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"
# -------------------------------------------------------------------------
# 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 |
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 {}
| | | | 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 [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 |
control y {
set y PPL
etrace
}
}
join [lrange [datal] 0 4] \n
}
| | | | | | | 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 [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 |
return [uplevel 1 $script]
}
join [lrange [control y {
set y DPL
etrace
}] 0 3] \n
}
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 [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 19 20 21 22 23 24 25 |
# 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 | # 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] | > > > > > > > > > > > > < < < < < | 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]
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 19 20 21 22 23 24 25 |
# 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
|
| ︙ | ︙ | |||
3335 3336 3337 3338 3339 3340 3341 |
after 100
log 2
}
} msg
interp delete $i
lappend result $msg
} -result {1 {time limit exceeded}}
| | | 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 |
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} -setup {
proc cb1 {i t} {
global result
lappend result cb1
$i limit time -seconds $t -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 22 23 24 25 26 27 |
# 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::*
|
| ︙ | ︙ | |||
1185 1186 1187 1188 1189 1190 1191 |
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]
| | | 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 |
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 {
set f [open $path(test1) w]
fconfigure $f -encoding 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]
|
| ︙ | ︙ | |||
1610 1611 1612 1613 1614 1615 1616 |
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
| | | < < < | < | < < < < < | > | | | | | | > > > > > | > | > > > > | > | | > | < < | < < | < < | > | > > > > | > > | | | > > > > > > > > > > > > > > > > > > > > > | 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 |
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
apply [list {} {
set template {
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]} {
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 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)]
|
| ︙ | ︙ | |||
5840 5841 5842 5843 5844 5845 5846 |
update
fconfigure $s2 -translation {auto auto}
set modes [fconfigure $s2 -translation]
close $s1
close $s2
set modes
} {auto crlf}
| | | | 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 |
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 -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} -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]
|
| ︙ | ︙ | |||
7323 7324 7325 7326 7327 7328 7329 |
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]
| | | | | > | | | > | | 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 7399 7400 7401 7402 7403 7404 7405 7406 7407 |
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 -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 -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 41}
test io-52.4.1 {TclCopyChannel} {fcopy} {
file delete $path(test1)
set f1 [open $thisScript]
set f2 [open $path(test1) w]
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 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.
|
| ︙ | ︙ | |||
7454 7455 7456 7457 7458 7459 7460 |
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\]
| | | > | | 7488 7489 7490 7491 7492 7493 7494 7495 7496 7497 7498 7499 7500 7501 7502 7503 7504 7505 7506 7507 7508 7509 7510 7511 7512 7513 7514 7515 7516 7517 7518 7519 |
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 -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 -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 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
|
| ︙ | ︙ | |||
7714 7715 7716 7717 7718 7719 7720 7721 7722 7723 7724 7725 7726 7727 |
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.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 {
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 7782 7783 7784 7785 7786 7787 7788 7789 7790 7791 7792 |
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 {
|
| ︙ | ︙ | |||
9328 9329 9330 9331 9332 9333 9334 |
binary scan $d H* hd
set hd
} -cleanup {
close $f
removeFile io-75.5
} -result 4181
| > > > > > > > > > > > > > > > > > > > > | > > | 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 9419 9420 9421 9422 9423 9424 9425 9426 9427 9428 9429 |
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 -encoding 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.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 -encoding binary
# \x81 is an incomplete byte sequence in utf-8
puts -nonewline $f A\x81
flush $f
seek $f 0
|
| ︙ | ︙ | |||
9424 9425 9426 9427 9428 9429 9430 |
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}
| | > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > > | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > | > > > > > | > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > > > | 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 9763 9764 9765 9766 9767 9768 9769 9770 9771 9772 9773 |
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.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 -encoding 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 -encoding 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 {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 -encoding 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 {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 -encoding binary
# \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 -encoding 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}} {
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 -encoding 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]]
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
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 -encoding 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 [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 -encoding 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 {
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 -encoding binary
|
| ︙ | ︙ | |||
9575 9576 9577 9578 9579 9580 9581 |
flush $f
seek $f 0
fconfigure $f -encoding shiftjis -blocking 0 -eofchar {} -translation lf \
-profile strict
} -body {
set d [read $f]
binary scan $d H* hd
| | > > > > | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | > > > > > > > > > > > > > > > > > > > > > > > > | | 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 9859 9860 9861 9862 9863 9864 9865 9866 9867 9868 9869 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 9924 9925 9926 9927 9928 9929 9930 9931 9932 9933 9934 9935 |
flush $f
seek $f 0
fconfigure $f -encoding shiftjis -blocking 0 -eofchar {} -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 -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 ${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 -encoding 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 -encoding binary
puts -nonewline $f A\x81
flush $f
seek $f 0
fconfigure $f -encoding utf-8 -buffering none -eofchar {} \
-translation lf
} -body {
catch {read $f} errmsg
lappend res $errmsg
chan configure $f -profile tcl8
seek $f 0
set d [read $f]
binary scan $d H* hd
lappend res $hd
return $res
} -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 -encoding 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 -encoding binary
# \x81 is invalid in utf-8
puts -nonewline $f A\x81
flush $f
seek $f 0
fconfigure $f -encoding utf-8 -blocking 0 -eofchar {} -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 -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}
|
| ︙ | ︙ | |||
9651 9652 9653 9654 9655 9656 9657 |
flush $chan
seek $chan 0
fconfigure $chan -encoding utf-8 -buffering none -eofchar {} \
-translation auto -profile strict
} -body {
set res [gets $chan]
lappend res [gets $chan]
| | > > > > > > | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 10059 10060 10061 10062 10063 10064 10065 10066 10067 10068 10069 10070 |
flush $chan
seek $chan 0
fconfigure $chan -encoding utf-8 -buffering none -eofchar {} \
-translation auto -profile strict
} -body {
set res [gets $chan]
lappend res [gets $chan]
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} {} 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 -encoding 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 -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 -encoding 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 -encoding 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 -encoding 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]
|
| ︙ | ︙ | |||
9819 9820 9821 9822 9823 9824 9825 |
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: "*"}
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 10181 10182 10183 10184 10185 10186 10187 10188 10189 10190 10191 10192 10193 10194 10195 10196 10197 |
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: "*"}
# 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 23 24 25 26 27 28 |
# 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]
|
| ︙ | ︙ | |||
1394 1395 1396 1397 1398 1399 1400 |
note [fconfigure $c]
close $c
rename foo {}
set res
} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} -profile * -translation {auto *}}}
test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body {
set res {}
| | | 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 |
note [fconfigure $c]
close $c
rename foo {}
set res
} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} -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 {}}
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 * -eofchar {} -profile * -translation {auto *}}}
test iocmd-25.3 {chan configure, cgetall, regular result} -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 20 21 22 23 24 25 |
# 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 19 20 21 22 23 24 25 |
# Copyright © 2000 Ajuba Solutions.
# Copyright © 2000 Andreas Kupries.
#
# 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: 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 20 21 22 23 24 25 26 |
# 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 21 22 23 24 25 26 27 |
# 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 20 21 22 23 24 25 26 |
# 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 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 |
# 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 ""}
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-@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-@mode@ {linsert errors} {
list [catch @linsert@ [newlist msg]] $msg
} {1 {wrong # args: should be "linsert list index ?element ...?"}}
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-@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 ""}
}]
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 20 21 22 23 24 25 26 |
# 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 | # 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. | > > > > > > > > > > > > > < < < < < < | 1 2 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.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
|
| ︙ | ︙ | |||
219 220 221 222 223 224 225 |
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
| > > > | > > > > > | | | > > > | | 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 {
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 15 16 17 18 19 20 21 | # 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 20 21 22 23 24 25 26 |
# 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 23 24 25 26 27 28 29 |
# 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 19 20 21 22 23 24 25 |
# 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 20 21 22 23 24 25 26 |
# 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 20 21 22 23 24 25 26 |
# 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 | # 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. | > > > > > > > > > > > > < < < < < | 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.
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 20 21 22 23 24 25 26 |
# 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 20 21 22 23 24 25 26 |
# 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 | # 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. | > > > > > > > > > > > > < < < < < | 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.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
testConstraint arithSeriesDouble 1
|
| ︙ | ︙ | |||
326 327 328 329 330 331 332 333 334 335 336 337 338 339 |
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]
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}}}]
| > | 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 |
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 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.
# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your 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.
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]]
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
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-@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-@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-@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 "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-@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-@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-@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-@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-@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-@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-@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-@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-@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-@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-@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-@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-@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}
}]
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 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.
# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your 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.
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 | # 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. | > > > > > > > > > > > > < < < < < | 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.
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 19 20 21 22 23 24 25 |
# 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 |
# 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::*
}
| > > > > > > > | 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 19 20 21 22 23 24 25 |
# 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 21 22 23 24 25 26 27 |
# 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 19 20 21 22 23 24 25 |
# 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 | # 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. | > > > > > > > > > > > > > > < < < < < < < | 1 2 3 4 5 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.
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 | # 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. | > > > > > > > > > > > > > < < < < < < | 1 2 3 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.
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 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.
# You may distribute and/or modify this program under the terms of the GNU
# Affero General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your 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.
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 | # Commands covered: proc, apply, [interp alias], [namespce 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. | > > > > > > > > > > > > < < < < < | 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], [namespce 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.
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 | # 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. | > > > > > > > > > > > > > < < < < < < | 1 2 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.
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 16 17 18 19 20 21 22 |
# 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 16 17 18 19 20 21 22 |
# 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 17 18 19 20 21 22 23 |
# 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 18 19 20 21 22 23 24 |
# 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 20 21 22 23 24 25 26 |
# 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 21 22 23 24 25 26 27 |
# 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 17 18 19 20 21 22 23 |
# 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 17 18 19 20 21 22 23 |
# 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 | # 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. | > > > > > > > > > > > > > > < < < < < < < | 1 2 3 4 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.
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 20 21 22 23 24 25 26 |
# 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 | # 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. | > > > > > > > > > > < < < | 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.
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 | # 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. | > > > > > > > > > > > > < < < < < | 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.
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 | # 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. | > > > > > > > > > > > > > > < < < < < < < | 1 2 3 4 5 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.
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 | # 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. | > > > > > > > > > > > > > < < < < < < | 1 2 3 4 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.
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 | # 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. | > > > > > > > > > > > < < < < | 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.
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 20 21 22 23 24 25 26 |
# 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 | # 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.) | > > > > > > > > > < < | 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.)
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 20 21 22 23 24 25 26 |
# 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 20 21 22 23 24 25 26 |
# 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 | # 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. | > > > > > > > > > > < < < | 1 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.
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 | # 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. | > > > > > > > > > > > > < < < < < | 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.
# 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 20 21 22 23 24 25 26 |
# 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 19 20 21 22 23 24 25 |
# 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 19 20 21 22 23 24 25 |
# 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 | # 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. # | > > > > > > > > > > > > > | 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 | # 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. | < < < < < < | 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.
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 | # 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. | > > > > > > > > > > > > > < < < < < < | 1 2 3 4 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.
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 | # 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. | > > > > > > > > > > > > > < < < < < < | 1 2 3 4 5 6 7 8 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.
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 20 21 22 23 24 25 26 |
# 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 | # 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. | > > > > > > > > > > > < < < < | 1 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.
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 | # 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. | > > > > > > > > > > > > > > < < < < < < < | 1 2 3 4 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.
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 19 20 21 22 23 24 25 |
# 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 | # 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. # | > > > > > > > > > > > > > < < < < < | 1 2 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. # # 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 |
| ︙ | ︙ |
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 21 22 23 24 25 26 27 |
# 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 20 21 22 23 24 25 26 |
# 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 | # 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. | > > > > > > > > > > > > < < < < < | 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.
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 21 22 23 24 25 26 27 |
# 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 | # 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. | > > > > > > > > > > > > > < < < < < < | 1 2 3 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.
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 20 21 22 23 24 25 26 |
# 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 20 21 22 23 24 25 26 |
# 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 | # 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. | > > > > > > > > > > > > < < < < < | 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.
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 26 27 28 29 30 31 |
# 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 |
#! /usr/bin/env tclsh
# 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]]
| > > > > > > > < | 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 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 20 21 22 23 24 25 26 |
# 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 | # 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. | > > > > > > > > > > > > > < < < < < < | 1 2 3 4 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.
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 | # 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. | > > > > > > > > > > < < < | 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.
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 20 21 22 23 24 25 26 |
# 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 | # 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. | > > > > > > > > > > > > < < < < < | 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.
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 | # 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. | > > > > > > > > > > > > < < < < < | 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.
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 17 18 19 20 21 22 23 |
# 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 19 20 21 22 23 24 25 |
# 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 19 20 21 22 23 24 25 |
# 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 20 21 22 23 24 25 26 |
# 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 20 21 22 23 24 25 26 |
# 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 20 21 22 23 24 25 26 |
# 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 20 21 22 23 24 25 26 |
# 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 17 18 19 20 21 22 23 |
# 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 |
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
| | | | 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
} 1
test utf-1.17 {Tcl_UniCharToUtf: \xC0 + \x80} testbytestring {
set hi [testbytestring \xC0]
string length $hi[testbytestring \x80]
} 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 18 19 20 21 22 23 |
# Copyright (c) 2023 Ashok P. Nadkarni
# Copyright (c) 2024 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.
# This file contains a collection of tests for Tcl_UtfToExternal and
# Tcl_UtfToExternal. Sourcing this file into Tcl runs the tests and generates
# errors. No output means no errors found.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
|
| ︙ | ︙ | |||
70 71 72 73 74 75 76 |
} -result [list nospace {} \xFF] -constraints testencoding
# Another bug - char limit not obeyed
# % set cv 2
# % testencoding Tcl_ExternalToUtf utf-8 abcdefgh {start end noterminate charlimit} {} 20 rv wv cv
# nospace {} abcÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ
| > > > > > > > | | 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 |
} -result [list nospace {} \xFF] -constraints testencoding
# Another bug - char limit not obeyed
# % set cv 2
# % testencoding Tcl_ExternalToUtf utf-8 abcdefgh {start end noterminate charlimit} {} 20 rv wv cv
# nospace {} abcÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ
test TableToUtf-bug-5be203d6ca-profilestrict {Bug 5be203d6ca - truncated prefix in table encoding} -body {
set src \x82\x4F\x82\x50\x82
lassign [testencoding Tcl_ExternalToUtf shiftjis $src {start profilestrict} 0 16 srcRead dstWritten charsWritten] buf
set result [list [testencoding Tcl_ExternalToUtf shiftjis $src {start profilestrict} 0 16 srcRead dstWritten charsWritten] $srcRead $dstWritten $charsWritten]
lappend result {*}[list [testencoding Tcl_ExternalToUtf shiftjis [string range $src $srcRead end] {end profiletcl8} 0 10 srcRead dstWritten charsWritten] $srcRead $dstWritten $charsWritten]
} -result [list [list multibyte 0 \xEF\xBC\x90\xEF\xBC\x91\x00\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF] 4 6 2 [list ok 0 \xC2\x82\x00\xFF\xFF\xFF\xFF\xFF\xFF\xFF] 1 2 1]
test TableToUtf-bug-5be203d6ca-profiletcl8 {Bug 5be203d6ca - truncated prefix in table encoding} -body {
set src \x82\x4F\x82\x50\x82
lassign [testencoding Tcl_ExternalToUtf shiftjis $src {start profiletcl8} 0 16 srcRead dstWritten charsWritten] buf
set result [list [testencoding Tcl_ExternalToUtf shiftjis $src {start profiletcl8} 0 16 srcRead dstWritten charsWritten] $srcRead $dstWritten $charsWritten]
lappend result {*}[list [testencoding Tcl_ExternalToUtf shiftjis [string range $src $srcRead end] {end profiletcl8} 0 10 srcRead dstWritten charsWritten] $srcRead $dstWritten $charsWritten]
} -result [list [list multibyte 0 \xEF\xBC\x90\xEF\xBC\x91\x00\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF] 4 6 2 [list ok 0 \xC2\x82\x00\xFF\xFF\xFF\xFF\xFF\xFF\xFF] 1 2 1] -constraints testencoding
::tcltest::cleanupTests
return
# Local Variables:
# mode: tcl
# End:
|
Changes to tests/util.test.
|
| < < < > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
# 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 | # 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. | > > > > > > > > > > > > > < < < < < < | 1 2 3 4 5 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.
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 | # 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. | > > > > > > > > > > > > > > < < < < < < < | 1 2 3 4 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.
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 19 20 21 22 23 24 25 |
# 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 | # 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. | > > > > > > > > > > > > < < < < < | 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 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.
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 | # 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. | > > > > > > > > > > > > < < < < < | 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.
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 19 20 21 22 23 24 25 |
# 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 19 20 21 22 23 24 25 |
# 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 19 20 21 22 23 24 25 |
# 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 | # # 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. | > > > > > > > > > > > > < < < < < < | 1 2 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.
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 19 20 21 22 23 24 25 |
# 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 21 22 23 24 25 26 |
# 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 19 20 21 22 23 24 25 |
# 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 | # 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. | > > > > > > > > > > | < < | 1 2 3 4 5 6 7 8 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.
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 | #--------------------------------------------------------------------------- # # 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 | # 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. # | | > > > > > > > > > > > > > > > > > > > > > > | < < < < < < < | 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. 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 | /* | < < < < < < > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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) 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 | # 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 | > > > > > > > > > > > > < < < < < < | 1 2 3 4 5 6 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
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 19 20 21 22 23 24 |
# 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 | # 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. | > > > > > > > > > > > > < < < < < | 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. # 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 25 26 27 28 29 |
#! /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.
#
#----------------------------------------------------------------------
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 23 24 25 26 |
#! /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
#
#----------------------------------------------------------------------
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 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 | # # Results: # None. # # Side effects: # Creates the message catalogs. # | < < < < < | 29 30 31 32 33 34 35 36 37 38 39 40 41 42 | # # Results: # None. # # Side effects: # Creates the message catalogs. # #---------------------------------------------------------------------- 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. |
| ︙ | ︙ |
Changes to tools/makeHeader.tcl.
1 2 3 4 5 | # makeHeader.tcl -- # # This script generates embeddable C source (in a .h file) from a .tcl # script. # | > > > > > > > > > > > > < < < < | 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.
#
package require Tcl 8.6-
namespace eval makeHeader {
####################################################################
#
|
| ︙ | ︙ |
Changes to tools/makeTestCases.tcl.
1 2 3 4 5 6 7 | # 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 [file join $d library/tzdata/America/Detroit] | > > > > > > > > | 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 [file join $d library/tzdata/America/Detroit] |
| ︙ | ︙ |
Changes to tools/mkVfs.tcl.
1 2 3 4 5 6 7 |
proc cat fname {
set fname [open $fname r]
set data [read $fname]
close $fname
return $data
}
| > > > > > > > | 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 | #============================================================================== | < < < > > > > > > > > > > | 1 2 3 4 5 6 7 8 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, 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 | # 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. | > > > > > > > > > < < | 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.
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 20 21 22 23 24 25 26 |
# 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 | #---------------------------------------------------------------------- # # 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. | > > > > > > > > > > > | 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 | # 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. # | < < < < < | 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.
#
#----------------------------------------------------------------------
# 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 15 16 17 18 19 20 |
# Copyright © 1995-1997 Roger E. Critchlow Jr
# Copyright © 2004-2011 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.
# 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.
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 |
#!/usr/bin/env tclsh
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.
| > > > > > > > > > > < < < | 1 2 3 4 5 6 7 8 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.
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 |
#include <tcl.h>
extern DLLEXPORT Tcl_LibraryInitProc Tsdperf_Init;
static Tcl_ThreadDataKey key;
typedef struct {
| > > > > > > > > > | 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 |
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]]
| > > > > > > > > | 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 21 22 23 |
#! /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 | # 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 | > > > > > > > > > > > > < < < | 1 2 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
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 |
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"
| < < < < | 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"
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 "};
/*
* 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,"]
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 "};
/*
* 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 |
puts $f [string trimright $line]
set line " "
}
}
puts $f $line
puts -nonewline $f "};
| < | < < < | 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 "};
#define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= [format 0x%X $next])
/*
* The following constants are used to determine the category of a
* Unicode character.
*/
enum {
|
| ︙ | ︙ | |||
397 398 399 400 401 402 403 | #define GetDelta(info) ((info) >> 8) /* * This macro extracts the information about a character from the * Unicode character tables. */ | < | < < < | 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.
*/
#define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0x1FFFFF) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\])
"
close $f
}
uni::main
return
|
Changes to tools/valgrind_check_success.
1 2 3 4 5 6 7 8 9 |
#! /usr/bin/env tclsh
proc main {sourcetype source} {
switch $sourcetype {
file {
set chan [open $source]
try {
set data [read $chan]
| > > > > > > > > | 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 | # # 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@ | > > > > > > | 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 |
# 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
| < < < < < | 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
# 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 |
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 \
| | > | > | | | | | 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 |
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 tclTestObjInterface.o \
tclTestObjInterfaceInteger.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 tclCmdAH.o tclCmdIL.o tclCmdMZ.o \
tclCompCmds.o tclCompCmdsGR.o tclCompCmdsSZ.o tclCompExpr.o \
tclCompile.o tclConfig.o tclDate.o tclDictObj.o tclDisassemble.o \
tclEncoding.o tclEnsemble.o \
tclEnv.o tclEvent.o tclExecute.o tclFCmd.o tclFileName.o tclGet.o \
tclHash.o tclHistory.o tclIndexObj.o tclInterp.o tclIO.o tclIOCmd.o \
tclIORChan.o tclIORTrans.o tclIOGT.o tclIOSock.o tclIOUtil.o \
tclLink.o tclListObj.o \
tclLiteral.o tclLoad.o tclMain.o tclNamesp.o tclNotify.o \
tclObj.o 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 \
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
|
| ︙ | ︙ | |||
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 | $(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)/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)/tclStrToD.c \ $(GENERIC_DIR)/tclTest.c \ $(GENERIC_DIR)/tclTestABSList.c \ $(GENERIC_DIR)/tclTestObj.c \ $(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 \ | > > > | 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 | $(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)/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 \ |
| ︙ | ︙ | |||
1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 | 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 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 tclLoadAix.o: $(UNIX_DIR)/tclLoadAix.c | > > > | 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 | 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 tclLoadAix.o: $(UNIX_DIR)/tclLoadAix.c |
| ︙ | ︙ | |||
1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 | 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 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 | > > > > > > > | 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 | 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 |
| ︙ | ︙ |
Deleted unix/configure.
more than 10,000 changes
Changes to unix/configure.ac.
1 2 3 4 5 6 7 8 | #! /bin/bash -norc 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]) | > > > > > > > > | 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 | 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@ | | | | < < < < < < < < < < < < | 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@ -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}
@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}
@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
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 |
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}
| < < < < < < < < < < < < | 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}
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 |
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}
| < < < < < < < < < < < < | 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}
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 | #!/bin/sh ######################################################################## ### Parse Options ### Gzip=: Sym="" | > > > > > > > | 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 | #!/bin/sh | | > > > > > > > | 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 | #------------------------------------------------------------------------ # SC_PATH_TCLCONFIG -- # # Locate the tclConfig.sh file and perform a sanity check on # the Tcl compile flags # # Arguments: | > > > > > > > | 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 |
# This file is the basis for a binary Tcl RPM for Linux.
%{!?directory:%define directory /usr/local}
| | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
# This file is the basis for a binary Tcl RPM for Linux.
%{!?directory:%define directory /usr/local}
Name: tclunchained
Summary: TclUnchained scripting language development environment
Version: 9.0a4
Release: 2
License: GNU Affero General Public License
Group: Development/Languages
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
creating integration applications that tie together diverse
applications, protocols, devices, and frameworks. When paired with
|
| ︙ | ︙ |
Changes to unix/tclAppInit.c.
1 | /* | < < < < < < > | | | | > > > | > | > > > > | < < > | 1 2 3 4 5 6 7 8 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) 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. */ /* * You may distribute and/or modify this program under the terms of the GNU * Affero General Public License as published by the Free Software Foundation, * either version 3 of the License, or (at your 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). */ #include "tcl.h" #ifdef TCL_TEST extern Tcl_LibraryInitProc Tcltest_Init; extern Tcl_LibraryInitProc Tcltest_SafeInit; #endif /* TCL_TEST */ #ifdef TCL_XT_TEST |
| ︙ | ︙ | |||
82 83 84 85 86 87 88 |
{
#ifdef TCL_XT_TEST
XtToolkitInitialize();
#endif
#ifdef TCL_LOCAL_MAIN_HOOK
TCL_LOCAL_MAIN_HOOK(&argc, &argv);
| | | 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 !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 | /* | < < < < < < > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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-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 |
| ︙ | ︙ |
Changes to unix/tclKqueueNotfy.c.
1 2 3 4 5 6 7 | /* * 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. | > > > > > > > > > > > > > > > > > < < < < < < | 1 2 3 4 5 6 7 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. */ #include "tclInt.h" #ifndef HAVE_COREFOUNDATION /* Darwin/Mac OS X CoreFoundation notifier is * in tclMacOSXNotify.c */ #if defined(NOTIFIER_KQUEUE) && TCL_THREADS |
| ︙ | ︙ |
Changes to unix/tclLoadAix.c.
1 2 3 4 5 6 7 | /* * 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. * | > > > > > > > > > > > > > > > | 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 | * 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. */ | < < < < < < | 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. */ #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 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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-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 | /* * 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). | > > > > > > > > > > > > > > > > > < < < < < < | 1 2 3 4 5 6 7 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). */ #include "tclInt.h" #ifndef MODULE_SCOPE # define MODULE_SCOPE extern #endif |
| ︙ | ︙ |
Changes to unix/tclLoadNext.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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-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. |
| ︙ | ︙ |
Changes to unix/tclLoadOSF.c.
1 2 3 4 5 6 7 | /* * 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]. | > > > > > > > > > > > > > > > > | 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 | * 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> | < < < < < | 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> */ #include "tclInt.h" #include <sys/types.h> #include <loader.h> |
| ︙ | ︙ |
Changes to unix/tclLoadShl.c.
1 2 3 4 5 6 | /* * 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). | > > > > > > > > > > > > > > > > < < < < < | 1 2 3 4 5 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). */ #include <dl.h> #include "tclInt.h" /* * Static functions defined within this file. |
| ︙ | ︙ |
Changes to unix/tclSelectNotfy.c.
1 2 3 4 5 6 | /* * 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. | > > > > > > > > > > > > > > > > < < < < < | 1 2 3 4 5 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. */ #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 |
| ︙ | ︙ |
Changes to unix/tclUnixChan.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 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 © 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> |
| ︙ | ︙ |
Changes to unix/tclUnixCompat.c.
1 | /* | < < > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | /* * 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 */ |
| ︙ | ︙ |
Changes to unix/tclUnixEvent.c.
1 | /* | < < < < > > > > > > > > > > > > > > > | 1 2 3 4 5 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. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ /* * You may distribute and/or modify this program under the terms of the GNU * Affero General Public License as published by the Free Software Foundation, * either version 3 of the License, or (at your 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 | /* | < < < < < < < < < < < < < < | 1 2 3 4 5 6 7 8 | /* * Copyright © 1988, 1993, 1994 * 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. |
| ︙ | ︙ | |||
36 37 38 39 40 41 42 43 44 45 46 47 48 49 | * 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. */ #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 | > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
| ︙ | ︙ |
Changes to unix/tclUnixFile.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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. */ /* * 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); /* |
| ︙ | ︙ |
Changes to unix/tclUnixInit.c.
1 | /* | < < < < > > > > > > > > > > > > > > > | 1 2 3 4 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-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 |
| ︙ | ︙ |
Changes to unix/tclUnixNotfy.c.
1 | /* | < < < < < < > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 © 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 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 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 © 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> |
| ︙ | ︙ | |||
1098 1099 1100 1101 1102 1103 1104 |
* routine.
*/
if (pipePtr->errorFile) {
errChan = Tcl_MakeFileChannel(
INT2PTR(GetFd(pipePtr->errorFile)),
TCL_READABLE);
| < < | 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 |
* routine.
*/
if (pipePtr->errorFile) {
errChan = Tcl_MakeFileChannel(
INT2PTR(GetFd(pipePtr->errorFile)),
TCL_READABLE);
} else {
errChan = NULL;
}
result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
errChan);
}
|
| ︙ | ︙ |
Changes to unix/tclUnixPort.h.
1 2 3 4 5 6 7 8 9 10 11 12 13 | /* * 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. | > > > > > > > > > > > > > > > > > < < < < < < | 1 2 3 4 5 6 7 8 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. */ #ifndef _TCLUNIXPORT #define _TCLUNIXPORT /* *--------------------------------------------------------------------------- |
| ︙ | ︙ |
Changes to unix/tclUnixSock.c.
1 | /* | < < < < > > > > > > > > > > > > > > > | 1 2 3 4 5 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 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. |
| ︙ | ︙ |
Changes to unix/tclUnixTest.c.
1 | /* | < < < < > > > > > > > > > > > > > > > > | | < | 1 2 3 4 5 6 7 8 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 © 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 # 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 | /* | < < < < > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 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 © 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. * |
| ︙ | ︙ |
Changes to unix/tclUnixTime.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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 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 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ /* * You may distribute and/or modify this program under the terms of the GNU * Affero General Public License as published by the Free Software Foundation, * either version 3 of the License, or (at your 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" /* |
| ︙ | ︙ |
Changes to unix/tclXtTest.c.
1 | /* | < < < < > > > > > > > > > > > > > > > | 1 2 3 4 5 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. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ /* * You may distribute and/or modify this program under the terms of the GNU * Affero General Public License as published by the Free Software Foundation, * either version 3 of the License, or (at your 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 | # # 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@ | > > > > > > | 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 | # 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 | < < < < < | 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 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@ |
| ︙ | ︙ | |||
142 143 144 145 146 147 148 |
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}
| < < | 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 |
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_LIB_FILE = @LIBPREFIX@tcldde$(DDEVER)${DLLSUFFIX}${LIBSUFFIX}
REG_DLL_FILE = tcl9registry$(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 [file normalize ${DDE_DLL_FILE}]];\
package ifneeded registry 1.3.7 [list load [file normalize ${REG_DLL_FILE}]]
|
| ︙ | ︙ | |||
271 272 273 274 275 276 277 278 279 280 281 282 283 284 |
${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} -DMP_PREC=4 \
${AC_FLAGS} ${COMPILE_DEBUG_FLAGS}
TCLTEST_OBJS = \
tclTest.$(OBJEXT) \
tclTestABSList.$(OBJEXT) \
tclTestObj.$(OBJEXT) \
tclTestProcBodyObj.$(OBJEXT) \
tclThreadTest.$(OBJEXT) \
tclWinTest.$(OBJEXT)
GENERIC_OBJS = \
regcomp.$(OBJEXT) \
regexec.$(OBJEXT) \
| > | 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 |
${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) \
|
| ︙ | ︙ | |||
520 521 522 523 524 525 526 |
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)
| | | 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 |
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}
libraries:
doc:
tclzipfile: ${TCL_ZIP_FILE}
|
| ︙ | ︙ | |||
594 595 596 597 598 599 600 |
@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
| < < < < < < < < | 594 595 596 597 598 599 600 601 602 603 604 605 606 607 |
@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
${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}
|
| ︙ | ︙ | |||
658 659 660 661 662 663 664 |
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)
| < < < < < < | 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 |
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)
tclWinDde.${OBJEXT}: tclWinDde.c
$(CC) -c $(CC_SWITCHES) $(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
|
| ︙ | ︙ | |||
865 866 867 868 869 870 871 |
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
| < < < < < < < < | 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 |
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_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_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)" \
|
| ︙ | ︙ | |||
1142 1143 1144 1145 1146 1147 1148 | $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \ "$(GENERIC_DIR_NATIVE)" \ "$(GENERIC_DIR_NATIVE)/tclOO.decls" # # 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 | | | 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 | $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \ "$(GENERIC_DIR_NATIVE)" \ "$(GENERIC_DIR_NATIVE)/tclOO.decls" # # 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.* # 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 | /* | < < < < > > > > > > > > > > > > > > > | 1 2 3 4 5 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) 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.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Changes to win/configure.ac.
1 2 3 4 5 6 7 8 | #! /bin/bash -norc # 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]) | > > > > > > > > | 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 | #------------------------------------------------------------- -*- 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. # | > > > > > > > > > > > > > > < < < < < < > | 1 2 3 4 5 6 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. # #------------------------------------------------------------------------------ # 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 6-8 in rules.vc. # |
| ︙ | ︙ | |||
227 228 229 230 231 232 233 234 235 236 237 238 239 240 | TCLSHOBJS = \ $(TMP_DIR)\tclAppInit.obj \ $(TMP_DIR)\tclsh.res TCLTESTOBJS = \ $(TMP_DIR)\tclTest.obj \ $(TMP_DIR)\tclTestObj.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 | > | 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 |
| ︙ | ︙ |
Changes to win/nmakehlp.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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) 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 | #------------------------------------------------------------- -*- 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. # | > > > > > > > > > > > > > > | < | < < < < | 1 2 3 4 5 6 7 8 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. # #------------------------------------------------------------------------------ !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. |
| ︙ | ︙ | |||
855 856 857 858 859 860 861 | !if [nmakehlp -f $(OPTS) "nomsvcrt"] !message *** Doing nomsvcrt MSVCRT = 0 !else !if [nmakehlp -f $(OPTS) "msvcrt"] !message *** Doing msvcrt !else | < < < < < < < < < < < < < < < | 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 | !if [nmakehlp -f $(OPTS) "nomsvcrt"] !message *** Doing nomsvcrt MSVCRT = 0 !else !if [nmakehlp -f $(OPTS) "msvcrt"] !message *** Doing msvcrt !else !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 # 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 |
| ︙ | ︙ | |||
1000 1001 1002 1003 1004 1005 1006 | !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 | < < < < < | 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 | !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 # Defaults - Permit deprecated functions and warning level 3 WARNINGS = -W3 !if "$(CHECKS)" != "" && ![nmakehlp -f "$(CHECKS)" "none"] !if [nmakehlp -f $(CHECKS) "nodep"] !message *** Doing nodep check !endif !if [nmakehlp -f $(CHECKS) "fullwarn"] !message *** Doing full warnings check WARNINGS = -W4 !if [nmakehlp -l -warn:3 $(LINKER_TESTFLAGS)] LINKERFLAGS = $(LINKERFLAGS) -warn:3 |
| ︙ | ︙ | |||
1141 1142 1143 1144 1145 1146 1147 | 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)\$(TCLSCRIPTZIPNAME) | < < < < < < < < < < < < < < < < < < < < < | 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 |
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)\$(TCLSCRIPTZIPNAME)
TCLSTUBLIBNAME = $(STUBPREFIX).lib
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
TCLSTUBLIB = $(_TCLDIR)\lib\tclstub.lib
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\$(TCLSCRIPTZIPNAME)
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
TCLSTUBLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub.lib
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)\$(TCLSCRIPTZIPNAME)
TCLTOOLSDIR = $(_TCLDIR)\tools
TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"
!endif # TCLINSTALL
tcllibs = "$(TCLSTUBLIB)" "$(TCLIMPLIB)"
!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)
TKLIBNAME = tcl9tk$(TK_VERSION)$(SUFX).$(EXT)
TKIMPLIBNAME = tcl9tk$(TK_VERSION)$(SUFX).lib
!if $(TK_MAJOR_VERSION) == 8
TKSTUBLIBNAME = tkstub$(TK_VERSION).lib
!else
TKSTUBLIBNAME = tkstub.lib
!endif
!if $(DOING_TK)
|
| ︙ | ︙ | |||
1290 1291 1292 1293 1294 1295 1296 | !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) | < < < < < < < < | 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 | !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) PRJLIBNAME = $(PRJLIBNAME9) PRJLIB = $(OUT_DIR)\$(PRJLIBNAME) PRJSTUBLIBNAME = $(STUBPREFIX).lib 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) |
| ︙ | ︙ | |||
1406 1407 1408 1409 1410 1411 1412 | 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 | < | < | 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 | 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 OPTDEFINES = $(OPTDEFINES) !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) |
| ︙ | ︙ | |||
1437 1438 1439 1440 1441 1442 1443 | !if "$(MACHINE)" == "AMD64" || "$(MACHINE)" == "ARM64" OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_DO64BIT !endif !if $(VCVERSION) < 1300 OPTDEFINES = $(OPTDEFINES) /DNO_STRTOI64=1 !endif | < < < < < < < < < < < < | 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 |
!if "$(MACHINE)" == "AMD64" || "$(MACHINE)" == "ARM64"
OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_DO64BIT
!endif
!if $(VCVERSION) < 1300
OPTDEFINES = $(OPTDEFINES) /DNO_STRTOI64=1
!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 | #------------------------------------------------------------------------ # SC_PATH_TCLCONFIG -- # # Locate the tclConfig.sh file and perform a sanity check on # the Tcl compile flags # # Arguments: | > > > > > > > | 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 | /* | < < < < < < < < > | | | | > > > | > | < > > > > | > | > | 1 2 3 4 5 6 7 8 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 (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. */ /* * You may distribute and/or modify this program under the terms of the GNU * Affero General Public License as published by the Free Software Foundation, * either version 3 of the License, or (at your 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). * 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 |
if (*p == '\\') {
*p = '/';
}
}
#ifdef TCL_LOCAL_MAIN_HOOK
TCL_LOCAL_MAIN_HOOK(&argc, &argv);
| | | 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 (!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 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 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-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 |
| ︙ | ︙ |
Changes to win/tclWinChan.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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-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 | 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); | | | 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(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); |
| ︙ | ︙ | |||
890 891 892 893 894 895 896 |
#undef STORE_ELEM
return dictObj;
}
static int
FileGetOptionProc(
| | | 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 |
#undef STORE_ELEM
return dictObj;
}
static int
FileGetOptionProc(
ClientData 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;
|
| ︙ | ︙ |
Changes to win/tclWinConsole.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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 © 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> |
| ︙ | ︙ |
Changes to win/tclWinDde.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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) 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> |
| ︙ | ︙ | |||
134 135 136 137 138 139 140 |
Tcl_Obj *const objv[]);
#ifdef __cplusplus
extern "C" {
#endif
DLLEXPORT int Dde_Init(Tcl_Interp *interp);
DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp);
| < < < < < | 145 146 147 148 149 150 151 152 153 154 155 156 157 158 |
Tcl_Obj *const objv[]);
#ifdef __cplusplus
extern "C" {
#endif
DLLEXPORT int Dde_Init(Tcl_Interp *interp);
DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp);
#ifdef __cplusplus
}
#endif
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
171 172 173 174 175 176 177 |
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);
}
| < < < < < < < < | 177 178 179 180 181 182 183 184 185 186 187 188 189 190 |
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);
}
/*
*----------------------------------------------------------------------
*
* Dde_SafeInit --
*
* This function initializes the dde command within a safe interp
|
| ︙ | ︙ | |||
206 207 208 209 210 211 212 |
{
int result = Dde_Init(interp);
if (result == TCL_OK) {
Tcl_HideCommand(interp, "dde", "dde");
}
return result;
}
| < < < < < < < < | 204 205 206 207 208 209 210 211 212 213 214 215 216 217 |
{
int result = Dde_Init(interp);
if (result == TCL_OK) {
Tcl_HideCommand(interp, "dde", "dde");
}
return result;
}
/*
*----------------------------------------------------------------------
*
* Initialize --
*
* Initialize the global DDE instance.
|
| ︙ | ︙ |
Changes to win/tclWinError.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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-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 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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 © 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() */ |
| ︙ | ︙ |
Changes to win/tclWinFile.c.
1 2 3 4 5 6 7 | /* * 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. | > > > > > > > > > > > > > > > > < < < < < | 1 2 3 4 5 6 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. */ #include "tclWinInt.h" #include "tclFileSystem.h" #include <winioctl.h> #include <shlobj.h> #include <lm.h> /* For TclpGetUserHome(). */ |
| ︙ | ︙ |
Changes to win/tclWinInit.c.
1 | /* | < < < < > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 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. * 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 |
| ︙ | ︙ |
Changes to win/tclWinInt.h.
1 | /* | < < < < > > > > > > > > > > > > > > > | 1 2 3 4 5 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-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 /* |
| ︙ | ︙ |
Changes to win/tclWinLoad.c.
1 2 3 4 5 6 | /* * tclWinLoad.c -- * * This function provides a version of the TclLoadFile that works with * the Windows "LoadLibrary" and "GetProcAddress" API for dynamic * loading. | > > > > > > > > > > > > > > > > < < < < < | 1 2 3 4 5 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. */ #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 |
| ︙ | ︙ |
Changes to win/tclWinNotify.c.
1 2 3 4 5 6 | /* * 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. | > > > > > > > > > > > > > > > > < < < < < | 1 2 3 4 5 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. */ #include "tclInt.h" /* * The following static indicates whether this module has been initialized. */ |
| ︙ | ︙ |
Changes to win/tclWinPanic.c.
1 | /* | < < < < > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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 © 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 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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 © 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. */ |
| ︙ | ︙ | |||
2119 2120 2121 2122 2123 2124 2125 |
if (pipePtr->errorFile) {
WinFile *filePtr = (WinFile *) pipePtr->errorFile;
errChan = Tcl_MakeFileChannel((void *) filePtr->handle,
TCL_READABLE);
Tcl_Free(filePtr);
| < < | | 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 |
if (pipePtr->errorFile) {
WinFile *filePtr = (WinFile *) pipePtr->errorFile;
errChan = Tcl_MakeFileChannel((void *) filePtr->handle,
TCL_READABLE);
Tcl_Free(filePtr);
} else {
errChan = NULL;
}
result = TclCleanupChildren(interp, pipePtr->numPids,
pipePtr->pidPtr, errChan);
}
|
| ︙ | ︙ |
Changes to win/tclWinPort.h.
1 2 3 4 5 6 | /* * 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. | > > > > > > > > > > > > > > > > < < < < < | 1 2 3 4 5 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. */ #ifndef _TCLWINPORT #define _TCLWINPORT #if !defined(_WIN64) && !defined(__MINGW_USE_VC2005_COMPAT) /* See [Bug 3354324]: file mtime sets wrong time */ |
| ︙ | ︙ |
Changes to win/tclWinReg.c.
1 | /* | < < < < < < > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 (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") |
| ︙ | ︙ | |||
141 142 143 144 145 146 147 |
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);
| < < < < < | 152 153 154 155 156 157 158 159 160 161 162 163 164 165 |
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);
#ifdef __cplusplus
}
#endif
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
181 182 183 184 185 186 187 |
}
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);
}
| < < < < < < < < | 187 188 189 190 191 192 193 194 195 196 197 198 199 200 |
}
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);
}
/*
*----------------------------------------------------------------------
*
* Registry_Unload --
*
* This function removes the registry command.
|
| ︙ | ︙ | |||
235 236 237 238 239 240 241 |
cmd = (Tcl_Command)Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL);
if (cmd != NULL) {
Tcl_DeleteCommandFromToken(interp, cmd);
}
return TCL_OK;
}
| < < < < < < < < < | 233 234 235 236 237 238 239 240 241 242 243 244 245 246 |
cmd = (Tcl_Command)Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL);
if (cmd != NULL) {
Tcl_DeleteCommandFromToken(interp, cmd);
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* DeleteCmd --
*
* Cleanup the interp command token so that unloading doesn't try to
|
| ︙ | ︙ |
Changes to win/tclWinSerial.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 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 © 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. */ |
| ︙ | ︙ |
Changes to win/tclWinSock.c.
1 | /* | < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 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-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. |
| ︙ | ︙ |
Changes to win/tclWinTest.c.
1 | /* | < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 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 © 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 | /* | < < < < > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 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 © 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 */ |
| ︙ | ︙ |
Changes to win/tclWinTime.c.
1 | /* | < < < < < > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 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. */ /* * 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 |
| ︙ | ︙ |