Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | merge 8.7 |
|---|---|
| Timelines: | family | ancestors | descendants | both | tcl9-design |
| Files: | files | file ages | folders |
| SHA3-256: |
f1d5e5874f3a79992cbd54b22d49dcd4 |
| User & Date: | dgp 2022-03-09 19:37:34.809 |
Context
|
2022-03-10
| ||
| 16:56 | merge 8.7 check-in: b0463de589 user: dgp tags: tcl9-design | |
|
2022-03-09
| ||
| 19:37 | merge 8.7 check-in: f1d5e5874f user: dgp tags: tcl9-design | |
| 15:16 | Tweak test code such that it can be used to test indexes > 2^31 too, so no longer limit values to IN... check-in: e3ee44645c user: jan.nijtmans tags: core-8-branch | |
|
2021-04-28
| ||
| 12:28 | WIP check-in: f290d896cb user: dgp tags: tcl9-design | |
Changes
Changes to .github/ISSUE_TEMPLATE.md.
1 2 | Important Note ========== | | | 1 2 3 | Important Note ========== Please do not file issues with Tcl on Github. They are unlikely to be noticed in a timely fashion. Tcl issues are hosted in the [tcl fossil repository on core.tcl-lang.org](https://core.tcl-lang.org/tcl/tktnew); please post them there. |
Changes to .github/PULL_REQUEST_TEMPLATE.md.
1 2 | Important Note ========== | | | 1 2 3 | Important Note ========== Please do not file pull requests with Tcl on Github. They are unlikely to be noticed in a timely fashion. Tcl issues (including patches) are hosted in the [tcl fossil repository on core.tcl-lang.org](https://core.tcl-lang.org/tcl/tktnew); please post them there. |
Changes to .github/workflows/mac-build.yml.
1 2 3 4 | name: macOS on: [push] jobs: xcode: | | | 1 2 3 4 5 6 7 8 9 10 11 12 |
name: macOS
on: [push]
jobs:
xcode:
runs-on: macos-11
defaults:
run:
shell: bash
working-directory: macosx
steps:
- name: Checkout
uses: actions/checkout@v2
|
| ︙ | ︙ | |||
20 21 22 23 24 25 26 |
CFLAGS: -arch x86_64 -arch arm64e
- name: Run Tests
run: make test styles=develop
env:
ERROR_ON_FAILURES: 1
MAC_CI: 1
clang:
| | | 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 |
CFLAGS: -arch x86_64 -arch arm64e
- name: Run Tests
run: make test styles=develop
env:
ERROR_ON_FAILURES: 1
MAC_CI: 1
clang:
runs-on: macos-11
strategy:
matrix:
cfgopt:
- ""
- "--disable-shared"
- "--enable-symbols"
- "--enable-symbols=mem"
|
| ︙ | ︙ |
Changes to .github/workflows/onefiledist.yml.
1 2 3 4 5 |
name: Build Binaries
on: [push]
jobs:
linux:
name: Linux
| | | 1 2 3 4 5 6 7 8 9 10 11 12 13 |
name: Build Binaries
on: [push]
jobs:
linux:
name: Linux
runs-on: ubuntu-18.04
defaults:
run:
shell: bash
steps:
- name: Checkout
uses: actions/checkout@v2
- name: Prepare
|
| ︙ | ︙ | |||
23 24 25 26 27 28 29 |
run: |
make tclsh
make shell SCRIPT="$VER_PATH $GITHUB_ENV"
echo "TCL_ZIP=`pwd`/`echo libtcl*.zip`" >> $GITHUB_ENV
working-directory: unix
- name: Package
run: |
| | | | | | | 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 |
run: |
make tclsh
make shell SCRIPT="$VER_PATH $GITHUB_ENV"
echo "TCL_ZIP=`pwd`/`echo libtcl*.zip`" >> $GITHUB_ENV
working-directory: unix
- name: Package
run: |
cp ../unix/tclsh tclsh${TCL_PATCHLEVEL}_snapshot
chmod +x tclsh${TCL_PATCHLEVEL}_snapshot
tar -cf tclsh${TCL_PATCHLEVEL}_snapshot.tar tclsh${TCL_PATCHLEVEL}_snapshot
working-directory: 1dist
- name: Upload
uses: actions/upload-artifact@v2
with:
name: Tclsh ${{ env.TCL_PATCHLEVEL }} Linux single-file build (snapshot)
path: 1dist/*.tar
macos:
name: macOS
runs-on: macos-11
defaults:
run:
shell: bash
steps:
- name: Checkout
uses: actions/checkout@v2
- name: Checkout create-dmg
|
| ︙ | ︙ | |||
70 71 72 73 74 75 76 |
make shell SCRIPT="$VER_PATH $GITHUB_ENV"
echo "TCL_BIN=`pwd`/tclsh" >> $GITHUB_ENV
echo "TCL_ZIP=`pwd`/`echo libtcl*.zip`" >> $GITHUB_ENV
working-directory: unix
- name: Package
run: |
mkdir contents
| | | | | | | | | > > > < < > > > > > | | | | | 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 |
make shell SCRIPT="$VER_PATH $GITHUB_ENV"
echo "TCL_BIN=`pwd`/tclsh" >> $GITHUB_ENV
echo "TCL_ZIP=`pwd`/`echo libtcl*.zip`" >> $GITHUB_ENV
working-directory: unix
- name: Package
run: |
mkdir contents
cp $TCL_BIN contents/tclsh${TCL_PATCHLEVEL}_snapshot
chmod +x contents/tclsh${TCL_PATCHLEVEL}_snapshot
cat > contents/README.txt <<EOF
This is a single-file executable developer preview of Tcl $TCL_PATCHLEVEL
It is not intended as an official release at all, so it is unsigned and unnotarized.
Use strictly at your own risk.
To run it, you need to copy the executable out and run:
xattr -d com.apple.quarantine tclsh${TCL_PATCHLEVEL}_snapshot
to mark the executable as runnable on your machine.
EOF
$CREATE_DMG \
--volname "Tcl $TCL_PATCHLEVEL (snapshot)" \
--window-pos 200 120 \
--window-size 800 400 \
"Tcl-$TCL_PATCHLEVEL-(snapshot).dmg" \
"contents/"
working-directory: 1dist
- name: Upload
uses: actions/upload-artifact@v2
with:
name: Tclsh ${{ env.TCL_PATCHLEVEL }} macOS single-file build (snapshot)
path: 1dist/*.dmg
win:
name: Windows
runs-on: windows-2019
defaults:
run:
shell: msys2 {0}
env:
CC: gcc
CFGOPT: --disable-symbols --disable-shared
steps:
- name: Install MSYS2
uses: msys2/setup-msys2@v2
with:
msystem: UCRT64
install: git mingw-w64-ucrt-x86_64-toolchain make zip
- name: Checkout
uses: actions/checkout@v2
- name: Prepare
run: |
touch generic/tclStubInit.c generic/tclOOStubInit.c
echo "VER_PATH=$(cd tools; pwd)/addVerToFile.tcl" >> $GITHUB_ENV
mkdir 1dist
working-directory: .
- name: Configure
run: ./configure $CFGOPT
working-directory: win
- name: Build
run: |
make binaries libraries
echo "TCL_ZIP=`pwd`/`echo libtcl*.zip`" >> $GITHUB_ENV
working-directory: win
- name: Get Exact Version
run: |
./tclsh*.exe $VER_PATH $GITHUB_ENV
working-directory: win
- name: Set Executable Name
run: |
cp ../win/tclsh*.exe tclsh${TCL_PATCHLEVEL}_snapshot.exe
working-directory: 1dist
- name: Upload
uses: actions/upload-artifact@v2
with:
name: Tclsh ${{ env.TCL_PATCHLEVEL }} Windows single-file build (snapshot)
path: '1dist/*_snapshot.exe'
|
Changes to .github/workflows/win-build.yml.
1 2 3 4 | name: Windows on: [push] jobs: msvc: | > > | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
name: Windows
on: [push]
env:
ERROR_ON_FAILURES: 1
jobs:
msvc:
runs-on: windows-2022
defaults:
run:
shell: powershell
working-directory: win
strategy:
matrix:
cfgopt:
|
| ︙ | ︙ | |||
36 37 38 39 40 41 42 |
}
- name: Run Tests ${{ matrix.cfgopt }}
run: |
&nmake -f makefile.vc ${{ matrix.cfgopt }} test
if ($lastexitcode -ne 0) {
throw "nmake exit code: $lastexitcode"
}
| < < < | | > > > > > < < < < | 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 |
}
- name: Run Tests ${{ matrix.cfgopt }}
run: |
&nmake -f makefile.vc ${{ matrix.cfgopt }} test
if ($lastexitcode -ne 0) {
throw "nmake exit code: $lastexitcode"
}
gcc:
runs-on: windows-2022
defaults:
run:
shell: msys2 {0}
working-directory: win
strategy:
matrix:
cfgopt:
- ""
- "CFLAGS=-DTCL_UTF_MAX=4"
- "CFLAGS=-DTCL_NO_DEPRECATED=1"
- "--disable-shared"
- "--enable-symbols"
- "--enable-symbols=mem"
# Using powershell means we need to explicitly stop on failure
steps:
- name: Install MSYS2
uses: msys2/setup-msys2@v2
with:
msystem: MINGW64
install: git mingw-w64-x86_64-toolchain make
- name: Checkout
uses: actions/checkout@v2
- name: Prepare
run: |
touch tclStubInit.c tclOOStubInit.c tclOOScript.h
mkdir "${HOME}/install dir"
working-directory: generic
- name: Configure ${{ matrix.cfgopt }}
run: |
./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
env:
CFGOPT: --enable-64bit ${{ matrix.cfgopt }}
- name: Build
run: make all
- name: Build Test Harness
run: make tcltest
- name: Run Tests
run: make test
# If you add builds with Wine, be sure to define the environment variable
# CI_USING_WINE when running them so that broken tests know not to run.
|
Changes to ChangeLog.
| ︙ | ︙ | |||
8092 8093 8094 8095 8096 8097 8098 | * tests/fileName.test: was computing the wrong results for both [file dirname] and [file tail] on "path" arguments with the PATHFLAGS != 0 intrep and with an empty string for the "joined-on" part. 2009-03-25 Jan Nijtmans <nijtmans@users.sf.net> * doc/tclsh.1: Bring doc and tools in line with | | | 8092 8093 8094 8095 8096 8097 8098 8099 8100 8101 8102 8103 8104 8105 8106 | * tests/fileName.test: was computing the wrong results for both [file dirname] and [file tail] on "path" arguments with the PATHFLAGS != 0 intrep and with an empty string for the "joined-on" part. 2009-03-25 Jan Nijtmans <nijtmans@users.sf.net> * doc/tclsh.1: Bring doc and tools in line with * tools/installData.tcl: https://wiki.tcl-lang.org/page/exec+magic * tools/str2c * tools/tcltk-man2html.tcl 2009-03-25 Donal K. Fellows <dkf@users.sf.net> * doc/coroutine.n: [Bug 2152285]: Added basic documentation for the coroutine and yield commands. |
| ︙ | ︙ |
Changes to ChangeLog.2004.
| ︙ | ︙ | |||
341 342 343 344 345 346 347 | * tests/encoding.test: Tcl(Get|Set)EncodingSearchPath. Updated tests. 2004-11-30 Kevin B. Kenny <kennykb@acm.org> * library/clock.tcl: Corrected the regular expressions that match a time zone to allow for time zones specified as +HH or -HH. * tests/clock.test: Added regression test case for the above issue. | | | 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 | * tests/encoding.test: Tcl(Get|Set)EncodingSearchPath. Updated tests. 2004-11-30 Kevin B. Kenny <kennykb@acm.org> * library/clock.tcl: Corrected the regular expressions that match a time zone to allow for time zones specified as +HH or -HH. * tests/clock.test: Added regression test case for the above issue. Thanks to Rolf Ade for reporting this issue [https://wiki.tcl-lang.org/page/Parsing+ISO8601+dates+and+times] * win/tclWinDde.c (Tcl_DdeObjCmd): Corrected a typo that caused a compilation failure on VC++. 2004-11-29 Andreas Kupries <andreask@activestate.com> * win/Makefile.in (install-libraries): Brought entry '2004-10-26 Don Porter (Tcl Modules)' into the windows world, actually the |
| ︙ | ︙ |
Changes to ChangeLog.2007.
| ︙ | ︙ | |||
5258 5259 5260 5261 5262 5263 5264 | * tests/scan.test: decimal formatted integers. Fixed to match. 2006-04-19 Kevin B. Kenny <kennykb@acm.org> * generic/tclStrToD.c: Added code to support the "middle endian" floating point format used in the Nokia N770's software-based floating point. Thanks to Bruce Johnson for reporting this bug, originally on | | | 5258 5259 5260 5261 5262 5263 5264 5265 5266 5267 5268 5269 5270 5271 5272 | * tests/scan.test: decimal formatted integers. Fixed to match. 2006-04-19 Kevin B. Kenny <kennykb@acm.org> * generic/tclStrToD.c: Added code to support the "middle endian" floating point format used in the Nokia N770's software-based floating point. Thanks to Bruce Johnson for reporting this bug, originally on https://wiki.tcl-lang.org/page/Nokia+770. * library/clock.tcl: Fixed a bug with Daylight Saving Time and Posix time zone specifiers reported by Martin Lemburg in http://groups.google.com/group/comp.lang.tcl/browse_thread/thread/9a8b15a4dfc0b7a0 (and not at SourceForge). * tests/clock.test: Added test case for the above bug. 2006-04-18 Donal K. Fellows <dkf@users.sf.net> |
| ︙ | ︙ |
Changes to README.md.
1 2 | # README: Tcl | | | 1 2 3 4 5 6 7 8 9 10 | # README: Tcl This is the **Tcl 8.7a6** source distribution. You can get any source release of Tcl from [our distribution site](https://sourceforge.net/projects/tcl/files/Tcl/). [](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux%22+branch%3Acore-8-branch) [](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows%22+branch%3Acore-8-branch) [](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS%22+branch%3Acore-8-branch) |
| ︙ | ︙ | |||
41 42 43 44 45 46 47 | anything you like with it, such as modifying it, redistributing it, and selling it either in whole or in part. See the file `license.terms` for complete information. ## <a id="doc">2.</a> Documentation Extensive documentation is available on our website. The home page for this release, including new features, is | | | 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 | anything you like with it, such as modifying it, redistributing it, and selling it either in whole or in part. See the file `license.terms` for complete information. ## <a id="doc">2.</a> Documentation Extensive documentation is available on our website. The home page for this release, including new features, is [here](https://www.tcl-lang.org/software/tcltk/8.7.html). Detailed release notes can be found at the [file distributions page](https://sourceforge.net/projects/tcl/files/Tcl/) by clicking on the relevant version. Information about Tcl itself can be found at the [Developer Xchange](https://www.tcl-lang.org/about/). There have been many Tcl books on the market. Many are mentioned in |
| ︙ | ︙ | |||
92 93 94 95 96 97 98 | ## <a id="devtools">4.</a> Development tools ActiveState produces a high-quality set of commercial quality development tools that is available to accelerate your Tcl application development. Tcl Dev Kit builds on the earlier TclPro toolset and provides a debugger, static code checker, single-file wrapping utility, bytecode compiler, and more. More information can be found at | | | 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 | ## <a id="devtools">4.</a> Development tools ActiveState produces a high-quality set of commercial quality development tools that is available to accelerate your Tcl application development. Tcl Dev Kit builds on the earlier TclPro toolset and provides a debugger, static code checker, single-file wrapping utility, bytecode compiler, and more. More information can be found at https://www.activestate.com/products/tcl/ ## <a id="complangtcl">5.</a> Tcl newsgroup There is a USENET newsgroup, "`comp.lang.tcl`", intended for the exchange of information about Tcl, Tk, and related applications. The newsgroup is a great place to ask general information questions. For bug reports, please see the "Support and bug fixes" section below. |
| ︙ | ︙ |
Changes to changes.
| ︙ | ︙ | |||
8839 8840 8841 8842 8843 8844 8845 | 2017-06-23 (TIP 472) Support 0d as prefix of decimal numbers (iyer,griffin) 2017-08-31 (bug)[2a9465] http state 100 continue handling broken (oehlmann) 2017-09-02 (bug)[0e4d88] replace command, delete trace kills namespace (porter) | | | 8839 8840 8841 8842 8843 8844 8845 8846 8847 8848 8849 8850 8851 8852 8853 | 2017-06-23 (TIP 472) Support 0d as prefix of decimal numbers (iyer,griffin) 2017-08-31 (bug)[2a9465] http state 100 continue handling broken (oehlmann) 2017-09-02 (bug)[0e4d88] replace command, delete trace kills namespace (porter) --- Released 8.7a1, September 8, 2017 --- https://core.tcl-lang.org/tcl/ for details 2017-08-10 [array names -regexp] supports backrefs (goth) 2017-08-10 Fix gcc build failures due to #pragma placement (cassoff,fellows) 2017-08-29 (bug)[b50fb2] exec redir append stdout and stderr to file (coulter) |
| ︙ | ︙ | |||
8938 8939 8940 8941 8942 8943 8944 | 2018-10-29 Update tcltest package for Travis support (fellows) => tcltest 2.5.0 2018-11-09 (bug)[35a8f1] overlong string length of some lists (owens) 2018-11-16 (bug)[00d04c] Repair [binary encode base64] (sebres) | | | 8938 8939 8940 8941 8942 8943 8944 8945 8946 8947 8948 8949 8950 8951 8952 |
2018-10-29 Update tcltest package for Travis support (fellows)
=> tcltest 2.5.0
2018-11-09 (bug)[35a8f1] overlong string length of some lists (owens)
2018-11-16 (bug)[00d04c] Repair [binary encode base64] (sebres)
- Released 8.6.9, November 16, 2018 - details at https://core.tcl-lang.org/tcl/ -
2018-11-22 (bug)[7a9dc5] [file normalize ~/~foo] segfault (sebres)
2018-12-30 (bug)[3cf3a9] variable 'timezone' deprecated in vc2017 (nijtmans)
2019-01-09 (bug)[cc1e91] [list [list {*}[set a " "]]] regression (sebres)
|
| ︙ | ︙ | |||
8986 8987 8988 8989 8990 8991 8992 | 2019-10-25 OSX: system Tcl deprecated. End default use of its packages. (walzer) 2019-10-28 (bug)[bcd100] bad fs cache when system encoding changes (coulter) 2019-11-15 (bug)[135804] segfault in [next] after destroy (coulter,sebres) | < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | 8986 8987 8988 8989 8990 8991 8992 8993 8994 8995 8996 8997 8998 8999 9000 9001 9002 9003 | 2019-10-25 OSX: system Tcl deprecated. End default use of its packages. (walzer) 2019-10-28 (bug)[bcd100] bad fs cache when system encoding changes (coulter) 2019-11-15 (bug)[135804] segfault in [next] after destroy (coulter,sebres) 2019-11-18 (bug)[13657a] application/json us text, not binary (noe,nijtmans) => http 2.9.1 - Released 8.6.10, Nov 21, 2019 - details at https://core.tcl-lang.org/tcl/ - Changes to 8.7a3 include all changes to the 8.6 line through 8.6.10, plus the following, which focuses on the high-level feature changes in this changeset (new minor version) rather than bug fixes: 2017-11-01 (bug)[3c32a3] crash deleting class mixed into instance (coulter) |
| ︙ | ︙ | |||
9224 9225 9226 9227 9228 9229 9230 9231 9232 9233 9234 9235 9236 9237 9238 9239 9240 9241 9242 9243 9244 9245 9246 9247 9248 9249 9250 | 2019-04-14 [TIP 367] [lremove] 2019-04-14 [TIP 504] [string insert] 2019-04-16 [TIP 342] [dict getwithdefault] 2019-05-25 [TIP 431] [file tempdir] 2019-05-25 [TIP 383] [coroinject], [coroprobe] 2019-05-31 [TIP 544] Tcl_GetIntForIndex() 2019-06-12 Replace TclOffset() with offsetof() 2019-06-15 [TIP 461] string compare operators for [expr] 2019-06-16 [TIP 521] floating point classification functions for [expr] 2019-06-20 (bug)[6bdadf] crash multi-arg traced [lappend] (fellows) 2019-06-28 [TIP 547] New encodings utf-16, ucs-2 2019-09-14 [TIP 414] Tcl_InitSubsystems() 2019-09-14 [TIP 548] wchar_t conversion functions | > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 9098 9099 9100 9101 9102 9103 9104 9105 9106 9107 9108 9109 9110 9111 9112 9113 9114 9115 9116 9117 9118 9119 9120 9121 9122 9123 9124 9125 9126 9127 9128 9129 9130 9131 9132 9133 9134 9135 9136 9137 9138 9139 9140 9141 9142 9143 9144 9145 9146 9147 9148 9149 9150 9151 9152 9153 9154 9155 9156 9157 9158 9159 9160 9161 9162 9163 9164 9165 9166 9167 9168 9169 9170 9171 9172 9173 9174 9175 9176 9177 9178 9179 9180 9181 9182 9183 9184 9185 9186 9187 9188 9189 9190 9191 9192 9193 9194 9195 9196 9197 9198 9199 9200 9201 9202 9203 9204 9205 9206 9207 9208 9209 9210 9211 9212 9213 9214 9215 9216 9217 9218 9219 9220 9221 9222 9223 9224 9225 9226 9227 9228 9229 9230 9231 9232 9233 9234 9235 9236 9237 9238 9239 9240 9241 9242 9243 9244 9245 9246 9247 9248 9249 9250 9251 9252 9253 9254 9255 9256 9257 9258 9259 9260 9261 9262 9263 9264 9265 9266 9267 9268 9269 9270 9271 9272 9273 9274 9275 9276 9277 9278 9279 9280 9281 9282 9283 9284 9285 9286 9287 9288 9289 9290 9291 9292 9293 9294 9295 9296 9297 9298 9299 9300 9301 9302 9303 9304 9305 9306 9307 9308 9309 9310 9311 9312 9313 9314 9315 9316 9317 9318 9319 9320 9321 9322 9323 9324 9325 9326 9327 9328 9329 9330 9331 9332 9333 9334 9335 9336 9337 9338 9339 9340 9341 9342 9343 9344 9345 9346 9347 9348 9349 9350 9351 9352 9353 9354 9355 9356 9357 9358 9359 9360 9361 9362 9363 9364 9365 9366 9367 9368 9369 9370 9371 9372 9373 9374 9375 9376 9377 |
2019-04-14 [TIP 367] [lremove]
2019-04-14 [TIP 504] [string insert]
2019-04-16 [TIP 342] [dict getwithdefault]
2019-04-23 (bug)[67a5ea] make [chan postevent] asynchronous
*** POTENTIAL INCOMPATIBILITY ***
2019-05-25 [TIP 431] [file tempdir]
2019-05-25 [TIP 383] [coroinject], [coroprobe]
2019-05-31 [TIP 544] Tcl_GetIntForIndex()
2019-06-12 Replace TclOffset() with offsetof()
2019-06-15 [TIP 461] string compare operators for [expr]
2019-06-16 [TIP 521] floating point classification functions for [expr]
2019-06-20 (bug)[6bdadf] crash multi-arg traced [lappend] (fellows)
2019-06-28 [TIP 547] New encodings utf-16, ucs-2
2019-09-14 [TIP 414] Tcl_InitSubsystems()
2019-09-14 [TIP 548] wchar_t conversion functions
- Released 8.7a3, Nov 21, 2019 --- https://core.tcl-lang.org/tcl/ for details -
2019-12-03 (bug)[3cd9be] Corner case in surrogate handling (nijtmans)
2019-12-09 (new) Add tcltest::(Setup|Eval|Cleanup|)Test (coulter,sebres)
=> tcltest 2.5.2
2019-12-12 (new) Add 3 libtommath functions to stub table (nijtmans)
2019-12-23 (bug)[ce3b9f] compilation errors with clang, windows msys2 (nijtmans)
2019-12-27 (bug)[1de6b0] [expr 1e2147483648] => 0.0 (kbk)
2020-01-04 (bug)[912886] tis-620 encoding fails to load (coulter)
2020-01-13 (bug)[0b9332] Win: support system encoding init to utf-8 (jedlička)
2020-01-17 (bug)[8cd2fe] [unload] corrupted list of loaded packages (berc)
2020-01-17 (bug)[5d989f] segfault in lsort for large list length (sebres)
2020-01-30 (bug) Reset WSAGetLastError()/errno in channel close (nijtmans)
2020-02-17 (bug) Win: avoid create of legacy error-vars on init phase (sebres)
2020-02-25 (bug) release refs when setting class's superclasses fails (dkf)
2020-02-26 (bug) C++ compiler compatibility for registry and dde (nijtmans)
=> registry 1.3.5
=> dde 1.4.3
2020-03-05 (new) Update to Unicode-13 (nijtmans)
2020-03-16 (bug)[8f89e2] Win: env var encoding, env-2.5 (sebres, nijtmans)
2020-03-27 (bug)[767e07] Tcl_Get(Range|UniChar) validate index inputs (nijtmans)
2020-03-28 (bug)[8edfce] [binary encode base64] & multi-byte wrapchars (dgp)
2020-03-28 (bug)[ffeb20] [binary decode base64] ignore invalid chars (dgp)
See RFC 2045
*** POTENTIAL INCOMPATIBILITY ***
2020-03-31 (bug)[b8e82d] some -maxlen values break uuencode round trip (dgp)
*** POTENTIAL INCOMPATIBILITY ***
2020-04-01 (bug)[f58371] Fileevent run in proper thread (bron,sebres)
2020-04-13 (bug)[afa4b2] TclNeedSpace bug; tests util-8.5 .. util-8.11 (dgp)
2020-04-13 (bug)[085913] Tcl_DStringAppendElement # quoting precision (dgp)
*** POTENTIAL INCOMPATIBILITY ***
2020-04-13 (bug)[a7f685] test util-5.52 (dgp)
2020-04-13 (bug)[c61818] Tcl_UtfPrev regression (dgp)
2020-04-15 (bug)[8af92d] zlib transform issue, bad inflate (sebres)
2020-04-16 (bug)[5e6346] Tcl_UtfPrev handling of overlong sequences (dgp)
2020-04-27 (bug)[45ca23] [string tolower] inconsistency (dgp)
2020-04-30 (bug)[da2352] init [info hostname] with DNS, not NetBIOS (nadkarni)
2020-05-11 (bug)[d402ff] Win32 potential crash when using main() (werner)
2020-05-13 (bug)[81242a] revised documentation for Tcl_UtfAtIndex() (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2020-05-13 (bug)[ed2980] Tcl_UtfToUniChar reads > TCL_UTF_MAX bytes (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2020-06-02 (bug) prevent segfault in parser (sebres)
2020-06-21 (bug)[f81bec] http POST a binary file (alakendu,nash)
=> http 2.9.2
2020-06-23 (bug)[41c985] auto_path nonsense in Safe Base (nash)
2020-06-24 (bug)[f70ce1] zlib multi-stream inflate acts only on first (sebres)
2020-07-09 (bug)[a1bd37] [clock scan] new ISO format (clock-34.(19-24)) (sebres)
*** POTENTIAL INCOMPATIBILITY ***
2020-07-10 (bug)[501974] [clock scan] +time zone (clock-34.(53-68)) (sebres)
*** POTENTIAL INCOMPATIBILITY ***
2020-07-15 (bug)[3c6e47] compiled [lappend] performance, avoid copy (sebres)
2020-07-16 (bug)[5bbd04] Fix index underflow (schwab)
2020-07-27 (bug)[cb0373] http::geturl -keepalive fixes (nash)
=> http 2.9.3
2020-08-10 (bug)[29e884] cmd resolution cycle (namespace-57.0) (coulter,sebres)
2020-08-12 (bug)[e87000] Tcl_BadChannelOption tolerate NULL (werner,nijtmans)
2020-08-31 (TIP #581) disfavor Master/Slave terminology (nijtmans)
=> opt 0.4.8
2020-09-11 (bug)[3bc0f4] UBSan complains about body.chars[] usage (nijtmans)
2020-09-17 (bug)[835c93] Support TIP 525 exit code for -singleproc 1 (nijtmans)
=> tcltest 2.5.3
2020-09-25 (new) force -eofchar \032 when evaluating library scripts (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2020-09-29 (bug)[0063cb] http::geturl -headers must be dict (oehlmann,nijtmans)
2020-10-19 (bug)[cb4582] Update install-sh script (stu,nijtmans)
2020-10-22 (bug)[c97593] Usage of gnu_printf in latest mingw-w64 (nijtmans)
2020-10-26 (new)[48898a] improve error message consistency (stu)
*** POTENTIAL INCOMPATIBILITY ***
2020-11-06 (new) revised case of module names (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2020-12-10 (bug)[ed5be7] Win: recognize "comx:" as serial port (oehlmann)
2020-12-11 (new) support for msys2, Big Sur (nijtmans)
=> platform 1.0.15
2020-12-23 tzdata updated to Olson's tzdata2020e (jima)
- Released 8.6.11, Dec 31, 2020 - details at https://core.tcl-lang.org/tcl/ -
Changes to 8.7a5 include all changes to the 8.6 line through 8.6.11,
plus the following, which focuses on the high-level feature changes
in this changeset (new minor version) rather than bug fixes:
2019-12-13 [TIP 538] Externalize libtommath
2020-01-20 [TIP 542] Support for switchable Full Unicode support
2020-01-21 [TIP 543] Eliminate `TCL_INTERP_DESTROYED` flag value
2020-01-24 [TIP 559] Eliminate public routine `Tcl_FreeResult
2020-01-31 (new) Implement 64-bit seek on Zip channels. (nijtmans)
2020-02-28 [TIP 557] C++ support for Tcl
2020-02-28 [TIP 562] Deprecate channel types 1-4
2020-03-11 (bug)[234d6c] Segfault in [set l {}; lpop l] (sebres)
2020-03-12 (bug) Crash in tests binary-79.[12] (porter)
2020-03-13 [TIP 569] Eliminate Comments That Serve Lint
2020-04-06 (bug)[dd010c] [string trim*] on astral characters (porter,nijtmans)
2020-05-30 [TIP 551] Permit underscore in numerical literals in source code
2020-07-03 [TIP 578] Death to TCL_DBGX
2020-08-11 (bug)[e87000] Win32 crash in [fconfigure stdout] (werner,nijtmans)
2020-09-06 (bug)[c1a376] deletion trace on imported ensemble (coulter)
2020-09-13 [TIP 585] Promote the INDEX_TEMP_TABLE flag of Tcl_GetIndexFromObj*() to the public interface
2020-09-15 (bug)[b5777d] crash in [string index abcd 0-0x10000000000000000]
2020-09-19 [b9ecf3] revised stork mgmt [uplevel [list $cmd ...]] (coulter)
2020-10-23 [TIP 587] Default utf-8 for source command
2020-10-27 (bug)[11229b] test string-31.26.* (porter)
2020-11-08 [TIP 582] Comments in Expressions
2020-11-16 [TIP 586] C String Parsing Support for binary scan
2020-12-07 [TIP 590] Recommend lowercase Package Names
2021-01-06 Bump to tcltest 2.5.4
2021-01-15 [TIP 481] `Tcl_GetStringFromObj()` with `size_t` length parameter
2021-01-15 [TIP 592] End support: Windows XP, Server 2003, Vista, Server 2008
2021-01-25 tzdata updated to Olson's tzdata2021a (nijtmans)
2021-01-29 (bug)[113be1] zipfs on mac
2021-03-15 [TIP 575] Switchable Tcl_UtfCharComplete()/Tcl_UtfNext()/Tcl_UtfPrev()
2021-03-19 (new)[0221b9] Drop TCL_WINDOW_EVENTS from Tcl's [update idletasks]
2021-03-30 (new)[4b4830] [chan truncate] for reflected channels
2021-04-30 [TIP 597] "string is unicode" and better utf-8/utf-16/cesu-8 encodings
2021-04-09 [TIP 598] export TclWinConvertError
2021-05-15 (bug)[463b7a] segfault from Tcl_Unload (coulter)
2021-05-15 (bug)[fb2a41] tclZipfs.c free all memory (coulter)
2021-05-18 (bug)[688fcc,28027d] namespace teardown reform (coulter)
- Released 8.7a5, Jun 18, 2021 --- https://core.tcl-lang.org/tcl/ for details -
2021-02-02 (new) support for MacOS Big Sur updates (nijtmans)
=> platform 1.0.17
2021-02-15 (bug)[d43f96] [string trim*] broken for Emoji (werner)
2021-02-16 (bug)[22324b] [string reverse] broken for Emoji (werner)
2021-02-19 (bug)[1dab71,7c64aa] BRE broken by uninitialized value use (lane)
2021-03-09 (bug)[8419c5] Unix tty channels tolerate EINTR (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2021-03-10 (bug)[4c591f] [string compare] EIAS violation (nijtmans)
2021-04-08 (new) dde package installation compatible with Tcl 9 (nijtmans)
=> dde 1.4.4
2021-04-14 (bug)[266494] [concat foo [list #]] EIAS violation (porter)
2021-05-03 (bug)[24b918] Save IO buffers from modern optimizers (rupprecht)
2021-05-06 (new) support for POSIX error EILSEQ (nijtmans)
2021-05-17 (bug)[688fcc] segfault during traced delete of alias (coulter)
2021-06-22 (bug)[bad6cc] More secure build tool. CVE-2021-35331 (nijtmans)
2021-07-17 (bug)[592a25] Win: segfault in Tcl_PutEnv() (danckaert,nijtmans)
2021-09-02 (bug)[ccc448] segfault in ensemble rewrite machinery (coulter)
2021-09-14 (new) Update to Unicode-14 (nijtmans)
2021-10-08 (bug)[a8579d] failed proc argument spec processing (russell,coulter)
2021-10-27 (new) support for MacOS Monterey (nijtmans)
=> platform 1.0.18
2021-10-27 tzdata updated to Olson's tzdata2021e (nijtmans)
- Released 8.6.12, Nov 5, 2021 - details at https://core.tcl-lang.org/tcl/ -
|
Changes to compat/zlib/contrib/masmx64/inffas8664.c.
| ︙ | ︙ |
Changes to compat/zlib/contrib/testzlib/testzlib.c.
| ︙ | ︙ |
Added compat/zlib/win64-arm/libz.dll.a.
cannot compute difference between binary files
Added compat/zlib/win64-arm/zdll.lib.
cannot compute difference between binary files
Added compat/zlib/win64-arm/zlib1.dll.
cannot compute difference between binary files
Changes to compat/zlib/win64/libz.dll.a.
cannot compute difference between binary files
Changes to compat/zlib/win64/zlib1.dll.
cannot compute difference between binary files
Changes to doc/Access.3.
| ︙ | ︙ | |||
16 17 18 19 20 21 22 | int \fBTcl_Access\fR(\fIpath\fR, \fImode\fR) .sp int \fBTcl_Stat\fR(\fIpath\fR, \fIstatPtr\fR) .SH ARGUMENTS .AS "struct stat" *statPtr out | | | 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | int \fBTcl_Access\fR(\fIpath\fR, \fImode\fR) .sp int \fBTcl_Stat\fR(\fIpath\fR, \fIstatPtr\fR) .SH ARGUMENTS .AS "struct stat" *statPtr out .AP "const char" *path in Native name of the file to check the attributes of. .AP int mode in Mask consisting of one or more of \fBR_OK\fR, \fBW_OK\fR, \fBX_OK\fR and \fBF_OK\fR. \fBR_OK\fR, \fBW_OK\fR and \fBX_OK\fR request checking whether the file exists and has read, write and execute permissions, respectively. \fBF_OK\fR just requests a check for the existence of the file. .AP "struct stat" *statPtr out |
| ︙ | ︙ |
Changes to doc/AddErrInfo.3.
| ︙ | ︙ | |||
45 46 47 48 49 50 51 | .AS Tcl_Interp commandLength .AP Tcl_Interp *interp in Interpreter in which to record information. .AP int code The code returned from script evaluation. .AP Tcl_Obj *options A dictionary of return options. | | | | 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 | .AS Tcl_Interp commandLength .AP Tcl_Interp *interp in Interpreter in which to record information. .AP int code The code returned from script evaluation. .AP Tcl_Obj *options A dictionary of return options. .AP "const char" *message in For \fBTcl_AddErrorInfo\fR, this is a conventional C string to append to the \fB\-errorinfo\fR return option. For \fBTcl_AddObjErrorInfo\fR, this points to the first byte of an array of \fIlength\fR bytes containing a string to append to the \fB\-errorinfo\fR return option. This byte array may contain embedded null bytes unless \fIlength\fR is negative. .AP Tcl_Obj *objPtr in A message to be appended to the \fB\-errorinfo\fR return option in the form of a Tcl_Obj value. .AP int length in The number of bytes to copy from \fImessage\fR when appending to the \fB\-errorinfo\fR return option. If negative, all bytes up to the first null byte are used. .AP Tcl_Obj *errorObjPtr in The \fB\-errorcode\fR return option will be set to this value. .AP "const char" *element in String to record as one element of the \fB\-errorcode\fR return option. Last \fIelement\fR argument must be NULL. .AP va_list argList in An argument list which must have been initialized using \fBva_start\fR, and cleared using \fBva_end\fR. .AP int lineNum The line number of a script where an error occurred. |
| ︙ | ︙ | |||
304 305 306 307 308 309 310 311 312 313 314 315 | If an error had occurred, the \fBTcl_ResetResult\fR call will clear the error state to make it appear as if no error had occurred after all. The global variables \fBerrorInfo\fR and \fBerrorCode\fR are not modified by \fBTcl_ResetResult\fR so they continue to hold a record of information about the most recent error seen in an interpreter. .SH "SEE ALSO" Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_Interp(3), Tcl_ResetResult(3), Tcl_SetErrno(3), errorCode(n), errorInfo(n) .SH KEYWORDS error, value, value result, stack, trace, variable | > > > > > > > > > > > > > > > > | 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 | If an error had occurred, the \fBTcl_ResetResult\fR call will clear the error state to make it appear as if no error had occurred after all. The global variables \fBerrorInfo\fR and \fBerrorCode\fR are not modified by \fBTcl_ResetResult\fR so they continue to hold a record of information about the most recent error seen in an interpreter. .SH "REFERENCE COUNT MANAGEMENT" .PP The result of \fBTcl_GetReturnOptions\fR will have at least one reference to it from the Tcl interpreter. If not using it immediately, you should use \fBTcl_IncrRefCount\fR to add your own reference. .PP The \fIoptions\fR argument to \fBTcl_SetReturnOptions\fR will have a reference added by the Tcl interpreter; it may safely be called with a zero-reference value. .PP \fBTcl_AppendObjToErrorInfo\fR only reads its \fIobjPtr\fR argument; it does not modify its reference count at all. .PP The \fIerrorObjPtr\fR argument to \fBTcl_SetObjErrorCode\fR will have a reference added by the Tcl interpreter; it may safely be called with a zero-reference value. .SH "SEE ALSO" Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_Interp(3), Tcl_ResetResult(3), Tcl_SetErrno(3), errorCode(n), errorInfo(n) .SH KEYWORDS error, value, value result, stack, trace, variable |
Changes to doc/Alloc.3.
1 2 3 4 5 6 7 8 9 10 | '\" '\" 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 7.5 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME | | > > > > > | 1 2 3 4 5 6 7 8 9 10 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 | '\" '\" 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 7.5 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_Alloc, Tcl_Free, Tcl_Realloc, Tcl_AttemptAlloc, Tcl_AttemptRealloc, Tcl_GetMemoryInfo, ckalloc, ckfree, ckrealloc, attemptckalloc, attemptckrealloc \- allocate or free heap memory .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp char * \fBTcl_Alloc\fR(\fIsize\fR) .sp void \fBTcl_Free\fR(\fIptr\fR) .sp char * \fBTcl_Realloc\fR(\fIptr, size\fR) .sp char * \fBTcl_AttemptAlloc\fR(\fIsize\fR) .sp char * \fBTcl_AttemptRealloc\fR(\fIptr, size\fR) .sp void \fBTcl_GetMemoryInfo\fR(\fIdsPtr\fR) .sp char * \fBckalloc\fR(\fIsize\fR) .sp void \fBckfree\fR(\fIptr\fR) .sp char * \fBckrealloc\fR(\fIptr, size\fR) .sp char * \fBattemptckalloc\fR(\fIsize\fR) .sp char * \fBattemptckrealloc\fR(\fIptr, size\fR) .SH ARGUMENTS .AS char *size .AP "unsigned int" size in Size in bytes of the memory block to allocate. .AP char *ptr in Pointer to memory block to free or realloc. .AP Tcl_DString *dsPtr in Initialized DString pointer. .BE .SH DESCRIPTION .PP These procedures provide a platform and compiler independent interface for memory allocation. Programs that need to transfer ownership of memory blocks between Tcl and other modules should use these routines |
| ︙ | ︙ | |||
84 85 86 87 88 89 90 91 92 | as macros. Normally, they are synonyms for the corresponding procedures documented on this page. When Tcl and all modules calling Tcl are compiled with \fBTCL_MEM_DEBUG\fR defined, however, these macros are redefined to be special debugging versions of these procedures. To support Tcl's memory debugging within a module, use the macros rather than direct calls to \fBTcl_Alloc\fR, etc. .SH KEYWORDS alloc, allocation, free, malloc, memory, realloc, TCL_MEM_DEBUG | > > > > | 89 90 91 92 93 94 95 96 97 98 99 100 101 | as macros. Normally, they are synonyms for the corresponding procedures documented on this page. When Tcl and all modules calling Tcl are compiled with \fBTCL_MEM_DEBUG\fR defined, however, these macros are redefined to be special debugging versions of these procedures. To support Tcl's memory debugging within a module, use the macros rather than direct calls to \fBTcl_Alloc\fR, etc. \fBTcl_GetMemoryInfo\fR appends a list-of-lists of memory stats to the provided DString. This function cannot be used in stub-enabled extensions, and it is only available if Tcl is compiled with the threaded memory allocator. .SH KEYWORDS alloc, allocation, free, malloc, memory, realloc, TCL_MEM_DEBUG |
Changes to doc/Async.3.
1 2 3 4 5 6 7 8 9 10 11 | '\" '\" 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_AsyncCreate 3 7.0 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME | | > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 | '\" '\" Copyright (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_AsyncCreate 3 7.0 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_AsyncCreate, Tcl_AsyncMark, Tcl_AsyncMarkFromSignal, Tcl_AsyncInvoke, Tcl_AsyncDelete, Tcl_AsyncReady \- handle asynchronous events .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp Tcl_AsyncHandler \fBTcl_AsyncCreate\fR(\fIproc, clientData\fR) .sp void \fBTcl_AsyncMark\fR(\fIasync\fR) .sp int \fBTcl_AsyncMarkFromSignal\fR(\fIasync\fR, \fIsigNumber\fR) .sp int \fBTcl_AsyncInvoke\fR(\fIinterp, code\fR) .sp void \fBTcl_AsyncDelete\fR(\fIasync\fR) .sp int \fBTcl_AsyncReady\fR() .SH ARGUMENTS .AS Tcl_AsyncHandler clientData .AP Tcl_AsyncProc *proc in Procedure to invoke to handle an asynchronous event. .AP ClientData clientData in One-word value to pass to \fIproc\fR. .AP Tcl_AsyncHandler async in Token for asynchronous event handler. .AP int sigNumber in POSIX signal number, when used in a signal context. .AP Tcl_Interp *interp in Tcl interpreter in which command was being evaluated when handler was invoked, or NULL if handler was invoked when there was no interpreter active. .AP int code in Completion code from command that just completed in \fIinterp\fR, or 0 if \fIinterp\fR is NULL. |
| ︙ | ︙ | |||
56 57 58 59 60 61 62 | allocation could have been in progress when the event occurred. The only safe approach is to set a flag indicating that the event occurred, then handle the event later when the world has returned to a clean state, such as after the current Tcl command completes. .PP \fBTcl_AsyncCreate\fR, \fBTcl_AsyncDelete\fR, and \fBTcl_AsyncReady\fR are thread sensitive. They access and/or set a thread-specific data | | | | > | | | > > | > | | | | | 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 |
allocation could have been in progress when the event occurred.
The only safe approach is to set a flag indicating that the event
occurred, then handle the event later when the world has returned
to a clean state, such as after the current Tcl command completes.
.PP
\fBTcl_AsyncCreate\fR, \fBTcl_AsyncDelete\fR, and \fBTcl_AsyncReady\fR
are thread sensitive. They access and/or set a thread-specific data
structure in the event of a core built with \fI\-\-enable\-threads\fR.
The token created by \fBTcl_AsyncCreate\fR contains the needed thread
information it was called from so that calling \fBTcl_AsyncMarkFromSignal\fR
or \fBTcl_AsyncMark\fR with this token will only yield the origin
thread into the asynchronous handler.
.PP
\fBTcl_AsyncCreate\fR creates an asynchronous handler and returns
a token for it.
The asynchronous handler must be created before
any occurrences of the asynchronous event that it is intended
to handle (it is not safe to create a handler at the time of
an event).
When an asynchronous event occurs the code that detects the event
(such as a POSIX signal handler) should call \fBTcl_AsyncMarkFromSignal\fR
with the token for the handler and the POSIX signal number. The
return value of this function is true, when the handler will be
marked, false otherwise.
For non-signal contexts, \fBTcl_AsyncMark\fR serves the same purpose.
\fBTcl_AsyncMarkFromSignal\fR and \fBTcl_AsyncMark\fR will mark
the handler as ready to execute, but will not invoke the handler
immediately. Tcl will call the \fIproc\fR associated with the
handler later, when the world is in a safe state, and \fIproc\fR
can then carry out the actions associated with the asynchronous event.
\fIProc\fR should have arguments and result that match the
type \fBTcl_AsyncProc\fR:
.PP
.CS
typedef int \fBTcl_AsyncProc\fR(
ClientData \fIclientData\fR,
Tcl_Interp *\fIinterp\fR,
|
| ︙ | ︙ |
Changes to doc/Backslash.3.
| ︙ | ︙ | |||
14 15 16 17 18 19 20 | .nf \fB#include <tcl.h>\fR .sp char \fBTcl_Backslash\fR(\fIsrc, countPtr\fR) .SH ARGUMENTS .AS char *countPtr out | | | 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 | .nf \fB#include <tcl.h>\fR .sp char \fBTcl_Backslash\fR(\fIsrc, countPtr\fR) .SH ARGUMENTS .AS char *countPtr out .AP "const char" *src in Pointer to a string starting with a backslash. .AP int *countPtr out If \fIcountPtr\fR is not NULL, \fI*countPtr\fR gets filled in with number of characters in the backslash sequence, including the backslash character. .BE |
| ︙ | ︙ |
Changes to doc/BoolObj.3.
| ︙ | ︙ | |||
84 85 86 87 88 89 90 91 92 93 94 95 | For example, the value .QW 5 passed to \fBTcl_GetBooleanFromObj\fR will lead to a \fBTCL_OK\fR return (and the boolean value 1), while the same value passed to \fBTcl_GetBoolean\fR will lead to a \fBTCL_ERROR\fR return. .SH "SEE ALSO" Tcl_NewObj, Tcl_IsShared, Tcl_GetBoolean .SH KEYWORDS boolean, value | > > > > > > > > > > > > | 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 | For example, the value .QW 5 passed to \fBTcl_GetBooleanFromObj\fR will lead to a \fBTCL_OK\fR return (and the boolean value 1), while the same value passed to \fBTcl_GetBoolean\fR will lead to a \fBTCL_ERROR\fR return. .SH "REFERENCE COUNT MANAGEMENT" .PP \fBTcl_NewBooleanObj\fR always returns a zero-reference object, much like \fBTcl_NewObj\fR. .PP \fBTcl_SetBooleanObj\fR does not modify the reference count of its \fIobjPtr\fR argument, but does require that the object be unshared. .PP \fBTcl_GetBooleanFromObj\fR does not modify the reference count of its \fIobjPtr\fR argument; it only reads. Note however that this function may set the interpreter result; if that is the only place that is holding a reference to the object, it will be deleted. .SH "SEE ALSO" Tcl_NewObj, Tcl_IsShared, Tcl_GetBoolean .SH KEYWORDS boolean, value |
Changes to doc/ByteArrObj.3.
1 2 3 4 5 6 7 8 9 10 | '\" '\" 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 Tcl_ByteArrayObj 3 8.1 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME | | | | > > > > > | | | | | | | > | | < > | | | | | > | | | > > > > > | > > | > | > > > | | < | | | | > > > > | > > > > | | | > > > > | > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > | > > > > > | > > | | > > > > > > > > | | < | > > > > > > > > | | | < | > | < | > > > > > > > > > > > > > > > > > | | 1 2 3 4 5 6 7 8 9 10 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 | '\" '\" 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 Tcl_ByteArrayObj 3 8.1 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_NewByteArrayObj, Tcl_SetByteArrayObj, Tcl_GetBytesFromObj, Tcl_GetByteArrayFromObj, Tcl_SetByteArrayLength \- manipulate a Tcl value as an array of bytes .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp Tcl_Obj * \fBTcl_NewByteArrayObj\fR(\fIbytes, numBytes\fR) .sp void \fBTcl_SetByteArrayObj\fR(\fIobjPtr, bytes, numBytes\fR) .sp .VS TIP568 unsigned char * \fBTcl_GetBytesFromObj\fR(\fIinterp, objPtr, numBytesPtr\fR) .VE TIP568 .sp unsigned char * \fBTcl_GetByteArrayFromObj\fR(\fIobjPtr, numBytesPtr\fR) .sp unsigned char * \fBTcl_SetByteArrayLength\fR(\fIobjPtr, numBytes\fR) .SH ARGUMENTS .AS "const unsigned char" *numBytesPtr in/out .AP "const unsigned char" *bytes in The array of bytes used to initialize or set a byte-array value. May be NULL even if \fInumBytes\fR is non-zero. .AP int numBytes in The number of bytes in the array. It must be >= 0. .AP Tcl_Obj *objPtr in/out For \fBTcl_SetByteArrayObj\fR, this points to an unshared value to be overwritten by a byte-array value. For \fBTcl_GetBytesFromObj\fR, \fBTcl_GetByteArrayFromObj\fR and \fBTcl_SetByteArrayLength\fR, this points to the value from which to extract an array of bytes. .AP Tcl_Interp *interp in Interpreter to use for error reporting. .AP "size_t | int" *numBytesPtr out Points to space where the number of bytes in the array may be written. Caller may pass NULL when it does not need this information. .BE .SH DESCRIPTION .PP These routines are used to create, modify, store, transfer, and retrieve arbitrary binary data in Tcl values. Specifically, data that can be represented as a sequence of arbitrary byte values is supported. This includes data read from binary channels, values created by the \fBbinary\fR command, encrypted data, or other information representable as a finite byte sequence. .PP A byte is an 8-bit quantity with no inherent meaning. When the 8 bits are interpreted as an integer value, the range of possible values is (0-255). The C type best suited to store a byte is the \fBunsigned char\fR. An \fBunsigned char\fR array of size \fIN\fR stores an aribtrary binary value of size \fIN\fR bytes. We call this representation a byte-array. Here we document the routines that allow us to operate on Tcl values as byte-arrays. .PP All Tcl values must correspond to a string representation. When a byte-array value must be processed as a string, the sequence of \fIN\fR bytes is transformed into the corresponding sequence of \fIN\fR characters, where each byte value transforms to the same character codepoint value in the range (U+0000 - U+00FF). Obtaining the string representation of a byte-array value (by calling \fBTcl_GetStringFromObj\fR) produces this string in Tcl's usual Modified UTF-8 encoding. .PP \fBTcl_NewByteArrayObj\fR and \fBTcl_SetByteArrayObj\fR create a new value or overwrite an existing unshared value, respectively, to hold a byte-array value of \fInumBytes\fR bytes. When a caller passes a non-NULL value of \fIbytes\fR, it must point to memory from which \fInumBytes\fR bytes can be read. These routines allocate \fInumBytes\fR bytes of memory, copy \fInumBytes\fR bytes from \fIbytes\fR into it, and keep the result in the internal representation of the new or overwritten value. When the caller passes a NULL value of \fIbytes\fR, the data copying step is skipped, and the bytes stored in the value are undefined. A \fIbytes\fR value of NULL is useful only when the caller will arrange to write known contents into the byte-array through a pointer retrieved by a call to one of the routines explained below. \fBTcl_NewByteArrayObj\fR returns a pointer to the created value with a reference count of zero. \fBTcl_SetByteArrayObj\fR overwrites and invalidates any old contents of the unshared \fIobjPtr\fR as appropriate, and keeps its reference count (0 or 1) unchanged. The value produced by these routines has no string representation. Any memory allocation failure may cause a panic. Note that the type of the \fInumBytes\fR argument is \fBint\fR; consequently the largest byte-array value that can be produced by these routines is one holding \fBINT_MAX\fR bytes. Note also that the string representation of any Tcl value is limited to \fBINT_MAX\fR bytes, so caution should be taken with any byte-array of more than \fBINT_MAX / 2\fR bytes. .PP \fBTcl_GetBytesFromObj\fR performs the opposite function of \fBTcl_SetByteArrayObj\fR, providing access to read a byte-array from a Tcl value that was previously written into it. When \fIobjPtr\fR is a value previously produced by \fBTcl_NewByteArrayObj\fR or \fBTcl_SetByteArrayObj\fR, then \fBTcl_GetBytesFromObj\fR returns a pointer to the byte-array kept in the value's internal representation. If the caller provides a non-NULL value for \fInumBytesPtr\fR, it must point to memory where \fBTcl_GetBytesFromObj\fR can write the number of bytes in the value's internal byte-array. With both pieces of information, the caller is able to retrieve any information about the contents of that byte-array that it seeks. When \fIobjPtr\fR does not already contain an internal byte-array, \fBTcl_GetBytesFromObj\fR will try to create one from the value's string representation. Any string value that does not include any character codepoints outside the range (U+0000 - U+00FF) will successfully translate to a unique byte-array value. With the created byte-array, the routine returns as before. For any string representation which does contain a forbidden character codepoint, the conversion fails, and \fBTcl_GetBytesFromObj\fR returns NULL to signal that failure. On failure, nothing will be written to \fInumBytesPtr\fR, and if the \fIinterp\fR argument is non-NULL, then error messages and codes are left in it recording the error. .PP \fBTcl_GetByteArrayFromObj\fR performs nearly the same function as \fBTcl_GetBytesFromObj\fR. They differ only in the circumstance when a byte-array internal value must be created by transformation of a string representation, and that string representation contains a character with codepoint greater than U+00FF. Instead of failing the conversion, \fBTcl_GetByteArrayFromObj\fR will use the 8 least significant bits of each codepoint to produce a valid byte value from any character codepoint value. In any other circumstance, \fBTcl_GetByteArrayFromObj\fR performs just as \fBTcl_GetBytesFromObj\fR does. Since the conversion cannot fail, \fBTcl_GetByteArrayFromObj\fR has no need for an \fIinterp\fR argument to record any errors and the caller can assume \fBTcl_GetByteArrayFromObj\fR does not return NULL. .PP \fBTcl_GetByteArrayFromObj\fR must be used with caution. Because of the truncation on conversion, the byte-array made available to the caller cannot reliably complete a round-trip back to the original string representation. This creates opportunities for bugs due to blindness to differences in values. This routine exists in this form primarily for compatibility with codebases written for earlier releases of Tcl. It is expected this routine will incompatibly change in Tcl 9 so that it also signals failed conversions with a NULL return. .PP On success, both \fBTcl_GetBytesFromObj\fR and \fBTcl_GetByteArrayFromObj\fR return a pointer into the internal representation of a \fBTcl_Obj\fR. That pointer must not be freed by the caller, and should not be retained for use beyond the known time the internal representation of the value has not been disturbed. The pointer may be used to overwrite the byte contents of the internal representation, so long as the value is unshared and any string representation is invalidated. .PP On success, both \fBTcl_GetBytesFromObj\fR and \fBTcl_GetByteArrayFromObj\fR write the number of bytes in the byte-array value of \fIobjPtr\fR to the space pointed to by \fInumBytesPtr\fR. This space may be of type \fBsize_t\fR or of type \fBint\fR. In Tcl 8, the largest number of bytes possible is \fBINT_MAX\fR, so either type can receive the value. In codebases meant to migrate to Tcl 9, the option to write to a space of type \fBsize_t\fR may aid in the migration. .PP \fBTcl_SetByteArrayLength\fR enables a caller to change the size of a byte-array in the internal representation of an unshared \fIobjPtr\fR to become \fInumBytes\fR bytes. This is most often useful after the bytes of the internal byte-array have been directly overwritten and it has been discovered that the required size differs from the first estimate used in the allocation. \fBTcl_SetByteArrayLength\fR returns a pointer to the resized byte-array. Because resizing the byte-array changes the internal representation, \fBTcl_SetByteArrayLength\fR also invalidates any string representation in \fIobjPtr\fR. If resizing grows the byte-array, the new byte values are undefined. If \fIobjPtr\fR does not already possess an internal byte-array, one is produced in the same way that \fBTcl_GetByteArrayFromObj\fR does, with all the cautions that go along with that. .SH "REFERENCE COUNT MANAGEMENT" .PP \fBTcl_NewByteArrayObj\fR always returns a zero-reference object, much like \fBTcl_NewObj\fR. .PP \fBTcl_SetByteArrayObj\fR and \fBTcl_SetByteArrayLength\fR do not modify the reference count of their \fIobjPtr\fR arguments, but do require that the object be unshared. .PP \fBTcl_GetBytesFromObj\fR and \fBTcl_GetByteArrayFromObj\fR do not modify the reference count of \fIobjPtr\fR; they only read. .SH "SEE ALSO" Tcl_GetStringFromObj, Tcl_NewObj, Tcl_IncrRefCount, Tcl_DecrRefCount .SH KEYWORDS value, binary data, byte array, utf, unicode |
Changes to doc/Cancel.3.
| ︙ | ︙ | |||
63 64 65 66 67 68 69 70 71 72 73 74 | . This flag is only used by \fBTcl_Canceled\fR; it is ignored by other procedures. If an error is returned and this bit is set in \fIflags\fR, then an error message will be left in the interpreter's result, where it can be retrieved with \fBTcl_GetObjResult\fR or \fBTcl_GetStringResult\fR. If this flag bit is not set then no error message is left and the interpreter's result will not be modified. .SH "SEE ALSO" interp(n), Tcl_Eval(3), TIP 285 .SH KEYWORDS cancel, unwind | > > > > > > > > | 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 | . This flag is only used by \fBTcl_Canceled\fR; it is ignored by other procedures. If an error is returned and this bit is set in \fIflags\fR, then an error message will be left in the interpreter's result, where it can be retrieved with \fBTcl_GetObjResult\fR or \fBTcl_GetStringResult\fR. If this flag bit is not set then no error message is left and the interpreter's result will not be modified. .SH "REFERENCE COUNT MANAGEMENT" .PP \fBTcl_CancelEval\fR always decrements the reference count of its \fIresultObjPtr\fR argument (if that is non-NULL). It is expected to be usually called with an object with zero reference count. If the object is shared with some other location (including the Tcl evaluation stack) it should have its reference count incremented before calling this function. .SH "SEE ALSO" interp(n), Tcl_Eval(3), TIP 285 .SH KEYWORDS cancel, unwind |
Changes to doc/Class.3.
| ︙ | ︙ | |||
51 52 53 54 55 56 57 58 59 60 61 62 63 64 | .sp \fBTcl_ClassSetMetadata\fR(\fIclass, metaTypePtr, metadata\fR) .sp Tcl_ObjectMapMethodNameProc \fBTcl_ObjectGetMethodNameMapper\fR(\fIobject\fR) .sp \fBTcl_ObjectSetMethodNameMapper\fR(\fIobject\fR, \fImethodNameMapper\fR) .SH ARGUMENTS .AS ClientData metadata in/out .AP Tcl_Interp *interp in/out Interpreter providing the context for looking up or creating an object, and into whose result error messages will be written on failure. .AP Tcl_Obj *objPtr in The name of the object to look up. | > > > > > > > > | 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 | .sp \fBTcl_ClassSetMetadata\fR(\fIclass, metaTypePtr, metadata\fR) .sp Tcl_ObjectMapMethodNameProc \fBTcl_ObjectGetMethodNameMapper\fR(\fIobject\fR) .sp \fBTcl_ObjectSetMethodNameMapper\fR(\fIobject\fR, \fImethodNameMapper\fR) .sp .VS "TIP 605" Tcl_Class \fBTcl_GetClassOfObject\fR(\fIobject\fR) .sp Tcl_Obj * \fBTcl_GetObjectClassName\fR(\fIinterp\fR, \fIobject\fR) .VE "TIP 605" .SH ARGUMENTS .AS ClientData metadata in/out .AP Tcl_Interp *interp in/out Interpreter providing the context for looking up or creating an object, and into whose result error messages will be written on failure. .AP Tcl_Obj *objPtr in The name of the object to look up. |
| ︙ | ︙ | |||
110 111 112 113 114 115 116 117 118 119 120 121 122 123 | may be retrieved using the \fBTcl_GetObjectCommand\fR function, the name of the object (and hence the name of the command) with \fBTcl_GetObjectName\fR, and the namespace may be retrieved using the \fBTcl_GetObjectNamespace\fR function. Note that the Tcl_Obj reference returned by \fBTcl_GetObjectName\fR is a shared reference. You can also get whether the object has been marked for deletion with \fBTcl_ObjectDeleted\fR (it returns true if deletion of the object has begun); this can be useful during the processing of methods. .PP Instances of classes are created using \fBTcl_NewObjectInstance\fR, which creates an object from any class (and which is internally called by both the \fBcreate\fR and \fBnew\fR methods of the \fBoo::class\fR class). It takes parameters that optionally give the name of the object and namespace to create, and which describe the arguments to pass to the class's constructor (if any). The result of the function will be either a reference to the newly | > > > > > > > | 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 | may be retrieved using the \fBTcl_GetObjectCommand\fR function, the name of the object (and hence the name of the command) with \fBTcl_GetObjectName\fR, and the namespace may be retrieved using the \fBTcl_GetObjectNamespace\fR function. Note that the Tcl_Obj reference returned by \fBTcl_GetObjectName\fR is a shared reference. You can also get whether the object has been marked for deletion with \fBTcl_ObjectDeleted\fR (it returns true if deletion of the object has begun); this can be useful during the processing of methods. .VS "TIP 605" The class of an object can be retrieved with \fBTcl_GetClassOfObject\fR, and the name of the class of an object with \fBTcl_GetObjectClassName\fR; note that these two \fImay\fR return NULL during deletion of an object (this is transient, and only occurs when the object is a long way through being deleted). .VE "TIP 605" .PP Instances of classes are created using \fBTcl_NewObjectInstance\fR, which creates an object from any class (and which is internally called by both the \fBcreate\fR and \fBnew\fR methods of the \fBoo::class\fR class). It takes parameters that optionally give the name of the object and namespace to create, and which describe the arguments to pass to the class's constructor (if any). The result of the function will be either a reference to the newly |
| ︙ | ︙ | |||
237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 | currently undefined. The \fIobject\fR parameter says which object is being processed. The \fIstartClsPtr\fR parameter points to a variable that contains the first class to provide a definition in the method chain to process, or NULL if the whole chain is to be processed (the argument itself is never NULL); this variable may be updated by the callback. The \fImethodNameObj\fR parameter gives an unshared object containing the name of the method being invoked, as provided by the user; this object may be updated by the callback. .SH "SEE ALSO" Method(3), oo::class(n), oo::copy(n), oo::define(n), oo::object(n) .SH KEYWORDS class, constructor, object .\" Local variables: .\" mode: nroff .\" fill-column: 78 .\" End: | > > > > > > > > > > > > > > > > > > > > > > > | 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 | currently undefined. The \fIobject\fR parameter says which object is being processed. The \fIstartClsPtr\fR parameter points to a variable that contains the first class to provide a definition in the method chain to process, or NULL if the whole chain is to be processed (the argument itself is never NULL); this variable may be updated by the callback. The \fImethodNameObj\fR parameter gives an unshared object containing the name of the method being invoked, as provided by the user; this object may be updated by the callback. .SH "REFERENCE COUNT MANAGEMENT" .PP The \fIobjPtr\fR argument to \fBTcl_GetObjectFromObj\fR will not have its reference count manipulated, but this function may modify the interpreter result (to report any error) so interpreter results should not be fed into this without an additional reference being used. .PP The result of \fBTcl_GetObjectName\fR is a value that is owned by the object that is regenerated when this function is first called after the object is renamed. If the value is to be retained at all, the caller should increment the reference count. .PP The first \fIobjc\fR values in the \fIobjv\fR argument to \fBTcl_NewObjectInstance\fR are the arguments to pass to the constructor. They must have a reference count of at least 1, and may have their reference counts changed during the running of the constructor. Constructors may modify the interpreter result, which consequently means that interpreter results should not be used as arguments without an additional reference being taken. .PP The \fImethodNameObj\fR argument to a Tcl_ObjectMapMethodNameProc implementation will be a value with a reference count of at least 1 where at least one reference is not held by the interpreter result. It is expected that method name mappers will only read their \fImethodNameObj\fR arguments. .SH "SEE ALSO" Method(3), oo::class(n), oo::copy(n), oo::define(n), oo::object(n) .SH KEYWORDS class, constructor, object .\" Local variables: .\" mode: nroff .\" fill-column: 78 .\" End: |
Changes to doc/CrtAlias.3.
| ︙ | ︙ | |||
239 240 241 242 243 244 245 246 | message is left as the result of \fIinterp\fR. If the operation succeeds, it returns \fBTCL_OK\fR. After executing this command, attempts to use \fIcmdName\fR in any script evaluation mechanism will fail. .PP For a description of the Tcl interface to multiple interpreters, see \fIinterp(n)\fR. .SH "SEE ALSO" | > > > > > > > > | | 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 | message is left as the result of \fIinterp\fR. If the operation succeeds, it returns \fBTCL_OK\fR. After executing this command, attempts to use \fIcmdName\fR in any script evaluation mechanism will fail. .PP For a description of the Tcl interface to multiple interpreters, see \fIinterp(n)\fR. .SH "REFERENCE COUNT MANAGEMENT" .PP \fBTcl_CreateAliasObj\fR increments the reference counts of the values in its \fIobjv\fR argument. (That reference lasts the same length of time as the owning alias.) .PP \fBTcl_GetAliasObj\fR returns (via its \fIobjvPtr\fR argument) a pointer to values that it holds a reference to. .SH "SEE ALSO" interp(n) .SH KEYWORDS alias, command, exposed commands, hidden commands, interpreter, invoke, parent, child |
Changes to doc/CrtMathFnc.3.
| ︙ | ︙ | |||
152 153 154 155 156 157 158 159 160 161 162 | will not be modified. The variable pointed to by \fInumArgsPointer\fR will contain -1, and no argument types will be stored in the variable pointed to by \fIargTypesPointer\fR. .PP \fBTcl_ListMathFuncs\fR returns a Tcl value containing a list of all the math functions defined in the interpreter whose name matches \fIpattern\fR. The returned value has a reference count of zero. .SH "SEE ALSO" expr(n), info(n), Tcl_CreateObjCommand(3), Tcl_Free(3), Tcl_NewListObj(3) .SH KEYWORDS expression, mathematical function | > > > > | 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 | will not be modified. The variable pointed to by \fInumArgsPointer\fR will contain -1, and no argument types will be stored in the variable pointed to by \fIargTypesPointer\fR. .PP \fBTcl_ListMathFuncs\fR returns a Tcl value containing a list of all the math functions defined in the interpreter whose name matches \fIpattern\fR. The returned value has a reference count of zero. .SH "REFERENCE COUNT MANAGEMENT" .PP \fBTcl_ListMathFuncs\fR always returns a zero-reference object, much like \fBTcl_NewObj\fR. .SH "SEE ALSO" expr(n), info(n), Tcl_CreateObjCommand(3), Tcl_Free(3), Tcl_NewListObj(3) .SH KEYWORDS expression, mathematical function |
Changes to doc/CrtObjCmd.3.
| ︙ | ︙ | |||
50 51 52 53 54 55 56 | const char * \fBTcl_GetCommandTypeName\fR(\fItoken\fR) .VE "info cmdtype feature" .SH ARGUMENTS .AS Tcl_CmdDeleteProc *deleteProc in/out .AP Tcl_Interp *interp in Interpreter in which to create a new command or that contains a command. | | | 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 | const char * \fBTcl_GetCommandTypeName\fR(\fItoken\fR) .VE "info cmdtype feature" .SH ARGUMENTS .AS Tcl_CmdDeleteProc *deleteProc in/out .AP Tcl_Interp *interp in Interpreter in which to create a new command or that contains a command. .AP "const char" *cmdName in Name of command. .AP Tcl_ObjCmdProc *proc in Implementation of the new command: \fIproc\fR will be called whenever \fIcmdName\fR is invoked as a command. .AP ClientData clientData in Arbitrary one-word value to pass to \fIproc\fR and \fIdeleteProc\fR. .AP Tcl_CmdDeleteProc *deleteProc in |
| ︙ | ︙ | |||
319 320 321 322 323 324 325 326 327 328 329 | function, the result will be the string literal .QW \fBnative\fR . The registration of a name can be undone by registering a mapping to NULL instead. The result from \fBTcl_GetCommandTypeName\fR will be exactly that string which was registered, and not a copy; use of a compile-time constant string is \fIstrongly recommended\fR. .VE "info cmdtype feature" .SH "SEE ALSO" Tcl_CreateCommand(3), Tcl_ResetResult(3), Tcl_SetObjResult(3) .SH KEYWORDS bind, command, create, delete, namespace, value | > > > > > > > > > > > > > > > | 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 | function, the result will be the string literal .QW \fBnative\fR . The registration of a name can be undone by registering a mapping to NULL instead. The result from \fBTcl_GetCommandTypeName\fR will be exactly that string which was registered, and not a copy; use of a compile-time constant string is \fIstrongly recommended\fR. .VE "info cmdtype feature" .SH "REFERENCE COUNT MANAGEMENT" .PP When the \fIproc\fR passed to \fBTcl_CreateObjCommand\fR is called, the values in its \fIobjv\fR argument will have a reference count of at least 1, with that guaranteed reference being from the Tcl evaluation stack. You should not call \fBTcl_DecrRefCount\fR on any of those values unless you call \fBTcl_IncrRefCount\fR on them first. Also, when the \fIproc\fR is called, the interpreter result is guaranteed to be an empty string value with a reference count of 1. .PP \fBTcl_GetCommandFullName\fR does not modify the reference count of its \fIobjPtr\fR argument, but does require that the object be unshared. .PP \fBTcl_GetCommandFromObj\fR does not modify the reference count of its \fIobjPtr\fR argument; it only reads. .SH "SEE ALSO" Tcl_CreateCommand(3), Tcl_ResetResult(3), Tcl_SetObjResult(3) .SH KEYWORDS bind, command, create, delete, namespace, value |
Changes to doc/CrtTrace.3.
| ︙ | ︙ | |||
183 184 185 186 187 188 189 190 191 | compilation of Tcl commands such as \fBif\fR and \fBwhile\fR is always disabled. There is no notification when a trace created with \fBTcl_CreateTrace\fR is deleted. There is no way to be notified when the trace created by \fBTcl_CreateTrace\fR is deleted. There is no way for the \fIproc\fR associated with a call to \fBTcl_CreateTrace\fR to abort execution of \fIcommand\fR. .SH KEYWORDS command, create, delete, interpreter, trace | > > > > > > > > > | 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 | compilation of Tcl commands such as \fBif\fR and \fBwhile\fR is always disabled. There is no notification when a trace created with \fBTcl_CreateTrace\fR is deleted. There is no way to be notified when the trace created by \fBTcl_CreateTrace\fR is deleted. There is no way for the \fIproc\fR associated with a call to \fBTcl_CreateTrace\fR to abort execution of \fIcommand\fR. .SH "REFERENCE COUNT MANAGEMENT" .PP When the \fIproc\fR passed to \fBTcl_CreateObjTrace\fR is called, the values in its \fIobjv\fR argument will have a reference count of at least 1, with that guaranteed reference being from the Tcl evaluation stack. You should not call \fBTcl_DecrRefCount\fR on any of those values unless you call \fBTcl_IncrRefCount\fR on them first. .SH "SEE ALSO" trace(n) .SH KEYWORDS command, create, delete, interpreter, trace |
Changes to doc/DictObj.3.
| ︙ | ︙ | |||
186 187 188 189 190 191 192 193 194 195 196 197 198 199 | first) that acts as a path to the key/value pair to be affected. Note that there is no corresponding operation for reading a value for a path as this is easy to construct from repeated use of \fBTcl_DictObjGet\fR. With \fBTcl_DictObjPutKeyList\fR, nested dictionaries are created for non-terminal keys where they do not already exist. With \fBTcl_DictObjRemoveKeyList\fR, all non-terminal keys must exist and have dictionaries as their values. .SH EXAMPLE Using the dictionary iteration interface to search determine if there is a key that maps to itself: .PP .CS Tcl_DictSearch search; Tcl_Obj *key, *value; | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | first) that acts as a path to the key/value pair to be affected. Note that there is no corresponding operation for reading a value for a path as this is easy to construct from repeated use of \fBTcl_DictObjGet\fR. With \fBTcl_DictObjPutKeyList\fR, nested dictionaries are created for non-terminal keys where they do not already exist. With \fBTcl_DictObjRemoveKeyList\fR, all non-terminal keys must exist and have dictionaries as their values. .SH "REFERENCE COUNT MANAGEMENT" .PP \fBTcl_NewDictObj\fR always returns a zero-reference object, much like \fBTcl_NewObj\fR. .PP \fBTcl_DictObjPut\fR does not modify the reference count of its \fIdictPtr\fR argument, but does require that the object be unshared. If \fBTcl_DictObjPut\fR returns \fBTCL_ERROR\fR it does not manipulate any reference counts; but if it returns \fBTCL_OK\fR then it definitely increments the reference count of \fIvaluePtr\fR and may increment the reference count of \fIkeyPtr\fR; the latter case happens exactly when the key did not previously exist in the dictionary. Note however that this function may set the interpreter result; if that is the only place that is holding a reference to an object, it will be deleted. .PP \fBTcl_DictObjGet\fR only reads from its \fIdictPtr\fR and \fIkeyPtr\fR arguments, and does not manipulate their reference counts at all. If the \fIvaluePtrPtr\fR argument is not set to NULL (and the function doesn't return \fBTCL_ERROR\fR), it will be set to a value with a reference count of at least 1, with a reference owned by the dictionary. Note however that this function may set the interpreter result; if that is the only place that is holding a reference to an object, it will be deleted. .PP \fBTcl_DictObjRemove\fR does not modify the reference count of its \fIdictPtr\fR argument, but does require that the object be unshared. It does not manipulate the reference count of its \fIkeyPtr\fR argument at all. Note however that this function may set the interpreter result; if that is the only place that is holding a reference to an object, it will be deleted. .PP \fBTcl_DictObjSize\fR does not modify the reference count of its \fIdictPtr\fR argument; it only reads. Note however that this function may set the interpreter result; if that is the only place that is holding a reference to the dictionary object, it will be deleted. .PP \fBTcl_DictObjFirst\fR does not modify the reference count of its \fIdictPtr\fR argument; it only reads. The variables given by the \fIkeyPtrPtr\fR and \fIvaluePtrPtr\fR arguments (if not NULL) will be updated to contain references to the relevant values in the dictionary; their reference counts will be at least 1 (due to the dictionary holding a reference to them). It may also manipulate internal references; these are not exposed to user code, but require a matching \fBTcl_DictObjDone\fR call. Note however that this function may set the interpreter result; if that is the only place that is holding a reference to the dictionary object, it will be deleted. .PP Similarly for \fBTcl_DictObjNext\fR; the variables given by the \fIkeyPtrPtr\fR and \fIvaluePtrPtr\fR arguments (if not NULL) will be updated to contain references to the relevant values in the dictionary; their reference counts will be at least 1 (due to the dictionary holding a reference to them). .PP \fBTcl_DictObjDone\fR does not manipulate (user-visible) reference counts. .PP \fBTcl_DictObjPutKeyList\fR is similar to \fBTcl_DictObjPut\fR; it does not modify the reference count of its \fIdictPtr\fR argument, but does require that the object be unshared. It may increment the reference count of any value passed in the \fIkeyv\fR argument, and will increment the reference count of the \fIvaluePtr\fR argument on success. It is recommended that values passed via \fIkeyv\fR and \fIvaluePtr\fR do not have zero reference counts. Note however that this function may set the interpreter result; if that is the only place that is holding a reference to an object, it will be deleted. .PP \fBTcl_DictObjRemoveKeyList\fR is similar to \fBTcl_DictObjRemove\fR; it does not modify the reference count of its \fIdictPtr\fR argument, but does require that the object be unshared, and does not modify the reference counts of any of the values passed in the \fIkeyv\fR argument. Note however that this function may set the interpreter result; if that is the only place that is holding a reference to an object, it will be deleted. .SH EXAMPLE Using the dictionary iteration interface to search determine if there is a key that maps to itself: .PP .CS Tcl_DictSearch search; Tcl_Obj *key, *value; |
| ︙ | ︙ |
Changes to doc/DoubleObj.3.
| ︙ | ︙ | |||
54 55 56 57 58 59 60 61 62 63 64 | Tcl value \fIobjPtr\fR. If the attempt succeeds, then \fBTCL_OK\fR is returned, and the double value is written to the storage pointed to by \fIdoublePtr\fR. If the attempt fails, then \fBTCL_ERROR\fR is returned, and if \fIinterp\fR is non-NULL, an error message is left in \fIinterp\fR. The \fBTcl_ObjType\fR of \fIobjPtr\fR may be changed to make subsequent calls to \fBTcl_GetDoubleFromObj\fR more efficient. '\" TODO: add discussion of treatment of NaN value .SH "SEE ALSO" Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult .SH KEYWORDS double, double value, double type, internal representation, value, value type, string representation | > > > > > > > > > > > > | 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 | Tcl value \fIobjPtr\fR. If the attempt succeeds, then \fBTCL_OK\fR is returned, and the double value is written to the storage pointed to by \fIdoublePtr\fR. If the attempt fails, then \fBTCL_ERROR\fR is returned, and if \fIinterp\fR is non-NULL, an error message is left in \fIinterp\fR. The \fBTcl_ObjType\fR of \fIobjPtr\fR may be changed to make subsequent calls to \fBTcl_GetDoubleFromObj\fR more efficient. '\" TODO: add discussion of treatment of NaN value .SH "REFERENCE COUNT MANAGEMENT" .PP \fBTcl_NewDoubleObj\fR always returns a zero-reference object, much like \fBTcl_NewObj\fR. .PP \fBTcl_SetDoubleObj\fR does not modify the reference count of its \fIobjPtr\fR argument, but does require that the object be unshared. .PP \fBTcl_GetDoubleFromObj\fR does not modify the reference count of its \fIobjPtr\fR argument; it only reads. Note however that this function may set the interpreter result; if that is the only place that is holding a reference to the object, it will be deleted. .SH "SEE ALSO" Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult .SH KEYWORDS double, double value, double type, internal representation, value, value type, string representation |
Changes to doc/Encoding.3.
| ︙ | ︙ | |||
552 553 554 555 556 557 558 559 560 | 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. .SH KEYWORDS utf, encoding, convert | > > > > > > > > > > > | 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 | 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. .SH "REFERENCE COUNT MANAGEMENT" .PP \fBTcl_GetEncodingFromObj\fR does not modify the reference count of its \fIobjPtr\fR argument; it only reads. Note however that this function may set the interpreter result; if that is the only place that is holding a reference to the object, it will be deleted. .PP \fBTcl_GetEncodingSearchPath\fR returns an object with a reference count of at least 1. .SH "SEE ALSO" encoding(n) .SH KEYWORDS utf, encoding, convert |
Changes to doc/Ensemble.3.
| ︙ | ︙ | |||
205 206 207 208 209 210 211 212 213 214 215 | . The namespace to which the ensemble is bound; when the namespace is deleted, so too will the ensemble, and this namespace is also the namespace whose list of exported commands is used if both the mapping dictionary and the subcommand list properties are NULL. May be read using \fBTcl_GetEnsembleNamespace\fR which returns a Tcl result code (\fBTCL_OK\fR, or \fBTCL_ERROR\fR if the token does not refer to an ensemble). .SH "SEE ALSO" namespace(n), Tcl_DeleteCommandFromToken(3) .SH KEYWORDS command, ensemble | > > > > > > > > > > > > > > > > > > > > > | 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 | . The namespace to which the ensemble is bound; when the namespace is deleted, so too will the ensemble, and this namespace is also the namespace whose list of exported commands is used if both the mapping dictionary and the subcommand list properties are NULL. May be read using \fBTcl_GetEnsembleNamespace\fR which returns a Tcl result code (\fBTCL_OK\fR, or \fBTCL_ERROR\fR if the token does not refer to an ensemble). .SH "REFERENCE COUNT MANAGEMENT" .PP \fBTcl_FindEnsemble\fR does not modify the reference count of its \fIcmdNameObj\fR argument; it only reads. Note however that this function may set the interpreter result; if that is the only place that is holding a reference to the object, it will be deleted. .PP The ensemble property getters (\fBTcl_GetEnsembleMappingDict\fR, \fBTcl_GetEnsembleParameterList\fR, \fBTcl_GetEnsembleSubcommandList\fR, and \fBTcl_GetEnsembleUnknownHandler\fR) do not manipulate the reference count of the values they provide out; if those are non-NULL, they will have a reference count of at least 1. Note that these functions may set the interpreter result. .PP The ensemble property setters (\fBTcl_SetEnsembleMappingDict\fR, \fBTcl_SetEnsembleParameterList\fR, \fBTcl_SetEnsembleSubcommandList\fR, and \fBTcl_SetEnsembleUnknownHandler\fR) will increment the reference count of the new value of the property they are given if they succeed (and decrement the reference count of the old value of the property, if relevant). If the property setters return \fBTCL_ERROR\fR, the reference count of the Tcl_Obj argument is left unchanged. .SH "SEE ALSO" namespace(n), Tcl_DeleteCommandFromToken(3) .SH KEYWORDS command, ensemble |
Changes to doc/Eval.3.
| ︙ | ︙ | |||
61 62 63 64 65 66 67 | value of a single word in the command to execute. .AP int numBytes in The number of bytes in \fIscript\fR, not including any null terminating character. If \-1, then all characters up to the first null byte are used. .AP "const char" *script in Points to first byte of script to execute (null-terminated and UTF-8). | | | 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 | value of a single word in the command to execute. .AP int numBytes in The number of bytes in \fIscript\fR, not including any null terminating character. If \-1, then all characters up to the first null byte are used. .AP "const char" *script in Points to first byte of script to execute (null-terminated and UTF-8). .AP "const char" *part in String forming part of a Tcl script. .AP va_list argList in An argument list which must have been initialized using \fBva_start\fR, and cleared using \fBva_end\fR. .BE .SH DESCRIPTION |
| ︙ | ︙ | |||
203 204 205 206 207 208 209 210 211 212 | invocation for \fIinterp\fR, it converts the return code to \fBTCL_ERROR\fR and sets \fIinterp\fR's result to an error message indicating that the \fBreturn\fR, \fBbreak\fR, or \fBcontinue\fR command was invoked in an inappropriate place. This means that top-level applications should never see a return code from \fBTcl_EvalObjEx\fR other than \fBTCL_OK\fR or \fBTCL_ERROR\fR. .SH KEYWORDS execute, file, global, result, script, value | > > > > > > > > > > > > > > | 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 | invocation for \fIinterp\fR, it converts the return code to \fBTCL_ERROR\fR and sets \fIinterp\fR's result to an error message indicating that the \fBreturn\fR, \fBbreak\fR, or \fBcontinue\fR command was invoked in an inappropriate place. This means that top-level applications should never see a return code from \fBTcl_EvalObjEx\fR other than \fBTCL_OK\fR or \fBTCL_ERROR\fR. .SH "REFERENCE COUNT MANAGEMENT" .PP \fBTcl_EvalObjEx\fR and \fBTcl_GlobalEvalObj\fR both increment and decrement the reference count of their \fIobjPtr\fR argument; you must not pass them any value with a reference count of zero. They also manipulate the interpreter result; you must not count on the interpreter result to hold the reference count of any value over these calls. .PP \fBTcl_EvalObjv\fR may increment and decrement the reference count of any value passed via its \fIobjv\fR argument; you must not pass any value with a reference count of zero. This function also manipulates the interpreter result; you must not count on the interpreter result to hold the reference count of any value over this call. .SH KEYWORDS execute, file, global, result, script, value |
Changes to doc/ExprLongObj.3.
| ︙ | ︙ | |||
94 95 96 97 98 99 100 101 102 103 104 105 106 | .PP If \fBTcl_ExprObj\fR successfully evaluates the expression, it stores a pointer to the Tcl value containing the expression's value at \fI*resultPtrPtr\fR. In this case, the caller is responsible for calling \fBTcl_DecrRefCount\fR to decrement the value's reference count when it is finished with the value. .SH "SEE ALSO" Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean, Tcl_ExprString, Tcl_GetObjResult .SH KEYWORDS boolean, double, evaluate, expression, integer, value, string | > > > > > > > > > | 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 | .PP If \fBTcl_ExprObj\fR successfully evaluates the expression, it stores a pointer to the Tcl value containing the expression's value at \fI*resultPtrPtr\fR. In this case, the caller is responsible for calling \fBTcl_DecrRefCount\fR to decrement the value's reference count when it is finished with the value. .SH "REFERENCE COUNT MANAGEMENT" .PP \fBTcl_ExprLongObj\fR, \fBTcl_ExprDoubleObj\fR, \fBTcl_ExprBooleanObj\fR, and \fBTcl_ExprObj\fR all increment and decrement the reference count of their \fIobjPtr\fR arguments; you must not pass them any value with a reference count of zero. They also manipulate the interpreter result; you must not count on the interpreter result to hold the reference count of any value over these calls. .SH "SEE ALSO" Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean, Tcl_ExprString, Tcl_GetObjResult .SH KEYWORDS boolean, double, evaluate, expression, integer, value, string |
Changes to doc/FileSystem.3.
| ︙ | ︙ | |||
41 42 43 44 45 46 47 | int \fBTcl_FSCreateDirectory\fR(\fIpathPtr\fR) .sp int \fBTcl_FSDeleteFile\fR(\fIpathPtr\fR) .sp int | | | 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 | int \fBTcl_FSCreateDirectory\fR(\fIpathPtr\fR) .sp int \fBTcl_FSDeleteFile\fR(\fIpathPtr\fR) .sp int \fBTcl_FSRemoveDirectory\fR(\fIpathPtr, recursive, errorPtr\fR) .sp int \fBTcl_FSRenameFile\fR(\fIsrcPathPtr, destPathPtr\fR) .sp Tcl_Obj * \fBTcl_FSListVolumes\fR(\fIvoid\fR) .sp |
| ︙ | ︙ | |||
75 76 77 78 79 80 81 | int \fBTcl_FSLstat\fR(\fIpathPtr, statPtr\fR) .sp int \fBTcl_FSUtime\fR(\fIpathPtr, tval\fR) .sp int | | | | 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 | int \fBTcl_FSLstat\fR(\fIpathPtr, statPtr\fR) .sp int \fBTcl_FSUtime\fR(\fIpathPtr, tval\fR) .sp int \fBTcl_FSFileAttrsGet\fR(\fIinterp, index, pathPtr, objPtrRef\fR) .sp int \fBTcl_FSFileAttrsSet\fR(\fIinterp, index, pathPtr, objPtr\fR) .sp const char *const * \fBTcl_FSFileAttrStrings\fR(\fIpathPtr, objPtrRef\fR) .sp int \fBTcl_FSStat\fR(\fIpathPtr, statPtr\fR) .sp |
| ︙ | ︙ | |||
193 194 195 196 197 198 199 200 201 202 203 204 205 206 | representation, it will be converted to have one. .AP Tcl_Obj *srcPathPtr in As for \fIpathPtr\fR, but used for the source file for a copy or rename operation. .AP Tcl_Obj *destPathPtr in As for \fIpathPtr\fR, but used for the destination filename for a copy or rename operation. .AP "const char" *encodingName in The encoding of the data stored in the file identified by \fIpathPtr\fR and to be evaluated. .AP "const char" *pattern in Only files or directories matching this pattern will be returned. .AP Tcl_GlobTypeData *types in Only files or directories matching the type descriptions contained in | > > | 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 | representation, it will be converted to have one. .AP Tcl_Obj *srcPathPtr in As for \fIpathPtr\fR, but used for the source file for a copy or rename operation. .AP Tcl_Obj *destPathPtr in As for \fIpathPtr\fR, but used for the destination filename for a copy or rename operation. .AP int recursive in Whether to remove subdirectories and their contents as well. .AP "const char" *encodingName in The encoding of the data stored in the file identified by \fIpathPtr\fR and to be evaluated. .AP "const char" *pattern in Only files or directories matching this pattern will be returned. .AP Tcl_GlobTypeData *types in Only files or directories matching the type descriptions contained in |
| ︙ | ︙ | |||
220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 | The list of path elements to operate on with a \fBjoin\fR operation. .AP int elements in If non-negative, the number of elements in the \fIlistObj\fR which should be joined together. If negative, then all elements are joined. .AP Tcl_Obj **errorPtr out In the case of an error, filled with a value containing the name of the file which caused an error in the various copy/rename operations. .AP Tcl_Obj **objPtrRef out Filled with a value containing the result of the operation. .AP Tcl_Obj *resultPtr out Pre-allocated value in which to store (using \fBTcl_ListObjAppendElement\fR) the list of files or directories which are successfully matched. .AP int mode in Mask consisting of one or more of R_OK, W_OK, X_OK and F_OK. R_OK, W_OK and X_OK request checking whether the file exists and has read, write and execute permissions, respectively. F_OK just requests checking for the existence of the file. .AP Tcl_StatBuf *statPtr out The structure that contains the result of a stat or lstat operation. .AP "const char" *sym1 in Name of a procedure to look up in the file's symbol table .AP "const char" *sym2 in Name of a procedure to look up in the file's symbol table | > > > > | | | 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 | The list of path elements to operate on with a \fBjoin\fR operation. .AP int elements in If non-negative, the number of elements in the \fIlistObj\fR which should be joined together. If negative, then all elements are joined. .AP Tcl_Obj **errorPtr out In the case of an error, filled with a value containing the name of the file which caused an error in the various copy/rename operations. .AP int index in The index of the attribute in question. .AP Tcl_Obj *objPtr in The value to set in the operation. .AP Tcl_Obj **objPtrRef out Filled with a value containing the result of the operation. .AP Tcl_Obj *resultPtr out Pre-allocated value in which to store (using \fBTcl_ListObjAppendElement\fR) the list of files or directories which are successfully matched. .AP int mode in Mask consisting of one or more of R_OK, W_OK, X_OK and F_OK. R_OK, W_OK and X_OK request checking whether the file exists and has read, write and execute permissions, respectively. F_OK just requests checking for the existence of the file. .AP Tcl_StatBuf *statPtr out The structure that contains the result of a stat or lstat operation. .AP "const char" *sym1 in Name of a procedure to look up in the file's symbol table .AP "const char" *sym2 in Name of a procedure to look up in the file's symbol table .AP Tcl_LibraryInitProc **proc1Ptr out Filled with the init function for this code. .AP Tcl_LibraryInitProc **proc2Ptr out Filled with the safe-init function for this code. .AP ClientData *clientDataPtr out Filled with the clientData value to pass to this code's unload function when it is called. .AP Tcl_LoadHandle *loadHandlePtr out Filled with an abstract token representing the loaded file. .AP Tcl_FSUnloadFileProc **unloadProcPtr out |
| ︙ | ︙ | |||
1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 |
typedef int \fBTcl_FSChdirProc\fR(
Tcl_Obj *\fIpathPtr\fR);
.CE
.PP
The \fBTcl_FSChdirProc\fR changes the applications current working
directory to the value specified in \fIpathPtr\fR. The function returns
-1 on error or 0 on success.
.SH "SEE ALSO"
cd(n), file(n), filename(n), load(n), open(n), pwd(n), source(n), unload(n)
.SH KEYWORDS
stat, access, filesystem, vfs, virtual filesystem
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 |
typedef int \fBTcl_FSChdirProc\fR(
Tcl_Obj *\fIpathPtr\fR);
.CE
.PP
The \fBTcl_FSChdirProc\fR changes the applications current working
directory to the value specified in \fIpathPtr\fR. The function returns
-1 on error or 0 on success.
.SH "REFERENCE COUNT MANAGEMENT"
.SS "PUBLIC API CALLS"
.PP
For all of these functions, \fIpathPtr\fR (including the \fIsrcPathPtr\fR and
\fIdestPathPtr\fR arguments to \fBTcl_FSCopyFile\fR,
\fBTcl_FSCopyDirectory\fR, and \fBTcl_FSRenameFile\fR, the \fIfirstPtr\fR and
\fIsecondPtr\fR arguments to \fBTcl_FSEqualPaths\fR, and the \fIlinkNamePtr\fR
and \fItoPtr\fR arguments to \fBTcl_FSLink\fR) must not be a zero reference
count value; references may be retained in internal caches even for
theoretically read-only operations. These functions may also manipulate the
interpreter result (if they take and are given a non-NULL \fIinterp\fR
argument); you must not count on the interpreter result to hold the reference
count of any argument value over these calls and should manage your own
references there. However, references held by the arguments to a Tcl command
\fIare\fR suitable for reference count management purposes for the duration of
the implementation of that command.
.PP
The \fIerrorPtr\fR argument to \fBTcl_FSCopyDirectory\fR and
\fBTcl_FSRemoveDirectory\fR is, when an object is set into it at all, set to
an object with a non-zero reference count that should be passed to
\fBTcl_DecrRefCount\fR when no longer needed.
.PP
\fBTcl_FSListVolumes\fR always returns a zero-reference object, much
like \fBTcl_NewObj\fR.
.PP
\fBTcl_FSLink\fR always returns a non-zero-reference object when it is
asked to read; you must call \fBTcl_DecrRefCount\fR on the object
once you no longer need it.
.PP
\fBTcl_FSGetCwd\fR always returns a non-zero-reference object; you
must call \fBTcl_DecrRefCount\fR on the object once you no longer need
it.
.PP
\fBTcl_FSPathSeparator\fR always returns a zero-reference object, much
like \fBTcl_NewObj\fR.
.PP
\fBTcl_FSJoinPath\fR always returns a zero-reference object, much
like \fBTcl_NewObj\fR. Its \fIlistObj\fR argument can have any reference
count; it is only read by this function.
.PP
\fBTcl_FSSplitPath\fR always returns a zero-reference object, much
like \fBTcl_NewObj\fR.
.PP
\fBTcl_FSGetNormalizedPath\fR returns an object with a non-zero
reference count where Tcl is the owner. You should increment its
reference count if you want to retain it, but do not need to if you
are just using the value immediately.
.PP
\fBTcl_FSJoinToPath\fR always returns a zero-reference object, much like
\fBTcl_NewObj\fR. Its \fIbasePtr\fR argument follows the rules above for
\fIpathPtr\fR, as do the values in the \fIobjv\fR argument.
.PP
\fBTcl_FSGetTranslatedPath\fR returns a non-zero-reference object (or
NULL in the error case); you must call \fBTcl_DecrRefCount\fR on the
object once you no longer need it.
.PP
\fBTcl_FSNewNativePath\fR always returns a zero-reference object (or
NULL), much like \fBTcl_NewObj\fR.
.PP
\fBTcl_FSFileSystemInfo\fR always returns a zero-reference object (or
NULL), much like \fBTcl_NewObj\fR.
.PP
The \fIobjPtr\fR and \fIobjPtrRef\fR arguments to \fBTcl_FSFileAttrsGet\fR,
\fBTcl_FSFileAttrsSet\fR and \fBTcl_FSFileAttrStrings\fR are conventional Tcl
values; the \fIobjPtr\fR argument will be read but not retained, and the
\fIobjPtrRef\fR argument will have (on success) a zero-reference value written
into it (as with \fBTcl_NewObj\fR). \fBTcl_FSFileAttrsGet\fR and
\fBTcl_FSFileAttrsSet\fR may also manipulate the interpreter result.
.PP
The \fIresultPtr\fR argument to \fBTcl_FSMatchInDirectory\fR will not have its
reference count manipulated, but it should have a reference count of no more
than 1, and should not be the current interpreter result (as the function may
overwrite that on error).
.SS "VIRTUAL FILESYSTEM INTERFACE"
.PP
For all virtual filesystem implementation functions, any \fIpathPtr\fR
arguments should not have their reference counts manipulated. If they take an
\fIinterp\fR argument, they may set an error message in that, but must not
manipulate the \fIpathPtr\fR afterwards. Aside from that:
.TP
\fIinternalToNormalizedProc\fR
.
This should return a zero-reference count value, as if allocated with
\fBTcl_NewObj\fR.
.TP
\fInormalizePathProc\fR
.
Unlike with other API implementation functions, the \fIpathPtr\fR argument
here is guaranteed to be an unshared object that should be updated. Its
reference count should not be modified.
.TP
\fIfilesystemPathTypeProc\fR
.
The return value (if non-NULL) either has a reference count of zero or needs
to be maintained (on a per-thread basis) by the filesystem. Tcl will increment
the reference count of the value if it wishes to retain it.
.TP
\fIfilesystemSeparatorProc\fR
.
The return value should be a value with reference count of zero.
.TP
\fImatchInDirectoryProc\fR
.
The \fIresultPtr\fR argument should be assumed to hold a list that can be
appended to (i.e., that has a reference count no greater than 1). No reference
to it should be retained.
.TP
\fIlinkProc\fR
.
If \fItoPtr\fR is NULL, this should return a value with reference count 1 that
has just been allocated and passed to \fBTcl_IncrRefCount\fR. If \fItoPtr\fR
is not NULL, it should be returned on success.
.TP
\fIlistVolumesProc\fR
.
The result value should be a list (if non-NULL); it will have its reference
count decremented once (with \fBTcl_DecrRefCount\fR) by Tcl once done.
.TP
\fIfileAttrStringsProc\fR
.
If the result is NULL, the \fIobjPtrRef\fR should have a list value written to
it; that list will have its reference count both incremented (with
\fBTcl_IncrRefCount\fR) and decremented (with \fBTcl_DecrRefCount\fR).
.TP
\fIfileAttrsGetProc\fR
.
The \fIobjPtrRef\fR argument should have (on non-error return) a zero
reference count value written to it (allocated as if with \fBTcl_NewObj\fR).
.TP
\fIfileAttrsSetProc\fR
.
The \fIobjPtr\fR argument should either just be read or its reference count
incremented to retain it.
.TP
\fIremoveDirectoryProc\fR
.
If an error is being reported, the problem filename reported via
\fIerrorPtr\fR should be newly allocated (as if with \fBTcl_NewObj\fR) and
have a reference count of 1 (i.e., have been passed to
\fBTcl_IncrRefCount\fR).
.TP
\fIcopyDirectoryProc\fR
.
If an error is being reported, the problem filename reported via
\fIerrorPtr\fR should be newly allocated (as if with \fBTcl_NewObj\fR) and
have a reference count of 1 (i.e., have been passed to
\fBTcl_IncrRefCount\fR).
.TP
\fIgetCwdProc\fR
.
The result will be passed to \fBTcl_DecrRefCount\fR by the implementation of
\fBTcl_FSGetCwd\fR after it has been normalized.
.SH "SEE ALSO"
cd(n), file(n), filename(n), load(n), open(n), pwd(n), source(n), unload(n)
.SH KEYWORDS
stat, access, filesystem, vfs, virtual filesystem
|
Changes to doc/FindExec.3.
| ︙ | ︙ | |||
9 10 11 12 13 14 15 | .BS .SH NAME Tcl_FindExecutable, Tcl_GetNameOfExecutable \- identify or return the name of the binary file containing the application .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp | | > > > | 9 10 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 | .BS .SH NAME Tcl_FindExecutable, Tcl_GetNameOfExecutable \- identify or return the name of the binary file containing the application .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp const char * \fBTcl_FindExecutable\fR(\fIargv0\fR) .sp const char * \fBTcl_GetNameOfExecutable\fR() .SH ARGUMENTS .AS char *argv0 .AP char *argv0 in The first command-line argument to the program, which gives the application's name. .BE .SH DESCRIPTION .PP The \fBTcl_FindExecutable\fR procedure computes the full path name of the executable file from which the application was invoked and saves it for Tcl's internal use. The executable's path name is needed for several purposes in Tcl. For example, it is needed on some platforms in the implementation of the \fBload\fR command. It is also returned by the \fBinfo nameofexecutable\fR command. .PP The result of \fBTcl_FindExecutable\fR is the full Tcl version (e.g., \fB8.7.0+abcdef...abcdef.gcc-1002.utf16\fR). .PP On UNIX platforms this procedure is typically invoked as the very first thing in the application's main program; it must be passed \fIargv[0]\fR as its argument. It is important not to change the working directory before the invocation. \fBTcl_FindExecutable\fR uses \fIargv0\fR along with the \fBPATH\fR environment variable to find the |
| ︙ | ︙ |
Changes to doc/GetCwd.3.
| ︙ | ︙ | |||
13 14 15 16 17 18 19 | .nf \fB#include <tcl.h>\fR .sp char * \fBTcl_GetCwd\fR(\fIinterp\fR, \fIbufferPtr\fR) .sp int | | | | | 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 | .nf \fB#include <tcl.h>\fR .sp char * \fBTcl_GetCwd\fR(\fIinterp\fR, \fIbufferPtr\fR) .sp int \fBTcl_Chdir\fR(\fIdirName\fR) .SH ARGUMENTS .AS Tcl_DString *bufferPtr in/out .AP Tcl_Interp *interp in Interpreter in which to report an error, if any. .AP Tcl_DString *bufferPtr in/out This dynamic string is used to store the current working directory. At the time of the call it should be uninitialized or free. The caller must eventually call \fBTcl_DStringFree\fR to free up anything stored here. .AP "const char" *dirName in File path in UTF\-8 format. .BE .SH DESCRIPTION .PP These procedures may be used to manipulate the current working directory for the application. They provide C\-level access to the same functionality as the Tcl \fBpwd\fR command. .PP \fBTcl_GetCwd\fR returns a pointer to a string specifying the current directory, or NULL if the current directory could not be determined. If NULL is returned, an error message is left in the \fIinterp\fR's result. Storage for the result string is allocated in bufferPtr; the caller must call \fBTcl_DStringFree()\fR when the result is no longer needed. The format of the path is UTF\-8. .PP \fBTcl_Chdir\fR changes the applications current working directory to the value specified in \fIdirName\fR. The format of the passed in string must be UTF\-8. The function returns -1 on error or 0 on success. .SH KEYWORDS pwd |
Changes to doc/GetIndex.3.
| ︙ | ︙ | |||
50 51 52 53 54 55 56 | The end of the array is marked by a NULL string pointer. .AP "const char" *msg in Null-terminated string describing what is being looked up, such as \fBoption\fR. This string is included in error messages. .AP int flags in OR-ed combination of bits providing additional information for operation. The only bits that are currently defined are \fBTCL_EXACT\fR | | | | | > > > | < > > | > > > > > > | 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 | The end of the array is marked by a NULL string pointer. .AP "const char" *msg in Null-terminated string describing what is being looked up, such as \fBoption\fR. This string is included in error messages. .AP int flags in OR-ed combination of bits providing additional information for operation. The only bits that are currently defined are \fBTCL_EXACT\fR , \fBTCL_INDEX_TEMP_TABLE\fR, and \fBTCL_INDEX_NULL_OK\fR. .AP enum|char|short|int|long *indexPtr out If not (int *)NULL, the index of the string in \fItablePtr\fR that matches the value of \fIobjPtr\fR is returned here. The variable can be any integer type, signed or unsigned, char, short, long or long long. It can also be an enum. .BE .SH DESCRIPTION .PP These procedures provide an efficient way for looking up keywords, switch names, option names, and similar things where the literal value of a Tcl value must be chosen from a predefined set. \fBTcl_GetIndexFromObj\fR compares \fIobjPtr\fR against each of the strings in \fItablePtr\fR to find a match. A match occurs if \fIobjPtr\fR's string value is identical to one of the strings in \fItablePtr\fR, or if it is a non-empty unique abbreviation for exactly one of the strings in \fItablePtr\fR and the \fBTCL_EXACT\fR flag was not specified; in either case \fBTCL_OK\fR is returned. If \fIindexPtr\fR is not NULL the index of the matching entry is stored at \fI*indexPtr\fR. .PP If there is no matching entry, \fBTCL_ERROR\fR is returned and an error message is left in \fIinterp\fR's result if \fIinterp\fR is not NULL. \fIMsg\fR is included in the error message to indicate what was being looked up. For example, if \fImsg\fR is \fBoption\fR the error message will have a form like .QW "\fBbad option \N'34'firt\N'34': must be first, second, or third\fR" . .PP If the \fBTCL_INDEX_TEMP_TABLE\fR was not specified, when \fBTcl_GetIndexFromObj\fR completes successfully it modifies the internal representation of \fIobjPtr\fR to hold the address of the table and the index of the matching entry. If \fBTcl_GetIndexFromObj\fR is invoked again with the same \fIobjPtr\fR and \fItablePtr\fR arguments (e.g. during a reinvocation of a Tcl command), it returns the matching index immediately without having to redo the lookup operation. Note: \fBTcl_GetIndexFromObj\fR assumes that the entries in \fItablePtr\fR are static: they must not change between invocations. This caching mechanism can be disallowed by specifying the \fBTCL_INDEX_TEMP_TABLE\fR flag. If the \fBTCL_INDEX_NULL_OK\fR flag was specified, objPtr is allowed to be NULL or the empty string. The resulting index is -1. Otherwise, if the value of \fIobjPtr\fR is the empty string, \fBTcl_GetIndexFromObj\fR will treat it as a non-matching value and return \fBTCL_ERROR\fR. .PP \fBTcl_GetIndexFromObjStruct\fR works just like \fBTcl_GetIndexFromObj\fR, except that instead of treating \fItablePtr\fR as an array of string pointers, it treats it as a pointer to the first string in a series of strings that have \fIoffset\fR bytes between them (i.e. that there is a pointer to the first array of characters at \fItablePtr\fR, a pointer to the second array of characters at \fItablePtr\fR+\fIoffset\fR bytes, etc.) This is particularly useful when processing things like \fBTk_ConfigurationSpec\fR, whose string keys are in the same place in each of several array elements. .SH "REFERENCE COUNT MANAGEMENT" .PP \fBTcl_GetIndexFromObj\fR and \fBTcl_GetIndexFromObjStruct\fR do not modify the reference count of their \fIobjPtr\fR arguments; they only read. Note however that these functions may set the interpreter result; if that is the only place that is holding a reference to the object, it will be deleted. .SH "SEE ALSO" prefix(n), Tcl_WrongNumArgs(3) .SH KEYWORDS index, option, value, table lookup |
Changes to doc/Hash.3.
| ︙ | ︙ | |||
326 327 328 329 330 331 332 333 334 |
typedef void \fBTcl_FreeHashEntryProc\fR(
Tcl_HashEntry *\fIhPtr\fR);
.CE
.PP
If this is NULL then \fBTcl_Free\fR is used to free the space for the entry.
Tcl_Obj* keys use this function to decrement the reference count on the
value.
.SH KEYWORDS
hash table, key, lookup, search, value
| > > > > > > > > > > > > > > | 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 |
typedef void \fBTcl_FreeHashEntryProc\fR(
Tcl_HashEntry *\fIhPtr\fR);
.CE
.PP
If this is NULL then \fBTcl_Free\fR is used to free the space for the entry.
Tcl_Obj* keys use this function to decrement the reference count on the
value.
.SH "REFERENCE COUNT MANAGEMENT"
.PP
When a hash table is created with \fBTcl_InitCustomHashTable\fR, the
\fBTcl_CreateHashEntry\fR function will increment the reference count of its
\fIkey\fR argument when it creates a key (but not if there is an existing
matching key). The reference count of the key will be decremented when the
corresponding hash entry is deleted, whether with \fBTcl_DeleteHashEntry\fR or
with \fBTcl_DeleteHashTable\fR. The \fBTcl_GetHashKey\fR function will return
the key without further modifying its reference count.
.PP
Custom hash tables that use a Tcl_Obj* as key will generally need to do
something similar in their \fIallocEntryProc\fR.
.SH "SEE ALSO"
Dict(3)
.SH KEYWORDS
hash table, key, lookup, search, value
|
Changes to doc/Init.3.
1 2 3 4 | '\" '\" Copyright (c) 1998-2000 Scriptics Corporation. '\" All rights reserved. '\" | | > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 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 | '\" '\" Copyright (c) 1998-2000 Scriptics Corporation. '\" All rights reserved. '\" .TH Tcl_Init 3 8.7 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_Init \- find and source initialization script .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp int \fBTcl_Init\fR(\fIinterp\fR) .sp const char * \fBTcl_SetPreInitScript\fR(\fIscriptPtr\fR) .SH ARGUMENTS .AS Tcl_Interp *interp .AP Tcl_Interp *interp in Interpreter to initialize. .AP "const char" *scriptPtr in Address of the initialization script. .BE .SH DESCRIPTION .PP \fBTcl_Init\fR is a helper procedure that finds and \fBsource\fRs the \fBinit.tcl\fR script, which should exist somewhere on the Tcl library path. .PP \fBTcl_Init\fR is typically called from \fBTcl_AppInit\fR procedures. .PP \fBTcl_SetPreInitScript\fR registers the pre-initialization script and returns the former (now replaced) script pointer. A value of \fINULL\fR may be passed to not register any script. The pre-initialization script is executed by \fBTcl_Init\fR before accessing the file system. The purpose is to typically prepare a custom file system (like an embedded zip-file) to be activated before the search. .SH "SEE ALSO" Tcl_AppInit, Tcl_Main .SH KEYWORDS application, initialization, interpreter |
Changes to doc/InitSubSyst.3.
| ︙ | ︙ | |||
9 10 11 12 13 14 15 | .BS .SH NAME Tcl_InitSubsystems \- initialize the Tcl library. .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp | | > > > | | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | .BS .SH NAME Tcl_InitSubsystems \- initialize the Tcl library. .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp const char * \fBTcl_InitSubsystems\fR(\fIvoid\fR) .SH DESCRIPTION .PP The \fBTcl_InitSubsystems\fR procedure initializes the Tcl library. This procedure is typically invoked as the very first thing in the application's main program. .PP The result of \fBTcl_InitSubsystems\fR is the full Tcl version (e.g., \fB8.7.0+abcdef...abcdef.gcc-1002.utf16\fR). .PP \fBTcl_InitSubsystems\fR is very similar in use to \fBTcl_FindExecutable\fR. It can be used when Tcl is used as utility library, no other encodings than utf8, iso8859-1 or utf-16 are used, and no interest exists in the value of \fBinfo nameofexecutable\fR. The system encoding will not be extracted from the environment, but falls back to iso8859-1. .SH KEYWORDS binary, executable file |
Changes to doc/IntObj.3.
| ︙ | ︙ | |||
156 157 158 159 160 161 162 163 164 165 166 167 | If anything later in the caller requires \fIobjPtr\fR to continue to hold the same value, then \fBTcl_GetBignumFromObj\fR must be chosen. .PP The \fBTcl_InitBignumFromDouble\fR routine is a utility procedure that extracts the integer part of \fIdoubleValue\fR and stores that integer value in the \fBmp_int\fR value \fIbigValue\fR. .SH "SEE ALSO" Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult .SH KEYWORDS integer, integer value, integer type, internal representation, value, value type, string representation | > > > > > > > > > > > > > > > > > > > > > | 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 | If anything later in the caller requires \fIobjPtr\fR to continue to hold the same value, then \fBTcl_GetBignumFromObj\fR must be chosen. .PP The \fBTcl_InitBignumFromDouble\fR routine is a utility procedure that extracts the integer part of \fIdoubleValue\fR and stores that integer value in the \fBmp_int\fR value \fIbigValue\fR. .SH "REFERENCE COUNT MANAGEMENT" .PP \fBTcl_NewIntObj\fR, \fBTcl_NewLongObj\fR, \fBTcl_NewWideIntObj\fR, and \fBTcl_NewBignumObj\fR always return a zero-reference object, much like \fBTcl_NewObj\fR. .PP \fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, \fBTcl_SetWideIntObj\fR, and \fBTcl_SetBignumObj\fR do not modify the reference count of their \fIobjPtr\fR arguments, but do require that the object be unshared. .PP \fBTcl_GetIntFromObj\fR, \fBTcl_GetIntForIndex\fR, \fBTcl_GetLongFromObj\fR, \fBTcl_GetWideIntFromObj\fR, \fBTcl_GetBignumFromObj\fR, and \fBTcl_TakeBignumFromObj\fR do not modify the reference count of their \fIobjPtr\fR arguments; they only read. Note however that this function may set the interpreter result; if that is the only place that is holding a reference to the object, it will be deleted. Also note that if \fBTcl_TakeBignumFromObj\fR is given an unshared value, the value of that object may be modified; it is intended to be used when the value is .QW consumed by the operation at this point. .SH "SEE ALSO" Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult .SH KEYWORDS integer, integer value, integer type, internal representation, value, value type, string representation |
Changes to doc/ListObj.3.
| ︙ | ︙ | |||
24 25 26 27 28 29 30 | .sp \fBTcl_SetListObj\fR(\fIobjPtr, objc, objv\fR) .sp int \fBTcl_ListObjGetElements\fR(\fIinterp, listPtr, objcPtr, objvPtr\fR) .sp int | | | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | .sp \fBTcl_SetListObj\fR(\fIobjPtr, objc, objv\fR) .sp int \fBTcl_ListObjGetElements\fR(\fIinterp, listPtr, objcPtr, objvPtr\fR) .sp int \fBTcl_ListObjLength\fR(\fIinterp, listPtr, lengthPtr\fR) .sp int \fBTcl_ListObjIndex\fR(\fIinterp, listPtr, index, objPtrPtr\fR) .sp int \fBTcl_ListObjReplace\fR(\fIinterp, listPtr, first, count, objc, objv\fR) .SH ARGUMENTS |
| ︙ | ︙ | |||
72 73 74 75 76 77 78 | For \fBTcl_SetListObj\fR, the number of Tcl values to insert into \fIobjPtr\fR. .AP "Tcl_Obj *const" objv[] in An array of pointers to values. \fBTcl_NewListObj\fR will insert these values into a new list value and \fBTcl_ListObjReplace\fR will insert them into an existing \fIlistPtr\fR. Each value will become a separate list element. | | | 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 | For \fBTcl_SetListObj\fR, the number of Tcl values to insert into \fIobjPtr\fR. .AP "Tcl_Obj *const" objv[] in An array of pointers to values. \fBTcl_NewListObj\fR will insert these values into a new list value and \fBTcl_ListObjReplace\fR will insert them into an existing \fIlistPtr\fR. Each value will become a separate list element. .AP int *lengthPtr out Points to location where \fBTcl_ListObjLength\fR stores the length of the list. .AP int index in Index of the list element that \fBTcl_ListObjIndex\fR is to return. The first element has index 0. .AP Tcl_Obj **objPtrPtr out |
| ︙ | ︙ | |||
158 159 160 161 162 163 164 | will attempt to convert it to one; if the conversion fails, it returns \fBTCL_ERROR\fR and leaves an error message in the interpreter's result value if \fIinterp\fR is not NULL. Otherwise it returns \fBTCL_OK\fR after storing the count and array pointer. .PP \fBTcl_ListObjLength\fR returns the number of elements in the list value referenced by \fIlistPtr\fR. | | | 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 | will attempt to convert it to one; if the conversion fails, it returns \fBTCL_ERROR\fR and leaves an error message in the interpreter's result value if \fIinterp\fR is not NULL. Otherwise it returns \fBTCL_OK\fR after storing the count and array pointer. .PP \fBTcl_ListObjLength\fR returns the number of elements in the list value referenced by \fIlistPtr\fR. It returns this count by storing an integer in the address \fIlengthPtr\fR. If the value is not already a list value, \fBTcl_ListObjLength\fR will attempt to convert it to one; if the conversion fails, it returns \fBTCL_ERROR\fR and leaves an error message in the interpreter's result value if \fIinterp\fR is not NULL. Otherwise it returns \fBTCL_OK\fR after storing the list's length. .PP |
| ︙ | ︙ | |||
242 243 244 245 246 247 248 249 250 251 252 253 |
by simply calling \fBTcl_ListObjReplace\fR
with a NULL \fIobjvPtr\fR:
.PP
.CS
result = \fBTcl_ListObjReplace\fR(interp, listPtr, first, count,
0, NULL);
.CE
.SH "SEE ALSO"
Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_GetObjResult(3)
.SH KEYWORDS
append, index, insert, internal representation, length, list, list value,
list type, value, value type, replace, string representation
| > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
by simply calling \fBTcl_ListObjReplace\fR
with a NULL \fIobjvPtr\fR:
.PP
.CS
result = \fBTcl_ListObjReplace\fR(interp, listPtr, first, count,
0, NULL);
.CE
.SH "REFERENCE COUNT MANAGEMENT"
.PP
\fBTcl_NewListObj\fR always returns a zero-reference object, much like
\fBTcl_NewObj\fR. If a non-NULL \fIobjv\fR argument is given, the reference
counts of the first \fIobjc\fR values in that array are incremented.
.PP
\fBTcl_SetListObj\fR does not modify the reference count of its \fIobjPtr\fR
argument, but does require that the object be unshared. The reference counts
of the first \fIobjc\fR values in the \fIobjv\fR array are incremented.
.PP
\fBTcl_ListObjGetElements\fR, \fBTcl_ListObjIndex\fR, and
\fBTcl_ListObjLength\fR do not modify the reference count of their
\fIlistPtr\fR arguments; they only read. Note however that these three
functions may set the interpreter result; if that is the only place that is
holding a reference to the object, it will be deleted.
.PP
\fBTcl_ListObjAppendList\fR, \fBTcl_ListObjAppendElement\fR, and
\fBTcl_ListObjReplace\fR require an unshared \fIlistPtr\fR argument.
\fBTcl_ListObjAppendList\fR only reads its \fIelemListPtr\fR argument.
\fBTcl_ListObjAppendElement\fR increments the reference count of its
\fIobjPtr\fR on success. \fBTcl_ListObjReplace\fR increments the reference
count of the first \fIobjc\fR values in the \fIobjv\fR array on success. Note
however that all these three functions may set the interpreter result on
failure; if that is the only place that is holding a reference to the object,
it will be deleted.
.SH "SEE ALSO"
Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_GetObjResult(3)
.SH KEYWORDS
append, index, insert, internal representation, length, list, list value,
list type, value, value type, replace, string representation
|
Changes to doc/Load.3.
| ︙ | ︙ | |||
56 57 58 59 60 61 62 63 64 65 66 67 68 69 | The result of \fBTcl_LoadFile\fR is a standard Tcl error code. The library may be unloaded with \fBTcl_FSUnloadFile\fR. .PP \fBTcl_FindSymbol\fR locates a symbol in a loaded library and returns it. If the symbol cannot be found, it returns NULL and sets an error message in the given \fIinterp\fR (if that is non-NULL). Note that it is unsafe to use this operation on a handle that has been passed to \fBTcl_FSUnloadFile\fR. .SH "SEE ALSO" Tcl_FSLoadFile(3), Tcl_FSUnloadFile(3), load(n), unload(n) .SH KEYWORDS binary code, loading, shared library '\" Local Variables: '\" mode: nroff '\" fill-column: 78 | > > > > | 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 | The result of \fBTcl_LoadFile\fR is a standard Tcl error code. The library may be unloaded with \fBTcl_FSUnloadFile\fR. .PP \fBTcl_FindSymbol\fR locates a symbol in a loaded library and returns it. If the symbol cannot be found, it returns NULL and sets an error message in the given \fIinterp\fR (if that is non-NULL). Note that it is unsafe to use this operation on a handle that has been passed to \fBTcl_FSUnloadFile\fR. .SH "REFERENCE COUNT MANAGEMENT" .PP The reference count of the \fIpathPtr\fR argument to \fBTcl_LoadFile\fR may be incremented. As such, it should not be given a zero reference count value. .SH "SEE ALSO" Tcl_FSLoadFile(3), Tcl_FSUnloadFile(3), load(n), unload(n) .SH KEYWORDS binary code, loading, shared library '\" Local Variables: '\" mode: nroff '\" fill-column: 78 |
| ︙ | ︙ |
Changes to doc/Method.3.
| ︙ | ︙ | |||
254 255 256 257 258 259 260 261 | .PP The \fIinterp\fR argument gives a place to write an error message when the attempt to clone the object is to fail, in which case the clone procedure must also return TCL_ERROR; it should return TCL_OK otherwise. The \fIoldClientData\fR field to a Tcl_CloneProc gives the value from the method being copied from, and the \fInewClientDataPtr\fR field will point to a variable in which to write the value for the method being copied to. .SH "SEE ALSO" | > > > > > > > > > > > > > > > > > > > > > > > > | | 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 | .PP The \fIinterp\fR argument gives a place to write an error message when the attempt to clone the object is to fail, in which case the clone procedure must also return TCL_ERROR; it should return TCL_OK otherwise. The \fIoldClientData\fR field to a Tcl_CloneProc gives the value from the method being copied from, and the \fInewClientDataPtr\fR field will point to a variable in which to write the value for the method being copied to. .SH "REFERENCE COUNT MANAGEMENT" .PP The \fInameObj\fR argument to \fBTcl_NewMethod\fR and \fBTcl_NewInstanceMethod\fR (when non-NULL) will have its reference count incremented if there is no existing method with that name in that class/object. .PP The result of \fBTcl_MethodName\fR is a value with a reference count of at least one. It should not be modified without first duplicating it (with \fBTcl_DuplicateObj\fR). .PP The values in the first \fIobjc\fR values of the \fIobjv\fR argument to \fBTcl_ObjectContextInvokeNext\fR are assumed to have a reference count of at least 1; the containing array is assumed to endure until the next method implementation (see \fBnext\fR) returns. Be aware that methods may \fByield\fR; if any post-call actions are desired (e.g., decrementing the reference count of values passed in here), they must be scheduled with \fBTcl_NRAddCallback\fR. .PP The \fIcallProc\fR of the \fBTcl_MethodType\fR structure takes values of at least reference count 1 in its \fIobjv\fR argument. It may add its own references, but must not decrement the reference count below that level; the caller of the method will decrement the reference count once the method returns properly (and the reference will be held if the method \fByield\fRs). .SH "SEE ALSO" Class(3), NRE(3), oo::class(n), oo::define(n), oo::object(n) .SH KEYWORDS constructor, method, object .\" Local variables: .\" mode: nroff .\" fill-column: 78 .\" End: |
Changes to doc/NRE.3.
| ︙ | ︙ | |||
36 37 38 39 40 41 42 | void \fBTcl_NRAddCallback\fR(\fIinterp, postProcPtr, data0, data1, data2, data3\fR) .fi .SH ARGUMENTS .AS Tcl_CmdDeleteProc *interp in .AP Tcl_Interp *interp in The relevant Interpreter. | | | 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 | void \fBTcl_NRAddCallback\fR(\fIinterp, postProcPtr, data0, data1, data2, data3\fR) .fi .SH ARGUMENTS .AS Tcl_CmdDeleteProc *interp in .AP Tcl_Interp *interp in The relevant Interpreter. .AP "const char" *cmdName in Name of the command to create. .AP Tcl_ObjCmdProc *proc in Called in order to evaluate a command. Is often just a small wrapper that uses \fBTcl_NRCallObjProc\fR to call \fInreProc\fR using a new trampoline. Behaves in the same way as the \fIproc\fR argument to \fBTcl_CreateObjCommand\fR(3) (\fIq.v.\fR). .AP Tcl_ObjCmdProc *nreProc in |
| ︙ | ︙ | |||
223 224 225 226 227 228 229 230 231 232 233 234 235 236 |
return result;
}
.CE
.PP
Any function comprising a routine can push other functions, making it possible
implement looping and sequencing constructs using the function stack.
.PP
.SH "SEE ALSO"
Tcl_CreateCommand(3), Tcl_CreateObjCommand(3), Tcl_EvalObjEx(3), Tcl_GetCommandFromObj(3), Tcl_ExprObj(3)
.SH KEYWORDS
stackless, nonrecursive, execute, command, global, value, result, script
.SH COPYRIGHT
Copyright \(co 2008 Kevin B. Kenny.
Copyright \(co 2018 Nathan Coulter.
| > > > > > > > > > > > > > > > > > > > | 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 |
return result;
}
.CE
.PP
Any function comprising a routine can push other functions, making it possible
implement looping and sequencing constructs using the function stack.
.PP
.SH "REFERENCE COUNT MANAGEMENT"
.PP
The first \fIobjc\fR values in the \fIobjv\fR array passed to the functions
\fBTcl_NRCallObjProc\fR, \fBTcl_NREvalObjv\fR, and \fBTcl_NRCmdSwap\fR should
have a reference count of at least 1; they may have additional references
taken during the execution.
.PP
The \fIobjPtr\fR argument to \fBTcl_NREvalObj\fR and \fBTcl_NRExprObj\fR
should have a reference count of at least 1, and may have additional
references taken to it during execution.
.PP
The \fIresultObj\fR argument to \fBTcl_NRExprObj\fR should be an unshared
object.
.PP
Use \fBTcl_NRAddCallback\fR to schedule any required final decrementing of the
reference counts of arguments to any of the other functions on this page, as
with any other post-processing step in the non-recursive execution engine.
.PP
The
.SH "SEE ALSO"
Tcl_CreateCommand(3), Tcl_CreateObjCommand(3), Tcl_EvalObjEx(3), Tcl_GetCommandFromObj(3), Tcl_ExprObj(3)
.SH KEYWORDS
stackless, nonrecursive, execute, command, global, value, result, script
.SH COPYRIGHT
Copyright \(co 2008 Kevin B. Kenny.
Copyright \(co 2018 Nathan Coulter.
|
Changes to doc/Namespace.3.
| ︙ | ︙ | |||
42 43 44 45 46 47 48 | Tcl_Namespace * \fBTcl_FindNamespace\fR(\fIinterp, name, contextNsPtr, flags\fR) .sp Tcl_Command \fBTcl_FindCommand\fR(\fIinterp, name, contextNsPtr, flags\fR) .sp Tcl_Obj * | | | | 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 | Tcl_Namespace * \fBTcl_FindNamespace\fR(\fIinterp, name, contextNsPtr, flags\fR) .sp Tcl_Command \fBTcl_FindCommand\fR(\fIinterp, name, contextNsPtr, flags\fR) .sp Tcl_Obj * \fBTcl_GetNamespaceUnknownHandler\fR(\fIinterp, nsPtr\fR) .sp int \fBTcl_SetNamespaceUnknownHandler\fR(\fIinterp, nsPtr, handlerPtr\fR) .SH ARGUMENTS .AS Tcl_NamespaceDeleteProc allowOverwrite in/out .AP Tcl_Interp *interp in/out The interpreter in which the namespace exists and where name lookups are performed. Also where error result messages are written. .AP "const char" *name in The name of the namespace or command to be created or accessed. |
| ︙ | ︙ | |||
155 156 157 158 159 160 161 162 163 164 165 | .PP \fBTcl_GetNamespaceUnknownHandler\fR returns the unknown command handler for the namespace, or NULL if none is set. .PP \fBTcl_SetNamespaceUnknownHandler\fR sets the unknown command handler for the namespace. If \fIhandlerPtr\fR is NULL, then the handler is reset to its default. .SH "SEE ALSO" Tcl_CreateCommand(3), Tcl_ListObjAppendList(3), Tcl_SetVar(3) .SH KEYWORDS namespace, command | > > > > > > > > > > > > | 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 | .PP \fBTcl_GetNamespaceUnknownHandler\fR returns the unknown command handler for the namespace, or NULL if none is set. .PP \fBTcl_SetNamespaceUnknownHandler\fR sets the unknown command handler for the namespace. If \fIhandlerPtr\fR is NULL, then the handler is reset to its default. .SH "REFERENCE COUNT MANAGEMENT" .PP The \fIobjPtr\fR argument to \fBTcl_AppendExportList\fR should be an unshared object, as it will be modified by this function. The reference count of \fIobjPtr\fR will not be altered. .PP \fBTcl_GetNamespaceUnknownHandler\fR returns a possibly shared value. Its reference count should be incremented if the value is to be retained. .PP The \fIhandlerPtr\fR argument to \fBTcl_SetNamespaceUnknownHandler\fR will have its reference count incremented if it is a non-empty list. .SH "SEE ALSO" Tcl_CreateCommand(3), Tcl_ListObjAppendList(3), Tcl_SetVar(3) .SH KEYWORDS namespace, command |
Changes to doc/Notifier.3.
| ︙ | ︙ | |||
99 100 101 102 103 104 105 | Procedure to invoke for each queued event in \fBTcl_DeleteEvents\fR. .AP int flags in What types of events to service. These flags are the same as those passed to \fBTcl_DoOneEvent\fR. .AP int mode in Indicates whether events should be serviced by \fBTcl_ServiceAll\fR. Must be one of \fBTCL_SERVICE_NONE\fR or \fBTCL_SERVICE_ALL\fR. | | | 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 | Procedure to invoke for each queued event in \fBTcl_DeleteEvents\fR. .AP int flags in What types of events to service. These flags are the same as those passed to \fBTcl_DoOneEvent\fR. .AP int mode in Indicates whether events should be serviced by \fBTcl_ServiceAll\fR. Must be one of \fBTCL_SERVICE_NONE\fR or \fBTCL_SERVICE_ALL\fR. .AP const Tcl_NotifierProcs* notifierProcPtr in Structure of function pointers describing notifier procedures that are to replace the ones installed in the executable. See \fBREPLACING THE NOTIFIER\fR for details. .BE .SH INTRODUCTION .PP The interfaces described here are used to customize the Tcl event |
| ︙ | ︙ |
Changes to doc/Object.3.
| ︙ | ︙ | |||
279 280 281 282 283 284 285 | .SH "STORAGE MANAGEMENT OF VALUES" .PP Tcl values are allocated on the heap and are shared as much as possible to reduce storage requirements. Reference counting is used to determine when a value is no longer needed and can safely be freed. A value just created by \fBTcl_NewObj\fR or \fBTcl_NewStringObj\fR | | > > > > > | 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 | .SH "STORAGE MANAGEMENT OF VALUES" .PP Tcl values are allocated on the heap and are shared as much as possible to reduce storage requirements. Reference counting is used to determine when a value is no longer needed and can safely be freed. A value just created by \fBTcl_NewObj\fR or \fBTcl_NewStringObj\fR has \fIrefCount\fR 0, meaning that the object can often be given to a function like \fBTcl_SetObjResult\fR, \fBTcl_ListObjAppendElement\fR, or \fBTcl_DictObjPut\fR (as a value) without explicit reference management, all of which are common use cases. (The latter two require that the the target list or dictionary be well-formed, but that is often easy to arrange when the value is being initially constructed.) The macro \fBTcl_IncrRefCount\fR increments the reference count when a new reference to the value is created. The macro \fBTcl_DecrRefCount\fR decrements the count when a reference is no longer needed and, if the value's reference count drops to zero, frees its storage. A value shared by different code or data structures has \fIrefCount\fR greater than 1. |
| ︙ | ︙ |
Changes to doc/ObjectType.3.
| ︙ | ︙ | |||
244 245 246 247 248 249 250 251 252 253 254 | The \fIfreeIntRepProc\fR member can be set to NULL to indicate that the internal representation does not require freeing. The \fIfreeIntRepProc\fR implementation must not access the \fIbytes\fR member of the value, since Tcl makes its own internal uses of that field during value deletion. The defined tasks for the \fIfreeIntRepProc\fR have no need to consult the \fIbytes\fR member. .SH "SEE ALSO" Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3) .SH KEYWORDS internal representation, value, value type, string representation, type conversion | > > > > > > > > > > > > > > > > > > > > > > | 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 | The \fIfreeIntRepProc\fR member can be set to NULL to indicate that the internal representation does not require freeing. The \fIfreeIntRepProc\fR implementation must not access the \fIbytes\fR member of the value, since Tcl makes its own internal uses of that field during value deletion. The defined tasks for the \fIfreeIntRepProc\fR have no need to consult the \fIbytes\fR member. .PP 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. .SH "REFERENCE COUNT MANAGEMENT" .PP The \fIobjPtr\fR argument to \fBTcl_AppendAllObjTypes\fR should be an unshared value; this function will not modify the reference count of that value, but will modify its contents. If \fIobjPtr\fR is not (interpretable as) a list, this function will set the interpreter result and produce an error; using an unshared empty value is strongly recommended. .PP The \fIobjPtr\fR argument to \fBTcl_ConvertToType\fR can have any non-zero reference count; this function will not modify the reference count, but may write to the interpreter result on error so values that originate from there should have an additional reference made before calling this. .PP None of the callback functions in the \fBTcl_ObjType\fR structure should modify the reference count of their arguments, but if the values contain subsidiary values (e.g., the elements of a list or the keys of a dictionary) then those subsidiary values may have their reference counts modified. .SH "SEE ALSO" Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3) .SH KEYWORDS internal representation, value, value type, string representation, type conversion |
Changes to doc/OpenFileChnl.3.
| ︙ | ︙ | |||
637 638 639 640 641 642 643 644 645 646 647 648 | platform and the channel type. On Unix platforms, the handle is always a Unix file descriptor as returned from the \fBopen\fR system call. On Windows platforms, the handle is a file \fBHANDLE\fR when the channel was created with \fBTcl_OpenFileChannel\fR, \fBTcl_OpenCommandChannel\fR, or \fBTcl_MakeFileChannel\fR. Other channel types may return a different type of handle on Windows platforms. .SH "SEE ALSO" DString(3), fconfigure(n), filename(n), fopen(3), Tcl_CreateChannel(3) .SH KEYWORDS access point, blocking, buffered I/O, channel, channel driver, end of file, flush, input, nonblocking, output, read, seek, write | > > > > > > > > > > > > > > > > > > | 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 | platform and the channel type. On Unix platforms, the handle is always a Unix file descriptor as returned from the \fBopen\fR system call. On Windows platforms, the handle is a file \fBHANDLE\fR when the channel was created with \fBTcl_OpenFileChannel\fR, \fBTcl_OpenCommandChannel\fR, or \fBTcl_MakeFileChannel\fR. Other channel types may return a different type of handle on Windows platforms. .SH "REFERENCE COUNT MANAGEMENT" .PP The \fIreadObjPtr\fR argument to \fBTcl_ReadChars\fR must be an unshared value; it will be modified by this function. Using the interpreter result for this purpose is \fIstrongly\fR not recommended; the preferred pattern is to use a new value from \fBTcl_NewObj\fR to receive the data and only to pass it to \fBTcl_SetObjResult\fR if this function succeeds. .PP The \fIlineObjPtr\fR argument to \fBTcl_GetsObj\fR must be an unshared value; it will be modified by this function. Using the interpreter result for this purpose is \fIstrongly\fR not recommended; the preferred pattern is to use a new value from \fBTcl_NewObj\fR to receive the data and only to pass it to \fBTcl_SetObjResult\fR if this function succeeds. .PP The \fIwriteObjPtr\fR argument to \fBTcl_WriteObj\fR should be a value with any reference count. This function will not modify the reference count. Using the interpreter result without adding an additional reference to it is not recommended. .SH "SEE ALSO" DString(3), fconfigure(n), filename(n), fopen(3), Tcl_CreateChannel(3) .SH KEYWORDS access point, blocking, buffered I/O, channel, channel driver, end of file, flush, input, nonblocking, output, read, seek, write |
Changes to doc/Panic.3.
| ︙ | ︙ | |||
14 15 16 17 18 19 20 | .sp void \fBTcl_Panic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR) .sp void \fBTcl_PanicVA\fR(\fIformat\fR, \fIargList\fR) .sp | | | 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 | .sp void \fBTcl_Panic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR) .sp void \fBTcl_PanicVA\fR(\fIformat\fR, \fIargList\fR) .sp const char * \fBTcl_SetPanicProc\fR(\fIpanicProc\fR) .sp void \fBTcl_ConsolePanic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR) .sp .SH ARGUMENTS .AS Tcl_PanicProc *panicProc |
| ︙ | ︙ | |||
77 78 79 80 81 82 83 84 85 86 87 88 89 90 | .PP After \fBTcl_SetPanicProc\fR returns, any future calls to \fBTcl_Panic\fR will call \fIpanicProc\fR, passing along the \fIformat\fR and \fIarg\fR arguments. \fIpanicProc\fR should avoid making calls into the Tcl library, or into other libraries that may call the Tcl library, since the original call to \fBTcl_Panic\fR indicates the Tcl library is not in a state of reliable operation. .PP The typical use of \fBTcl_SetPanicProc\fR arranges for the error message to be displayed or reported in a manner more suitable for the application or the platform. .PP \fBTcl_SetPanicProc\fR can not be used in stub-enabled extensions. Its symbol entry in the stub table is deprecated and it will be removed in Tcl 9.0. | > > > | 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 | .PP After \fBTcl_SetPanicProc\fR returns, any future calls to \fBTcl_Panic\fR will call \fIpanicProc\fR, passing along the \fIformat\fR and \fIarg\fR arguments. \fIpanicProc\fR should avoid making calls into the Tcl library, or into other libraries that may call the Tcl library, since the original call to \fBTcl_Panic\fR indicates the Tcl library is not in a state of reliable operation. .PP The result of \fBTcl_SetPanicProc\fR is the full Tcl version (e.g., \fB8.7.0+abcdef...abcdef.gcc-1002.utf16\fR). .PP The typical use of \fBTcl_SetPanicProc\fR arranges for the error message to be displayed or reported in a manner more suitable for the application or the platform. .PP \fBTcl_SetPanicProc\fR can not be used in stub-enabled extensions. Its symbol entry in the stub table is deprecated and it will be removed in Tcl 9.0. |
| ︙ | ︙ |
Changes to doc/ParseArgs.3.
| ︙ | ︙ | |||
185 186 187 188 189 190 191 192 193 194 195 196 197 198 | \fBTCL_ARGV_STRING\fR . This argument takes a following string value argument. A pointer to the string will be stored at \fIdstPtr\fR; the string inside will have a lifetime linked to the lifetime of the string representation of the argument value that it came from, and so should be copied if it needs to be retained. The \fIsrcPtr\fR and \fIclientData\fR fields are ignored. .SH "SEE ALSO" Tcl_GetIndexFromObj(3), Tcl_Main(3), Tcl_CreateObjCommand(3) .SH KEYWORDS argument, parse '\" Local Variables: '\" fill-column: 78 '\" End: | > > > > > > | 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 | \fBTCL_ARGV_STRING\fR . This argument takes a following string value argument. A pointer to the string will be stored at \fIdstPtr\fR; the string inside will have a lifetime linked to the lifetime of the string representation of the argument value that it came from, and so should be copied if it needs to be retained. The \fIsrcPtr\fR and \fIclientData\fR fields are ignored. .SH "REFERENCE COUNT MANAGEMENT" .PP The values in the \fIobjv\fR argument to \fBTcl_ParseArgsObjv\fR will not have their reference counts modified by this function. The interpreter result may be modified on error; the values passed should not be the interpreter result with no further reference added. .SH "SEE ALSO" Tcl_GetIndexFromObj(3), Tcl_Main(3), Tcl_CreateObjCommand(3) .SH KEYWORDS argument, parse '\" Local Variables: '\" fill-column: 78 '\" End: |
Changes to doc/ParseCmd.3.
| ︙ | ︙ | |||
187 188 189 190 191 192 193 194 195 196 197 198 199 200 | resulting values. The return value from \fBTcl_EvalTokensStandard\fR is a Tcl completion code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR, \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR, or possibly some other integer value originating in an extension. In addition, a result value or error message is left in \fIinterp\fR's result; it can be retrieved using \fBTcl_GetObjResult\fR. .PP \fBTcl_EvalTokens\fR differs from \fBTcl_EvalTokensStandard\fR only in the return convention used: it returns the result in a new Tcl_Obj. The reference count of the value returned as result has been incremented, so the caller must invoke \fBTcl_DecrRefCount\fR when it is finished with the value. If an error or other exception occurs while evaluating the tokens | > | 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 | resulting values. The return value from \fBTcl_EvalTokensStandard\fR is a Tcl completion code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR, \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR, or possibly some other integer value originating in an extension. In addition, a result value or error message is left in \fIinterp\fR's result; it can be retrieved using \fBTcl_GetObjResult\fR. .SS "DEPRECATED FUNCTIONS" .PP \fBTcl_EvalTokens\fR differs from \fBTcl_EvalTokensStandard\fR only in the return convention used: it returns the result in a new Tcl_Obj. The reference count of the value returned as result has been incremented, so the caller must invoke \fBTcl_DecrRefCount\fR when it is finished with the value. If an error or other exception occurs while evaluating the tokens |
| ︙ | ︙ | |||
459 460 461 462 463 464 465 466 467 | \fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVarName\fR. .PP There are additional fields in the Tcl_Parse structure after the \fInumTokens\fR field, but these are for the private use of \fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR, \fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVarName\fR; they should not be referenced by code outside of these procedures. .SH KEYWORDS backslash substitution, braces, command, expression, parse, token, variable substitution | > > > > > > > | 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 | \fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVarName\fR. .PP There are additional fields in the Tcl_Parse structure after the \fInumTokens\fR field, but these are for the private use of \fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR, \fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVarName\fR; they should not be referenced by code outside of these procedures. .SH "REFERENCE COUNT MANAGEMENT" .PP The result of \fBTcl_EvalTokens\fR is an unshared value with a reference count of 1; the caller of that function should call \fBTcl_DecrRefCount\fR on the result value to dispose of it. (The equivalent with \fBTcl_EvalTokenStandard\fR is just the interpreter result, which can be retrieved with \fBTcl_GetObjResult\fR.) .SH KEYWORDS backslash substitution, braces, command, expression, parse, token, variable substitution |
Changes to doc/PkgRequire.3.
| ︙ | ︙ | |||
87 88 89 90 91 92 93 94 95 96 | allow the setting and retrieving of the client data associated with the package. In all other respects they are equivalent to the matching functions. .PP \fBTcl_PkgRequireProc\fR is the form of \fBpackage require\fR handling multiple requirements. The other forms are present for backward compatibility and translate their invocations to this form. .SH KEYWORDS package, present, provide, require, version .SH "SEE ALSO" | > > > > | | 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 | allow the setting and retrieving of the client data associated with the package. In all other respects they are equivalent to the matching functions. .PP \fBTcl_PkgRequireProc\fR is the form of \fBpackage require\fR handling multiple requirements. The other forms are present for backward compatibility and translate their invocations to this form. .SH "REFERENCE COUNT MANAGEMENT" .PP The requirements values given (in the \fIobjv\fR argument) to \fBTcl_PkgRequireProc\fR must have non-zero reference counts. .SH KEYWORDS package, present, provide, require, version .SH "SEE ALSO" package(n), Tcl_StaticLibrary(3) |
Changes to doc/RecEvalObj.3.
| ︙ | ︙ | |||
40 41 42 43 44 45 46 47 48 49 50 51 | you should invoke \fBTcl_EvalObjEx\fR instead of \fBTcl_RecordAndEvalObj\fR. Normally \fBTcl_RecordAndEvalObj\fR is only called with top-level commands typed by the user, since the purpose of history is to allow the user to re-issue recently invoked commands. If the \fIflags\fR argument contains the \fBTCL_NO_EVAL\fR bit then the command is recorded without being evaluated. .SH "SEE ALSO" Tcl_EvalObjEx, Tcl_GetObjResult .SH KEYWORDS command, event, execute, history, interpreter, value, record | > > > > > > | 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 | you should invoke \fBTcl_EvalObjEx\fR instead of \fBTcl_RecordAndEvalObj\fR. Normally \fBTcl_RecordAndEvalObj\fR is only called with top-level commands typed by the user, since the purpose of history is to allow the user to re-issue recently invoked commands. If the \fIflags\fR argument contains the \fBTCL_NO_EVAL\fR bit then the command is recorded without being evaluated. .SH "REFERENCE COUNT MANAGEMENT" .PP The reference count of the \fIcmdPtr\fR argument to \fBTcl_RecordAndEvalObj\fR must be at least 1. This function will modify the interpreter result; do not use an existing result as \fIcmdPtr\fR directly without incrementing its reference count. .SH "SEE ALSO" Tcl_EvalObjEx, Tcl_GetObjResult .SH KEYWORDS command, event, execute, history, interpreter, value, record |
Changes to doc/RegExp.3.
| ︙ | ︙ | |||
47 48 49 50 51 52 53 | .AP Tcl_Obj *textObj in/out Refers to the value from which to get the text to search. The internal representation of the value may be converted to a form that can be efficiently searched. .AP Tcl_Obj *patObj in/out Refers to the value from which to get a regular expression. The compiled regular expression is cached in the value. | | | | 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 | .AP Tcl_Obj *textObj in/out Refers to the value from which to get the text to search. The internal representation of the value may be converted to a form that can be efficiently searched. .AP Tcl_Obj *patObj in/out Refers to the value from which to get a regular expression. The compiled regular expression is cached in the value. .AP "const char" *text in Text to search for a match with a regular expression. .AP "const char" *pattern in String in the form of a regular expression pattern. .AP Tcl_RegExp regexp in Compiled regular expression. Must have been returned previously by \fBTcl_GetRegExpFromObj\fR or \fBTcl_RegExpCompile\fR. .AP "const char" *start in If \fItext\fR is just a portion of some other string, this argument identifies the beginning of the larger string. If it is not the same as \fItext\fR, then no .QW \fB^\fR matches will be allowed. .AP int index in Specifies which range is desired: 0 means the range of the entire |
| ︙ | ︙ | |||
373 374 375 376 377 378 379 380 381 382 383 | \fBTCL_REG_CANMATCH\fR flag was used. It indicates the first character in the string where a match could occur. If a match was found, this will be the same as the beginning of the current match. If no match was found, then it indicates the earliest point at which a match might occur if additional text is appended to the string. If it is no match is possible even with further text, this field will be set to \-1. .SH "SEE ALSO" re_syntax(n) .SH KEYWORDS match, pattern, regular expression, string, subexpression, Tcl_RegExpIndices, Tcl_RegExpInfo | > > > > > > > > > > > > > > > > | 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 | \fBTCL_REG_CANMATCH\fR flag was used. It indicates the first character in the string where a match could occur. If a match was found, this will be the same as the beginning of the current match. If no match was found, then it indicates the earliest point at which a match might occur if additional text is appended to the string. If it is no match is possible even with further text, this field will be set to \-1. .SH "REFERENCE COUNT MANAGEMENT" .PP The \fItextObj\fR and \fIpatObj\fR arguments to \fBTcl_RegExpMatchObj\fR must have reference counts of at least 1. Note however that this function may set the interpreter result; neither argument should be the direct interpreter result without an additional reference being taken. .PP The \fIpatObj\fR argument to \fBTcl_GetRegExpFromObj\fR must have a reference count of at least 1. Note however that this function may set the interpreter result; the argument should not be the direct interpreter result without an additional reference being taken. .PP The \fItextObj\fR argument to \fBTcl_RegExpExecObj\fR must have a reference count of at least 1. Note however that this function may set the interpreter result; the argument should not be the direct interpreter result without an additional reference being taken. .SH "SEE ALSO" re_syntax(n) .SH KEYWORDS match, pattern, regular expression, string, subexpression, Tcl_RegExpIndices, Tcl_RegExpInfo |
Changes to doc/SetChanErr.3.
| ︙ | ︙ | |||
31 32 33 34 35 36 37 | .AP Tcl_Channel chan in Refers to the Tcl channel whose bypass area is accessed. .AP Tcl_Interp* interp in Refers to the Tcl interpreter whose bypass area is accessed. .AP Tcl_Obj* msg in Error message put into a bypass area. A list of return options and values, followed by a string message. Both message and the option/value information | | | | | 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 | .AP Tcl_Channel chan in Refers to the Tcl channel whose bypass area is accessed. .AP Tcl_Interp* interp in Refers to the Tcl interpreter whose bypass area is accessed. .AP Tcl_Obj* msg in Error message put into a bypass area. A list of return options and values, followed by a string message. Both message and the option/value information are optional. This \fImust\fR be a well-formed list. .AP Tcl_Obj** msgPtr out Reference to a place where the message stored in the accessed bypass area can be stored in. .BE .SH DESCRIPTION .PP The standard definition of a Tcl channel driver does not permit the direct return of arbitrary error messages, except for the setting and retrieval of channel options. All other functions are restricted to POSIX error codes. .PP The functions described here overcome this limitation. Channel drivers are allowed to use \fBTcl_SetChannelError\fR and \fBTcl_SetChannelErrorInterp\fR to place arbitrary error messages in \fIbypass areas\fR defined for channels and interpreters. And the generic I/O layer uses \fBTcl_GetChannelError\fR and \fBTcl_GetChannelErrorInterp\fR to look for messages in the bypass areas and arrange for their return as errors. The POSIX error codes set by a driver are used now if and only if no messages are present. .PP \fBTcl_SetChannelError\fR stores error information in the bypass area of the specified channel. The number of references to the \fBmsg\fR value goes up by |
| ︙ | ︙ | |||
130 131 132 133 134 135 136 137 138 139 140 | .PP All other API functions are unchanged. In particular, the functions below leave all their error information in the interpreter result. .DS .ta 1.9i 4i \fBTcl_Close\fR \fBTcl_UnstackChannel\fR \fBTcl_UnregisterChannel\fR .DE .SH "SEE ALSO" Tcl_Close(3), Tcl_OpenFileChannel(3), Tcl_SetErrno(3) .SH KEYWORDS channel driver, error messages, channel type | > > > > > > > > > | 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 | .PP All other API functions are unchanged. In particular, the functions below leave all their error information in the interpreter result. .DS .ta 1.9i 4i \fBTcl_Close\fR \fBTcl_UnstackChannel\fR \fBTcl_UnregisterChannel\fR .DE .SH "REFERENCE COUNT MANAGEMENT" .PP The \fImsg\fR argument to \fBTcl_SetChannelError\fR and \fBTcl_SetChannelErrorInterp\fR, if not NULL, may have any reference count; these functions will copy. .PP \fBTcl_GetChannelError\fR and \fBTcl_GetChannelErrorInterp\fR write a value reference into their \fImsgPtr\fR, but do not manipulate its reference count. The reference count will be at least 1 (unless the reference is NULL). .SH "SEE ALSO" Tcl_Close(3), Tcl_OpenFileChannel(3), Tcl_SetErrno(3) .SH KEYWORDS channel driver, error messages, channel type |
Changes to doc/SetResult.3.
| ︙ | ︙ | |||
235 236 237 238 239 240 241 242 243 244 245 246 |
.CS
typedef void \fBTcl_FreeProc\fR(
char *\fIblockPtr\fR);
.CE
.PP
When \fIfreeProc\fR is called, its \fIblockPtr\fR will be set to
the value of \fIresult\fR passed to \fBTcl_SetResult\fR.
.SH "SEE ALSO"
Tcl_AddErrorInfo, Tcl_CreateObjCommand, Tcl_SetErrorCode, Tcl_Interp,
Tcl_GetReturnOptions
.SH KEYWORDS
append, command, element, list, value, result, return value, interpreter
| > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
.CS
typedef void \fBTcl_FreeProc\fR(
char *\fIblockPtr\fR);
.CE
.PP
When \fIfreeProc\fR is called, its \fIblockPtr\fR will be set to
the value of \fIresult\fR passed to \fBTcl_SetResult\fR.
.SH "REFERENCE COUNT MANAGEMENT"
.PP
The interpreter result is one of the main places that owns references to
values, along with the bytecode execution stack, argument lists, variables,
and the list and dictionary collection values.
.PP
\fBTcl_SetObjResult\fR takes a value with an arbitrary reference count
\fI(specifically including zero)\fR and guarantees to increment the reference
count. If code wishes to continue using the value after setting it as the
result, it should add its own reference to it with \fBTcl_IncrRefCount\fR.
.PP
\fBTcl_GetObjResult\fR returns the current interpreter result value. This will
have a reference count of at least 1. If the caller wishes to keep the
interpreter result value, it should increment its reference count.
.PP
\fBTcl_GetStringResult\fR does not manipulate reference counts, but the string
it returns is owned by (and has a lifetime controlled by) the current
interpreter result value; it should be copied instead of being relied upon to
persist after the next Tcl API call, as most Tcl operations can modify the
interpreter result.
.PP
\fBTcl_SetResult\fR, \fBTcl_AppendResult\fR, \fBTcl_AppendResultVA\fR,
\fBTcl_AppendElement\fR, and \fBTcl_ResetResult\fR all modify the interpreter
result. They may cause the old interpreter result to have its reference count
decremented and a new interpreter result to be allocated. After they have been
called, the reference count of the interpreter result is guaranteed to be 1.
.SH "SEE ALSO"
Tcl_AddErrorInfo, Tcl_CreateObjCommand, Tcl_SetErrorCode, Tcl_Interp,
Tcl_GetReturnOptions
.SH KEYWORDS
append, command, element, list, value, result, return value, interpreter
|
Changes to doc/SetVar.3.
| ︙ | ︙ | |||
238 239 240 241 242 243 244 245 246 247 248 249 | If the variable cannot be removed because it does not exist then \fBTCL_ERROR\fR is returned. If an array element is specified, the given element is removed but the array remains. If an array name is specified without an index, then the entire array is removed. .SH "SEE ALSO" Tcl_GetObjResult, Tcl_GetStringResult, Tcl_TraceVar .SH KEYWORDS array, get variable, interpreter, scalar, set, unset, value, variable | > > > > > > > > > > > > > > > > > > > > > | 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 | If the variable cannot be removed because it does not exist then \fBTCL_ERROR\fR is returned. If an array element is specified, the given element is removed but the array remains. If an array name is specified without an index, then the entire array is removed. .SH "REFERENCE COUNT MANAGEMENT" .PP The result of \fBTcl_SetVar2Ex\fR, \fBTcl_ObjSetVar2\fR, \fBTcl_GetVar2Ex\fR, and \fBTcl_ObjGetVar2\fR is (if non-NULL) a value with a reference of at least 1, where that reference is held by the variable that the function has just operated upon. .PP The \fInewValuePtr\fR argument to \fBTcl_SetVar2Ex\fR and \fBTcl_ObjSetVar2\fR may be an arbitrary reference count value; its reference count will be incremented on success. However, it is recommended to not use a zero reference count value, as that makes correct handling of the error case tricky. .PP The \fIpart1\fR argument to \fBTcl_ObjSetVar2\fR and \fBTcl_ObjGetVar2\fR can have any reference count; these functions never modify it. It is recommended to not use a zero reference count for this argument. .PP The \fIpart2\fR argument to \fBTcl_ObjSetVar2\fR and \fBTcl_ObjGetVar2\fR, if non-NULL, should not have a zero reference count as these functions may retain a reference to it (particularly when it is used to create an array element that did not previously exist). .SH "SEE ALSO" Tcl_GetObjResult, Tcl_GetStringResult, Tcl_TraceVar .SH KEYWORDS array, get variable, interpreter, scalar, set, unset, value, variable |
Changes to doc/SplitList.3.
| ︙ | ︙ | |||
32 33 34 35 36 37 38 | int \fBTcl_ConvertCountedElement\fR(\fIsrc, length, dst, flags\fR) .SH ARGUMENTS .AS "const char *const" ***argvPtr out .AP Tcl_Interp *interp out Interpreter to use for error reporting. If NULL, then no error message is left. | | | 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 | int \fBTcl_ConvertCountedElement\fR(\fIsrc, length, dst, flags\fR) .SH ARGUMENTS .AS "const char *const" ***argvPtr out .AP Tcl_Interp *interp out Interpreter to use for error reporting. If NULL, then no error message is left. .AP "const char" *list in Pointer to a string with proper list structure. .AP int *argcPtr out Filled in with number of elements in \fIlist\fR. .AP "const char" ***argvPtr out \fI*argvPtr\fR will be filled in with the address of an array of pointers to the strings that are the extracted elements of \fIlist\fR. There will be \fI*argcPtr\fR valid entries in the array, followed by |
| ︙ | ︙ |
Name change from doc/StaticPkg.3 to doc/StaticLibrary.3.
1 2 3 4 5 6 | '\" '\" 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. '\" | | | > > | | | | | | | | | | | | | | | | | | | | | | > > > | | 1 2 3 4 5 6 7 8 9 10 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 |
'\"
'\" 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_StaticLibrary 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_StaticLibrary, Tcl_StaticPackage \- make a statically linked library available via the 'load' command
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_StaticLibrary\fR(\fIinterp, prefix, initProc, safeInitProc\fR)
.sp
\fBTcl_StaticPackage\fR(\fIinterp, prefix, initProc, safeInitProc\fR)
.SH ARGUMENTS
.AS Tcl_LibraryInitProc *safeInitProc
.AP Tcl_Interp *interp in
If not NULL, points to an interpreter into which the library has
already been incorporated (i.e., the caller has already invoked the
appropriate initialization procedure). NULL means the library
has not yet been incorporated into any interpreter.
.AP "const char" *prefix in
Prefix for library initialization function; should be properly
capitalized (first letter upper-case, all others lower-case).
.AP Tcl_LibraryInitProc *initProc in
Procedure to invoke to incorporate this library into a trusted
interpreter.
.AP Tcl_LibraryInitProc *safeInitProc in
Procedure to call to incorporate this library into a safe interpreter
(one that will execute untrusted scripts). NULL means the library
cannot be used in safe interpreters.
.BE
.SH DESCRIPTION
.PP
This procedure may be invoked to announce that a library has been
linked statically with a Tcl application and, optionally, that it
has already been incorporated into an interpreter.
Once \fBTcl_StaticLibrary\fR has been invoked for a library, it
may be incorporated into interpreters using the \fBload\fR command.
\fBTcl_StaticLibrary\fR is normally invoked only by the \fBTcl_AppInit\fR
procedure for the application, not by libraries for themselves
(\fBTcl_StaticLibrary\fR should only be invoked for statically
linked libraries, and code in the library itself should not need
to know whether the library is dynamically loaded or statically linked).
.PP
When the \fBload\fR command is used later to incorporate the library into
an interpreter, one of \fIinitProc\fR and \fIsafeInitProc\fR will
be invoked, depending on whether the target interpreter is safe
or not.
\fIinitProc\fR and \fIsafeInitProc\fR must both match the
following prototype:
.PP
.CS
typedef int \fBTcl_LibraryInitProc\fR(
Tcl_Interp *\fIinterp\fR);
.CE
.PP
The \fIinterp\fR argument identifies the interpreter in which the library
is to be incorporated. The initialization procedure must return \fBTCL_OK\fR or
\fBTCL_ERROR\fR to indicate whether or not it completed successfully; in
the event of an error it should set the interpreter's result to point to an
error message. The result or error from the initialization procedure will
be returned as the result of the \fBload\fR command that caused the
initialization procedure to be invoked.
.PP
\fBTcl_StaticLibrary\fR was named \fBTcl_StaticPackage\fR in Tcl 8.6 and
earlier, but the old name is deprecated now.
.PP
\fBTcl_StaticLibrary\fR can not be used in stub-enabled extensions. Its symbol
entry in the stub table is deprecated and it will be removed in Tcl 9.0.
.SH KEYWORDS
initialization procedure, package, static linking
.SH "SEE ALSO"
load(n), package(n), Tcl_PkgRequire(3)
|
Changes to doc/StringObj.3.
| ︙ | ︙ | |||
107 108 109 110 111 112 113 | The number of Unicode characters to copy from \fIunicode\fR when initializing, setting, or appending to a string value. If negative, all characters up to the first null character are used. .AP int index in The index of the Unicode character to return. .AP int first in The index of the first Unicode character in the Unicode range to be | | > | > | | 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 | The number of Unicode characters to copy from \fIunicode\fR when initializing, setting, or appending to a string value. If negative, all characters up to the first null character are used. .AP int index in The index of the Unicode character to return. .AP int first in The index of the first Unicode character in the Unicode range to be returned as a new value. If negative, behave the same as if the value was 0. .AP int last in The index of the last Unicode character in the Unicode range to be returned as a new value. If negative, take all characters up to the last one available. .AP Tcl_Obj *objPtr in/out Points to a value to manipulate. .AP Tcl_Obj *appendObjPtr in The value to append to \fIobjPtr\fR in \fBTcl_AppendObjToObj\fR. .AP int *lengthPtr out The location where \fBTcl_GetStringFromObj\fR will store the length of a value's string representation. May be (int *)NULL when not used. .AP "const char" *string in Null-terminated string value to append to \fIobjPtr\fR. .AP va_list argList in An argument list which must have been initialized using \fBva_start\fR, and cleared using \fBva_end\fR. |
| ︙ | ︙ | |||
379 380 381 382 383 384 385 386 387 388 389 390 | array. \fBTcl_ConcatObj\fR eliminates leading and trailing white space as it copies the string representations of the \fIobjv\fR array to the result. If an element of the \fIobjv\fR array consists of nothing but white space, then that value is ignored entirely. This white-space removal was added to make the output of the \fBconcat\fR command cleaner-looking. \fBTcl_ConcatObj\fR returns a pointer to a newly-created value whose ref count is zero. .SH "SEE ALSO" Tcl_NewObj(3), Tcl_IncrRefCount(3), Tcl_DecrRefCount(3), format(n), sprintf(3) .SH KEYWORDS append, internal representation, value, value type, string value, string type, string representation, concat, concatenate, unicode | > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | array. \fBTcl_ConcatObj\fR eliminates leading and trailing white space as it copies the string representations of the \fIobjv\fR array to the result. If an element of the \fIobjv\fR array consists of nothing but white space, then that value is ignored entirely. This white-space removal was added to make the output of the \fBconcat\fR command cleaner-looking. \fBTcl_ConcatObj\fR returns a pointer to a newly-created value whose ref count is zero. .SH "REFERENCE COUNT MANAGEMENT" .PP \fBTcl_NewStringObj\fR, \fBTcl_NewUnicodeObj\fR, \fBTcl_Format\fR, \fBTcl_ObjPrintf\fR, and \fBTcl_ConcatObj\fR always return a zero-reference object, much like \fBTcl_NewObj\fR. .PP \fBTcl_GetStringFromObj\fR, \fBTcl_GetString\fR, \fBTcl_GetUnicodeFromObj\fR, \fBTcl_GetUnicode\fR, \fBTcl_GetUniChar\fR, \fBTcl_GetCharLength\fR, and \fBTcl_GetRange\fR all only work with an existing value; they do not manipulate its reference count in any way. .PP \fBTcl_SetStringObj\fR, \fBTcl_SetUnicodeObj\fR, \fBTcl_AppendToObj\fR, \fBTcl_AppendUnicodeToObj\fR, \fBTcl_AppendObjToObj\fR, \fBTcl_AppendStringsToObj\fR, \fBTcl_AppendStringsToObjVA\fR, \fBTcl_AppendLimitedToObj\fR, \fBTcl_AppendFormatToObj\fR, \fBTcl_AppendPrintfToObj\fR, \fBTcl_SetObjLength\fR, and \fBTcl_AttemptSetObjLength\fR and require their \fIobjPtr\fR to be an unshared value (i.e, a reference count no more than 1) as they will modify it. .PP Additional arguments to the above functions (the \fIappendObjPtr\fR argument to \fBTcl_AppendObjToObj\fR, values in the \fIobjv\fR argument to \fBTcl_Format\fR, \fBTcl_AppendFormatToObj\fR, and \fBTcl_ConcatObj\fR) can have any reference count, but reference counts of zero are not recommended. .PP \fBTcl_Format\fR and \fBTcl_AppendFormatToObj\fR may modify the interpreter result, which involves changing the reference count of a value. .SH "SEE ALSO" Tcl_NewObj(3), Tcl_IncrRefCount(3), Tcl_DecrRefCount(3), format(n), sprintf(3) .SH KEYWORDS append, internal representation, value, value type, string value, string type, string representation, concat, concatenate, unicode |
Changes to doc/SubstObj.3.
| ︙ | ︙ | |||
58 59 60 61 62 63 64 65 66 67 68 | empty string is substituted for the command. Where an uncaught .QW "break exception" occurs during the evaluation of a command substitution, the result of the whole substitution on \fIobjPtr\fR will be truncated at the point immediately before the start of the command substitution, and no characters will be added to the result or substitutions performed after that point. .SH "SEE ALSO" subst(n) .SH KEYWORDS backslash substitution, command substitution, variable substitution | > > > > > > > | 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 | empty string is substituted for the command. Where an uncaught .QW "break exception" occurs during the evaluation of a command substitution, the result of the whole substitution on \fIobjPtr\fR will be truncated at the point immediately before the start of the command substitution, and no characters will be added to the result or substitutions performed after that point. .SH "REFERENCE COUNT MANAGEMENT" .PP The \fIobjPtr\fR argument to \fBTcl_SubstObj\fR must not have a reference count of zero. This function modifies the interpreter result, both on success and on failure; the result of this function on success is exactly the current interpreter result. Successful results should have their reference count incremented if they are to be retained. .SH "SEE ALSO" subst(n) .SH KEYWORDS backslash substitution, command substitution, variable substitution |
Changes to doc/TclZlib.3.
| ︙ | ︙ | |||
258 259 260 261 262 263 264 265 266 267 268 269 270 271 | \fBclock format\fR. On creation, the right value to use is that from \fBclock seconds\fR or \fBfile mtime\fR. .TP \fBtype\fR . The type of the uncompressed data (either \fBbinary\fR or \fBtext\fR) if known. .SH "PORTABILITY NOTES" These functions will fail gracefully if Tcl is not linked with the zlib library. .SH "SEE ALSO" Tcl_NewByteArrayObj(3), zlib(n) '\"Tcl_StackChannel(3) .SH "KEYWORDS" | > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | \fBclock format\fR. On creation, the right value to use is that from \fBclock seconds\fR or \fBfile mtime\fR. .TP \fBtype\fR . The type of the uncompressed data (either \fBbinary\fR or \fBtext\fR) if known. .SH "REFERENCE COUNT MANAGEMENT" .PP \fBTcl_ZlibDeflate\fR and \fBTcl_ZlibInflate\fR take a value with arbitrary reference count for their \fIdataObj\fR and \fIdictObj\fR arguments (the latter often being NULL instead), and set the interpreter result with their output value (or an error). The existing interpreter result should not be passed as any argument value unless an additional reference is held. .PP \fBTcl_ZlibStreamInit\fR takes a value with arbitrary reference count for its \fIdictObj\fR argument; it only reads from it. The existing interpreter result should not be passed unless an additional reference is held. .PP \fBTcl_ZlibStreamGetCommandName\fR returns a zero reference count value, much like \fBTcl_NewObj\fR. .PP The \fIdataObj\fR argument to \fBTcl_ZlibStreamPut\fR is a value with arbitrary reference count; it is only ever read from. .PP The \fIdataObj\fR argument to \fBTcl_ZlibStreamGet\fR is an unshared value (see \fBTcl_IsShared\fR) that will be updated by the function. .PP The \fIcompDict\fR argument to \fBTcl_ZlibStreamSetCompressionDictionary\fR, if non-NULL, may be duplicated or may have its reference count incremented. Using a zero reference count value is not recommended. .SH "PORTABILITY NOTES" These functions will fail gracefully if Tcl is not linked with the zlib library. .SH "SEE ALSO" Tcl_NewByteArrayObj(3), zlib(n) '\"Tcl_StackChannel(3) .SH "KEYWORDS" |
| ︙ | ︙ |
Changes to doc/Tcl_Main.3.
1 2 3 4 5 6 7 8 9 10 11 12 | '\" '\" Copyright (c) 1994 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 Tcl_Main 3 8.4 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME | | > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 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 | '\" '\" Copyright (c) 1994 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 Tcl_Main 3 8.4 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_Main, Tcl_MainEx, Tcl_MainExW, Tcl_SetStartupScript, Tcl_GetStartupScript, Tcl_SetMainLoop \- main program, startup script, and event loop definition for Tcl-based applications .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp \fBTcl_Main\fR(\fIargc, argv, appInitProc\fR) .sp \fBTcl_MainEx\fR(\fIargc, charargv, appInitProc, interp\fR) .sp \fBTcl_MainExW\fR(\fIargc, wideargv, appInitProc, interp\fR) .sp \fBTcl_SetStartupScript\fR(\fIpath, encoding\fR) .sp Tcl_Obj * \fBTcl_GetStartupScript\fR(\fIencodingPtr\fR) .sp \fBTcl_SetMainLoop\fR(\fImainLoopProc\fR) .SH ARGUMENTS .AS Tcl_MainLoopProc *mainLoopProc .AP int argc in Number of elements in \fIargv\fR. .AP char *argv[] in Array of strings containing command-line arguments. On Windows, when using -DUNICODE, the parameter type changes to wchar_t *. .AP char *charargv[] in As argv, but does not change type to wchar_t. .AP char *wideargv[] in As argv, but type is always wchar_t. .AP Tcl_AppInitProc *appInitProc in Address of an application-specific initialization procedure. The value for this argument is usually \fBTcl_AppInit\fR. .AP Tcl_Obj *path in Name of file to use as startup script, or NULL. .AP "const char" *encoding in Encoding of file to use as startup script, or NULL. .AP "const char" **encodingPtr out If non-NULL, location to write a copy of the (const char *) pointing to the encoding name. .AP Tcl_MainLoopProc *mainLoopProc in Address of an application-specific event loop procedure. .AP Tcl_Interp *interp in Already created Tcl Interpreter. .BE .SH DESCRIPTION .PP \fBTcl_Main\fR can serve as the main program for Tcl-based shell applications. A .QW "shell application" is a program |
| ︙ | ︙ | |||
187 188 189 190 191 192 193 194 195 196 197 198 | itself will evaluate the \fBexit\fR command after the main loop procedure (if any) returns. In non-interactive mode, after \fBTcl_Main\fR evaluates the startup script, and the main loop procedure (if any) returns, \fBTcl_Main\fR will also evaluate the \fBexit\fR command. .PP \fBTcl_Main\fR can not be used in stub-enabled extensions. .SH "SEE ALSO" tclsh(1), Tcl_GetStdChannel(3), Tcl_StandardChannels(3), Tcl_AppInit(3), exit(n), encoding(n) .SH KEYWORDS application-specific initialization, command-line arguments, main program | > > > > > > > > > | 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 | itself will evaluate the \fBexit\fR command after the main loop procedure (if any) returns. In non-interactive mode, after \fBTcl_Main\fR evaluates the startup script, and the main loop procedure (if any) returns, \fBTcl_Main\fR will also evaluate the \fBexit\fR command. .PP \fBTcl_Main\fR can not be used in stub-enabled extensions. .SH "REFERENCE COUNT MANAGEMENT" .PP \fBTcl_SetStartupScript\fR takes a value (or NULL) for its \fIpath\fR argument, and will increment the reference count of it. .PP \fBTcl_GetStartupScript\fR returns a value with reference count at least 1, or NULL. It's \fIencodingPtr\fR is also used (if non-NULL) to return a value with a reference count at least 1, or NULL. In both cases, the owner of the values is the current thread. .SH "SEE ALSO" tclsh(1), Tcl_GetStdChannel(3), Tcl_StandardChannels(3), Tcl_AppInit(3), exit(n), encoding(n) .SH KEYWORDS application-specific initialization, command-line arguments, main program |
Changes to doc/TraceVar.3.
| ︙ | ︙ | |||
355 356 357 358 359 360 361 362 363 364 365 366 367 368 | In an unset callback to \fIproc\fR, the \fBTCL_TRACE_DESTROYED\fR bit is set in \fIflags\fR if the trace is being removed as part of the deletion. Traces on a variable are always removed whenever the variable is deleted; the only time \fBTCL_TRACE_DESTROYED\fR is not set is for a whole-array trace invoked when only a single element of an array is unset. .SH BUGS .PP Array traces are not yet integrated with the Tcl \fBinfo exists\fR command, nor is there Tcl-level access to array traces. .SH "SEE ALSO" trace(n) .SH KEYWORDS | > > > > > > > > | 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 | In an unset callback to \fIproc\fR, the \fBTCL_TRACE_DESTROYED\fR bit is set in \fIflags\fR if the trace is being removed as part of the deletion. Traces on a variable are always removed whenever the variable is deleted; the only time \fBTCL_TRACE_DESTROYED\fR is not set is for a whole-array trace invoked when only a single element of an array is unset. .SH "REFERENCE COUNT MANAGEMENT" .PP When a \fIproc\fR callback is invoked, and that callback was installed with the \fBTCL_TRACE_RESULT_OBJECT\fR flag, the result of the callback is a Tcl_Obj reference when there is an error. The result will have its reference count decremented once when no longer needed, or may have additional references made to it (e.g., by setting it as the interpreter result with \fBTcl_SetObjResult\fR). .SH BUGS .PP Array traces are not yet integrated with the Tcl \fBinfo exists\fR command, nor is there Tcl-level access to array traces. .SH "SEE ALSO" trace(n) .SH KEYWORDS |
| ︙ | ︙ |
Changes to doc/UniCharIsAlpha.3.
1 2 3 4 5 6 7 8 9 10 | '\" '\" 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 Tcl_UniCharIsAlpha 3 "8.1" Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | '\" '\" 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 Tcl_UniCharIsAlpha 3 "8.1" Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_UniCharIsAlnum, Tcl_UniCharIsAlpha, Tcl_UniCharIsControl, Tcl_UniCharIsDigit, Tcl_UniCharIsGraph, Tcl_UniCharIsLower, Tcl_UniCharIsPrint, Tcl_UniCharIsPunct, Tcl_UniCharIsSpace, Tcl_UniCharIsUpper, Tcl_UniCharIsUnicode, Tcl_UniCharIsWordChar \- routines for classification of Tcl_UniChar characters .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp int \fBTcl_UniCharIsAlnum\fR(\fIch\fR) .sp |
| ︙ | ︙ | |||
39 40 41 42 43 44 45 46 47 48 49 50 51 52 | .sp int \fBTcl_UniCharIsSpace\fR(\fIch\fR) .sp int \fBTcl_UniCharIsUpper\fR(\fIch\fR) .sp int \fBTcl_UniCharIsWordChar\fR(\fIch\fR) .SH ARGUMENTS .AS int ch .AP int ch in The Unicode character to be examined. .BE | > > > | 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 | .sp int \fBTcl_UniCharIsSpace\fR(\fIch\fR) .sp int \fBTcl_UniCharIsUpper\fR(\fIch\fR) .sp int \fBTcl_UniCharIsUnicode\fR(\fIch\fR) .sp int \fBTcl_UniCharIsWordChar\fR(\fIch\fR) .SH ARGUMENTS .AS int ch .AP int ch in The Unicode character to be examined. .BE |
| ︙ | ︙ | |||
76 77 78 79 80 81 82 83 84 85 86 87 88 | \fBTcl_UniCharIsPrint\fR tests if the character is a Unicode print character. .PP \fBTcl_UniCharIsPunct\fR tests if the character is a Unicode punctuation character. .PP \fBTcl_UniCharIsSpace\fR tests if the character is a whitespace Unicode character. .PP \fBTcl_UniCharIsUpper\fR tests if the character is an uppercase Unicode character. .PP \fBTcl_UniCharIsWordChar\fR tests if the character is alphanumeric or a connector punctuation mark. .SH KEYWORDS unicode, classification | > > > | 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 | \fBTcl_UniCharIsPrint\fR tests if the character is a Unicode print character. .PP \fBTcl_UniCharIsPunct\fR tests if the character is a Unicode punctuation character. .PP \fBTcl_UniCharIsSpace\fR tests if the character is a whitespace Unicode character. .PP \fBTcl_UniCharIsUpper\fR tests if the character is an uppercase Unicode character. .PP \fBTcl_UniCharIsUnicode\fR tests if the character is a Unicode character, not being a surrogate or noncharacter. .PP \fBTcl_UniCharIsWordChar\fR tests if the character is alphanumeric or a connector punctuation mark. .SH KEYWORDS unicode, classification |
Changes to doc/Utf.3.
1 2 3 4 5 6 7 8 9 10 | '\" '\" 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 Utf 3 "8.1" Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | '\" '\" 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 Utf 3 "8.1" Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UtfToChar16, Tcl_UtfToWChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_Char16ToUtfDString, Tcl_UtfToWCharDString, Tcl_UtfToChar16DString, Tcl_WCharLen, Tcl_Char16Len, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharNcasecmp, Tcl_UniCharCaseMatch, Tcl_UtfNcmp, Tcl_UtfNcasecmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp typedef ... \fBTcl_UniChar\fR; .sp int |
| ︙ | ︙ | |||
41 42 43 44 45 46 47 48 49 50 51 52 53 54 | .sp unsigned short * \fBTcl_UtfToChar16DString\fR(\fIsrc, length, dsPtr\fR) .sp wchar_t * \fBTcl_UtfToWCharDString\fR(\fIsrc, length, dsPtr\fR) .sp int \fBTcl_UniCharLen\fR(\fIuniStr\fR) .sp int \fBTcl_UniCharNcmp\fR(\fIucs, uct, numChars\fR) .sp int | > > > > > > | 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 | .sp unsigned short * \fBTcl_UtfToChar16DString\fR(\fIsrc, length, dsPtr\fR) .sp wchar_t * \fBTcl_UtfToWCharDString\fR(\fIsrc, length, dsPtr\fR) .sp int \fBTcl_Char16Len\fR(\fIuniStr\fR) .sp int \fBTcl_WCharLen\fR(\fIuniStr\fR) .sp int \fBTcl_UniCharLen\fR(\fIuniStr\fR) .sp int \fBTcl_UniCharNcmp\fR(\fIucs, uct, numChars\fR) .sp int |
| ︙ | ︙ | |||
194 195 196 197 198 199 200 201 202 203 204 205 206 207 | .QW \-1 , in which case \fBTcl_UtfToUniCharDString\fR uses \fBstrlen\fR to calculate the length. The return value is a pointer to the Unicode representation of the UTF-8 string. Storage for the return value is appended to the end of the \fBTcl_DString\fR. The Unicode string is terminated with a Unicode null character. .PP \fBTcl_UniCharLen\fR corresponds to \fBstrlen\fR for Unicode characters. It accepts a null-terminated Unicode string and returns the number of Unicode characters (not bytes) in that string. .PP \fBTcl_UniCharNcmp\fR and \fBTcl_UniCharNcasecmp\fR correspond to \fBstrncmp\fR and \fBstrncasecmp\fR, respectively, for Unicode characters. They accept two null-terminated Unicode strings and the number of characters | > > > > > > > > | 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 | .QW \-1 , in which case \fBTcl_UtfToUniCharDString\fR uses \fBstrlen\fR to calculate the length. The return value is a pointer to the Unicode representation of the UTF-8 string. Storage for the return value is appended to the end of the \fBTcl_DString\fR. The Unicode string is terminated with a Unicode null character. .PP \fBTcl_Char16Len\fR corresponds to \fBstrlen\fR for UTF-16 characters. It accepts a null-terminated Unicode string and returns the number of Unicode characters (not bytes) in that string. .PP \fBTcl_WCharLen\fR corresponds to \fBstrlen\fR for wchar_t characters. It accepts a null-terminated Unicode string and returns the number of Unicode characters (not bytes) in that string. .PP \fBTcl_UniCharLen\fR corresponds to \fBstrlen\fR for Unicode characters. It accepts a null-terminated Unicode string and returns the number of Unicode characters (not bytes) in that string. .PP \fBTcl_UniCharNcmp\fR and \fBTcl_UniCharNcasecmp\fR correspond to \fBstrncmp\fR and \fBstrncasecmp\fR, respectively, for Unicode characters. They accept two null-terminated Unicode strings and the number of characters |
| ︙ | ︙ |
Changes to doc/WrongNumArgs.3.
| ︙ | ︙ | |||
69 70 71 72 73 74 75 76 77 78 79 | \fIbar\fR is actually an abbreviation for \fIbarfly\fR and the value is now an \fIindexObject\fR because it was passed to \fBTcl_GetIndexFromObj\fR. In this case the error message would be: .PP .CS wrong # args: should be "foo barfly fileName count" .CE .SH "SEE ALSO" Tcl_GetIndexFromObj(3) .SH KEYWORDS command, error message, wrong number of arguments | > > > > > > | 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 | \fIbar\fR is actually an abbreviation for \fIbarfly\fR and the value is now an \fIindexObject\fR because it was passed to \fBTcl_GetIndexFromObj\fR. In this case the error message would be: .PP .CS wrong # args: should be "foo barfly fileName count" .CE .SH "REFERENCE COUNT MANAGEMENT" .PP The \fIobjv\fR argument to \fBTcl_WrongNumArgs\fR should be the exact arguments passed to the command or method implementation function that is calling \fBTcl_WrongNumArgs\fR. As such, all values referenced in it should have reference counts greater than zero; this is usually a non-issue. .SH "SEE ALSO" Tcl_GetIndexFromObj(3) .SH KEYWORDS command, error message, wrong number of arguments |
Changes to doc/binary.n.
| ︙ | ︙ | |||
77 78 79 80 81 82 83 | that are not strictly part of the encoding itself. Otherwise it ignores them. RFC 2045 calls for base64 decoders to be non-strict. .RE .TP \fBhex\fR . The \fBhex\fR binary encoding converts each byte to a pair of hexadecimal | | > > | 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 | that are not strictly part of the encoding itself. Otherwise it ignores them. RFC 2045 calls for base64 decoders to be non-strict. .RE .TP \fBhex\fR . The \fBhex\fR binary encoding converts each byte to a pair of hexadecimal digits that represent the byte value as a hexadecimal integer. When encoding, lower characters are used. When decoding, upper and lower characters are accepted. .RS .PP No options are supported during encoding. During decoding, the following options are supported: .TP \fB\-strict\fR . |
| ︙ | ︙ |
Changes to doc/chan.n.
1 2 3 4 5 6 7 8 9 10 | '\" '\" Copyright (c) 2005-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 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 | > | | | | < | | | | | | | | | < < | | | > > > | | | | < < < | | | < | | | < < < > | | < > | | < < > | | < < < < < < | | < < | < > > < < < < > > | | < | | | | | | | | | < < | < | | | < < | | < | | | | | | < | | < | < < | | | < < | | | | < < | < | < < | | | > > > | > | | < > | | | | < < | | | | < | | < < | | | < | | < | | | < | | < > | | | | < | < | > | | | | | < < < | < > | < < | | | < < | | < | | < | | | < | | | | | | < < | | < | | | < < | < | < < | | | | | < | < | < | | | < | | < | < | | | | | > | < < < < | < < < < | | | < < | < < < | > | | | | | | | < | < | < | < < < < < | | | < | < | < | < < < > | < < | | < < | < < < < > | | | | < | | | < | < < > > > < < < < < < < | | < | | | | | < | < > > > | | | < | > | < > > > > | < < < < < < | < < < < < | | < | | < > > | < < > > | < < | > > > > > > > > | | < | | | < | | | | | < < < < < | < < < | < < < < | < | | < < < | | | | > > | | < | > | < < < | | < > | > | < | | < | > > | > | | | < | > | < | > > | | | < > | | | > | < | | | > > | < > > > > > > > < < < < < < < < < < < | | > > > > > > > > > > | < | < | < < < < < < | < | < < < < < | | < > | > > | > | | | < | | < < | | | | | < < | < | < < < | | | < < > | | < < < | > > | < | > < < | | | | | | | < | < < < < < < < | | | > > > > | < | | | | | | < < | | < < < < < < | | < < < < < < < < < | | < < | | | | | > | < | < < < < < | < < | < | < | | | | | < | | | < < | | | < < | | | | 1 2 3 4 5 6 7 8 9 10 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 |
'\"
'\" 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
\fBchan \fIoperation\fR ?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
\fBchan\fR provides several operations for reading from, writing to, and
otherwise manipulating channels, e.g. those created by \fBopen\fR and
\fBsocket\fR, or the default channels \fBstdin\fR, \fBstdout\fR or \fBstderr\fR
which correspond respectively to the standard input, output, and error streams
of the process. Any unique abbreviation for \fIoperation\fR is acceptable.
Available operations are:
.TP
\fBchan blocked \fIchannelName\fR
.
Returns 1 when the channel is in non-blocking mode and the last input operation
on the channel failed because it would have otherwise caused the process to
block, and 0 otherwise. Each Tcl channel is in blocking mode unless configured
otherwise.
.TP
\fBchan close \fIchannelName\fR ?\fIdirection\fR?
.
Closes and destroys the named channel, deleting any existing event handlers
established for the channel, and returns the empty string. If \fIdirection\fR is
given, it is
.QW\fBread\fR
or
.QW\fBwrite\fR
or any unique abbreviation of those words, and only that side of the channel is
closed. I.e. a read-write channel may become read-only or write-only.
Closing a read-only channel for reading, or closing a write-only channel for
writing is the same as simply closing the channel. It is an error to close a
read-only channel for writing or to close a write-only channel for reading.
.RS
.PP
When a channel is closed for writing, any buffered output on the channel is
flushed. When a channel is closed for reading, any buffered input is discarded.
When a channel is destroyed the underlying resource is closed and the channel
is thereafter unavailable.
.PP
\fBchan close\fR fully flushes any output before closing the write side of a
channel unless it is non-blocking mode, where it returns immediately and the
channel is flushed in the background before finally being closed.
.PP
\fBchan close\fR may return an error if an error occurs while flushing
output. If a process in a command pipeline created by \fBopen\fR returns an
error, \fBchan close\fR generates an error in the same manner as \fBexec\fR.
.PP
Closing one side of a socket or command pipeline may lead to the shutdown() or
close() of the underlying system resource, leading to a reaction from whatever
is on the other side of the pipeline or socket.
.PP
If the channel for a command pipeline is in blocking mode, \fBchan close\fR
waits for the connected processes to complete.
.PP
\fBchan close\fR only affects the current interpreter. If the channel is open
in any other interpreter, its state is unchanged there. See \fBinterp\fR for a
description of channel sharing.
.PP
When the last interpreter sharing a channel is destroyed, the channel is
switched to blocking mode and fully flushed and then closed.
.RE
.TP
\fBchan configure \fIchannelName\fR ?\fIoptionName\fR? ?\fIvalue\fR? ?\fIoptionName value\fR?...
.
Configures or reports the configuration of \fIchannelName\fR.
.RS
.PP
If no \fIoptionName\fR or \fIvalue\fR arguments are given,
\fBchan configure\fR returns a dictionary of option names and
values for the channel. If \fIoptionName\fR is supplied without a \fIvalue\fR,
\fBchan configure\fR returns the current value of the named option. If one or
more pairs of \fIoptionName\fR and \fIvalue\fR are supplied,
\fBchan configure\fR sets each of the named options to the corresponding
\fIvalue\fR and returns the empty string.
.PP
The options described below are supported for all channels. Each type of
channel may provide additional options. Those options are described in the
relevant documentation. For example, additional options are documented for
\fBsocket\fR, and also for serial devices at \fBopen\fR.
.TP
\fB\-blocking\fR \fIboolean\fR
.
If \fB\-blocking\fR is set to \fBtrue\fR, which is the default, reading from or
writing to the channel may cause the process to block indefinitely. Otherwise,
operations such as \fBchan gets\fR, \fBchan read\fR, \fBchan puts\fR, \fBchan
flush\fR, and \fBchan close\fR take care not to block. Non-blocking mode in
generally requires that the event loop is entered, e.g. by calling
\fBTcl_DoOneEvent\fR or \fBvwait\fR or by using Tk, to give Tcl a chance to
process events on the channel.
.TP
\fB\-buffering\fR \fInewValue\fR
.
If \fInewValue\fR is \fBfull\fR, which is the default, output is buffered
until the internal buffer is full or until \fBchan flush\fR is called. If
\fInewValue\fR is \fBline\fR, output is flushed each time a end-of-line
character is written. If \fInewValue\fR is \fBnone\fR, output is flushed after
every output operation. For \fBstdin\fR, \fBstdout\fR, and channels that
connect to terminal-like devices, the default value is \fBline\fR. For
\fBstderr\fR the default value is \fBnone\fR.
.TP
\fB\-buffersize\fR \fInewSize\fR
.
\fInewSize\fR, an integer no greater than one million, is the size in bytes of
any input or output buffers subsequently allocated for this channel.
.TP
\fB\-encoding\fR ?\fIname\fR?
.
Sets the encoding of the channel. \fIname\fR is either one of the names
returned by \fBencoding names\fR, or
.QW \fBbinary\fR
\&. Input is converted from the encoding into Unicode, and output is converted
from Unicode to the encoding.
.RS
.PP
\fBbinary\fR is an alias for \fBiso8859-1\fR: Each byte read from the
channel becomes the Unicode character having the same value as that byte, and
each character written to the channel becomes a single byte in the output,
allowing Tcl to work seamlessly with binary data as long as each "character" in
the data remains in the range of 0 to 255 so that there is no distinction between
binary data and text. For example, A JPEG image can be read from a
\fBbinary\fR channel, manipulated, and then written back to a \fBbinary\fR
channel.
For working with binary data \fB\-translation binary\fR is usually used
instead, as it sets the encoding to \fBbinary\fR and also disables other
translations on the channel.
.PP
The encoding of a new channel is the value of \fBencoding system\fR,
which returns the platform- and locale-dependent system encoding used to
interface with the operating system,
.RE
.TP
\fB\-eofchar\fR \fIchar\fR
.TP
\fB\-eofchar\fR \fB{\fIinChar outChar\fB}\fR
.
\fIchar\fR signals the end of the data when it is encountered in the input.
For output, the character is added when the channel is closed. If \fIchar\fR
is the empty string, there is no special character that marks the end of the
data. For read-write channels, one end-of-file character for input and another
for output may be given. When only one end-of-file character is given it is
applied to both input and output. For a read-write channel two values are
returned even if they are are identical.
The default value is the empty string, except that under Windows the default
value for reading is Control-z (\ex1A). The acceptable range is \ex01 -
\ex7f. A value outside this range results in an error.
.TP
\fB\-translation\fR \fItranslation\fR
.TP
\fB\-translation\fR \fB{\fIinTranslation outTranslation\fB}\fR
.
In Tcl a single line feed (\en) represents the end of a line. However,
at the destination the end of a line may be represented differently on
different platforms, or even for different devices on the same platform. For
example, under UNIX line feed is used in files and a
carriage-return-linefeed sequence is normally used in network connections.
Therefore, on input, e.g. with \fBchan gets\fR and \fBchan read\fR, each
external end-of-line character is translated into a line feed. On
output, e.g. with \fBchan puts\fR, each line feed is translated to the external
end-of-line character. The default translation, \fBauto\fR, handles all the common
cases, and \fB\-translation\fR provides explicit control over the end-of-line
character.
.RS
.PP
Returns the input translation for a read-only channel, the output translation
for a write-only channel, and both the input translation and the the output
translation for a read-write channel. When two translations are given, they
are the input and output translation, respectively. When only one translation
is given for a read-write channel, it is the translation for both input and
output. The following values are currently supported:
.TP
\fBauto\fR
.
The default. For input each occurrence of a line feed (\fBlf\fR), carriage
return (\fBcr\fR), or carriage return followed by a line feed (\fBcrlf\fR) is
translated into a line feed. For output, each line feed is translated into a
platform-specific representation: For all Unix variants it is \fBlf\fR, and
for all Windows variants it is \fBcrlf\fR, except that for sockets on all
platforms it is \fBcrlf\fR for both input and output.
.TP
\fBbinary\fR
.
Like \fBlf\fR, no end-of-line translation is performed, but in addition,
\fB\-eofchar\fR is set to the empty string to disable it, and \fB\-encoding\fR
is set to \fBbinary\fR. With this one setting, a channel is fully configured
for binary input and output.
.TP
\fBcr\fR
.
The end of a line is represented in the external data by a single carriage
return character. For input, each carriage return is translated to a line
feed, and for output each line feed character is translated to a carriage
return.
.TP
\fBcrlf\fR
.
The end of a line is represented in the external data by a carriage return
character followed by a line feed. For input, each carriage-return-linefeed
sequence is translated to a line feed. For output, each line feed is
translated to a carriage-return-linefeed sequence. This translation is
typically used for network connections, and also on Windows systems.
.TP
\fBlf\fR
.
The end of a line in the external data is represented by a line feed so no
translations occur during either input or output. This translation is
typically used on UNIX platforms,
.RE
.RE
.TP
\fBchan copy \fIinputChan outputChan\fR ?\fB\-size \fIsize\fR? ?\fB\-command \fIcallback\fR?
.
Copies data from \fIinputChan\fR to \fIoutputChan\fR, leveraging internal
buffers to avoid extra copies and to avoid buffering too much data in main
memory when copying large files to slow destinations like network sockets.
.RS
.PP
If \fB\-size\fR is given, the size is in bytes if the two channels have the
same encoding and in characters otherwise, and only that amount is copied.
Otherwise, all data until the end of the file is copied.
\fBchan copy\fR blocks until the copy is complete and returns the number of
bytes or characters written to \fIoutputChan\fR.
.PP
If \fB\-command\fR is given, \fBchan copy\fR returns immediately, the copy is
carried out in the background, and then \fIcallback\fR is called with the
number of bytes written to \fIoutputChan\fR as its first argument, and the
error message for any error that occurred as its second argument.
\fIinputChan\fR and \fIoutputChan\fR are automatically configured for
non-blocking mode if needed. Background copying only works correctly if the
event loop is active, e.g. via \fBvwait\fR or Tk.
.PP
During a background copy no other read or write operation may be performed on
\fIinputChan\fR or \fIoutputChan\fR. If either \fIinputChan\fR or
\fIoutputChan\fR is closed while the copy is in progress copying ceases and
\fBno\fR callback is made. If \fIinputChan\fR is closed all data already queued
is written to \fIoutputChan\fR.
.PP
The should be no event handler established for \fIinputChan\fR because it may
become readable during a background copy. An attempt to read or write
from within an event handler results result in the error, "channel busy".
.PP
Due to end-of-line translation the number of bytes read from \fIinputChan\fR
may be different than the number of bytes written to \fIoutputChan\fR. Only
the number of bytes written to \fIoutputChan\fR is reported.
.PP
\fBChan copy\fR reads the data according to the \fB\-encoding\fR,
\fB\-translation\fR, and \fB\-eofchar\fR of the source and writes to the
destination according to the configuration for that channel. If the encoding
and translation of both channels is \fBbinary\fR and the \fB\-eofchar\fR of
both channels is the empty string, an identical copy is made. If only the
encoding of the destination is \fBbinary\fR, Tcl's internal modified UTF-8
representation of the characters read from the source is written to the
destination. If only the encoding of the source is \fBbinary\fR, each byte read
becomes one Unicode character in the range of 0 to 255, and that character is
subject to the encoding and translation of the destination as it is written.
.RE
.TP
\fBchan create \fImode cmdPrefix\fR
.
Creates a new channel, called a \fBreflected\fR channel, with \fIcmdPrefix\fR
as its handler, and returns the name of the channel. \fBcmdPrefix\fR is the
first words of a command that provides the interface for a \fBrefchan\fR.
.RS
.PP
\fBImode\fR is a list of one or more of the strings
.QW \fBread\fR
or
.QW \fBwrite\fR
, indicating whether the channel is a read channel, a write channel, or both.
It is an error if the handler does not support the chosen mode.
.PP
The handler is called as needed from the global namespace at the top level, and
command resolution happens there at the time of the call. If the handler is
renamed or deleted any subsequent attempt to call it is an error, which may
not be able to describe the failure.
.PP
The handler is always called in the interpreter and thread it was created in,
even if the channel was shared with or moved into a different interpreter in a
different thread. This is achieved through event dispatch, so if the event
loop is not entered, e.g. by calling \fBTcl_DoOneEvent\fR or \fBvwait\fR or
using Tk, the thread performing the channel operation \fIblocks
indefinitely\fR, resulting in deadlock.
.PP
One side of a channel may be in one thread while the other side is in a
different thread, providing a stream-oriented bridge between the threads. This
provides a method for regular stream communication between threads as an
alternative to sending commands.
.PP
When the interpreter the handler is in is deleted each channel associated with
the handler is deleted as well, regardless of which interpreter or thread it
is currently in or shared with.
.PP
\fBchan create\fR is \fBsafe\fR and is accessible to safe interpreters. The
handler is always called in the safe interpreter it was created in.
.RE
.TP
\fBchan eof \fIchannelName\fR
.
Returns 1 if the last read on the channel failed because the end of the data
was already reached, and 0 otherwise.
.TP
\fBchan event \fIchannelName event\fR ?\fIscript\fR?
.
Arranges for the given script, called a \fBchannel event hndler\fR, to be
called whenever the given event, one of
.QW \fBreadable\fR
or
.QW \fBwritable\fR
occurs on the given channel, replacing any script that was previously set. If
\fIscript\fR is the empty string the current handler is deleted. It is also
deleted when the channel is closed. If \fIscript\fR is omitted, either the
existing script or the empty string is returned. The event loop must be
entered, e.g. via \fBvwait\fR or \fBupdate\fR, or by using Tk, for handlers to
be evaluated.
.RS
.PP
\fIscript\fR is evaluated at the global level in the interpreter it was
established in. Any resulting error is handled in the background, i.e. via
\fBinterp bgerror\fR. In order to prevent an endless loop due to a buggy
handler, the handler is deleted if \fIscript\fR returns an error so that it is
not evaluated again.
.PP
Without an event handler, \fBchan gets\fR or \fBchan read\fR on a channel in
blocking mode may block until data becomes available, become during which the
thread is unable to perform other work or respond to events on other channels.
This could cause the application to appear to
.QW "freeze up"
\&.
Channel event handlers allow events on the channel to direct channel handling
so that the reader or writer can continue to perform other processing while
waiting for a channel to become available and then handle channel operations
when the channel is ready for the operation.
.PP
A
.QW readable
event occurs when there is data that can be read from the channel and also when
there is an error on the channel. The handler must check for these conditions
and handle them appropriately. For example, a handler that does not check
whether the end of the data has been reached may be repeatedly evaluated in a
busy loop until the channel is closed.
.PP
A
.QW writable
event occurs when at least one byte of data can be written, or if there is an
error on the channel. A client socket opened in non-blocking mode becomes
writable when it becomes connected or if the connection fails.
.PP
Event-driven channel handling works best for channels in non-blocking mode. A
channel in blocking mode blocks when \fBchan puts\fR writes more data than the
channel can accept at the moment, and when \fBchan gets\fR or \fBchan read\fR
requests more data than is currently available. When a channel blocks, the
thread can not do any other processing or service any other events. A channel
in non-blocking mode allows a thread to carry on with other work and get back
to the channel at the right time.
.RE
.TP
\fBchan flush \fIchannelName\fR
.
For a channel in blocking mode, flushes all buffered output to the destination,
and then returns. For a channel in non-blocking mode, returns immediately
while all buffered output is flushed in the background as soon as possible.
.TP
\fBchan gets \fIchannelName\fR ?\fIvarName\fR?
.
Returns the next line from the channel, removing the trailing line feed, or if
\fIvarName\fR is given, assigns the line to that variable and returns the
number of characters read.
the line that was read, removing the trailing line feed, or returns the
empty string if there is no data to return and the end of the file has been
reached, or in non-blocking mode, if no complete line is currently available.
If \fIvarName\fR is given, assigns the line that was read to variable named
\fIvarName\fR and returns the number of characters that were read, or -1 if
there no data available and the end of the channel was reached or the channel
is in non-blocking mode.
.RS
.PP
If the end of the channel is reached the data read so far is returned or
assigned to \fIvarName\fR. When \fIvarName\fR is not given, \fBchan eof\fR may
indicate that the empty string means that the end of the data has been reached,
and \fBchan blocked\fR may indicate that that the empty string means there
isn't currently enough data do return the next line.
.RE
.TP
\fBchan names\fR ?\fIpattern\fR?
.
Returns a list of all channel names, or if \fIpattern\fR is given, only those
names that match according to the rules of \fBstring match\fR.
.TP
\fBchan pending \fImode channelName\fR
.
Returns the number of bytes of input
when \fImode\fR is
.QW\fBinput\fR
, or output when \fImode\fR is
.QW\fBoutput\fR
, that are currently internally buffered for the channel. Useful in a readable
event callback to impose limits on input line length to avoid a potential
denial-of-service attack where an extremely long line exceeds the available
memory to buffer it. Returns -1 if the channel was not opened for the mode in
question.
.TP
\fBchan pipe\fR
Creates a pipe, i.e. a readable channel and a writable channel, and returns the
names of the readable channel and the writable channel. Data written to the
writable channel can be read from the readable channel. Because the pipe is a
real system-level pipe, it can be connected to other processes using
redirection. For example, to redirect \fBstderr\fR from a subprocess into one
channel, and \fBstdout\fR into another, \fBexec\fR with "2>@" and ">@", each
onto the writable side of a pipe, closing the writable side immediately
thereafter so that EOF is signaled on the read side once the subprocess has
closed its output, typically on exit.
.RS
.PP
Due to buffering, data written to one side of a pipe might not immediately
become available on the other side. Tcl's own buffers can be configured via
\fBchan configure -buffering\fR, but overall behaviour still depends on
operating system buffers outside of Tcl's control. Once the write side of the
channel is closed, any data remaining in the buffers is flushed through to the
read side. It may be useful to arrange for the connected process to flush at
some point after writing to the channel or to have it use some system-provided
mechanism to configure buffering. When two pipes are connected to the same
process, one to send data to the process, and one to read data from the
process, a deadlock may occur if the channels are in blocking mode: If
reading, the channel may block waiting for data that can never come because
buffers are only flushed on subsequent writes, and if writing, the channel may
block while waiting for the buffers to become free, which can never happen
because the reader can not read while the writer is blocking. To avoid this
issue, either put the channels into non-blocking mode and use event handlers,
or place the read channel and the write channel in separate interpreters in
separate threads.
.RE
.TP
\fBchan pop \fIchannelName\fR
Removes the topmost transformation handler from the channel if there is one,
and closes the channel otherwise. The result is normally the empty string, but
may be an error in some situations, e.g. when closing the underlying resource
results in an error.
.TP
\fBchan postevent \fIchannelName eventSpec\fR
.
For use by handlers established with \fBchan create\fR. Notifies Tcl that
that one or more event(s) listed in \fIeventSpec\fR, each of which is either
.QW\fBread\fR
or
.QW\fBwrite\fR.
, have occurred.
.RS
.PP
For use only by handlers for a channel created by \fBchan create\fR. It is an
error to post an event for any other channel.
.PP
Since only the handler for a reflected channel channel should post events it is
an error to post an event from any interpreter other than the interpreter that
created the channel.
.PP
It is an error to post an event that the channel has no interest in. See
\fBwatch\fR in the \fBrefchan\fR documentation for more information
.PP
\fBchan postevent\fR is available in safe interpreters, as any handler for a
reflected channel would have been created, and will be evaluated in that
interpreter as well.
.RE
.TP
\fBchan push \fIchannelName cmdPrefix\fR
Adds a new transformation handler on top of the channel and returns a handle
for the transformation. \fIcmdPrefix\fR is the first words of a command that
provides the interface documented for \fBtranschan\fR, and transforms data on
the channel, It is an error if handler does not support the mode(s) the channel
is in.
.TP
\fBchan puts\fR ?\fB\-nonewline\fR? ?\fIchannelName\fR? \fIstring\fR
.
Writes \fIstring\fR and a line feed to the channel. If \fB\-nonewline\fR is
given, the trailing line feed is not written. The default channel is
\fBstdout\fR.
.RS
.PP
Each line feed in the output is translated according to the configuration of
\fB\-translation\fR.
.PP
Because Tcl internally buffers output, characters written to a channel may not
immediately be available at the destination. Tcl normally delays output until
the buffer is full or the channel is closed. \fBchan flush\fR forces output in
the direction of the destination.
.PP
When the output for a channel in blocking mode fills up, \fBchan puts\fR blocks
until space in the buffer is available again, but for a channel in non-blocking
mode, it returns immediately and the data is written in the background as fast
possible, constrained by the speed at which as the destination accepts it.
Output to a channel in non-blocking mode only works properly when the
application enters the event loop, giving Tcl a chance to find out that the
destination is ready to accept more data. When a channel is in non-blocking
mode, Tcl's internal buffers can hold an arbitrary amount of data, possibly
consuming a large amount of memory. To avoid wasting memory, channels in
non-blocking mode should normally be handled using \fBchan event\fR, where the
application only invokes \fBchan puts\fR after being recently notified through
a file event handler that the channel is ready for more output data.
.RE
.TP
\fBchan read \fIchannelName\fR ?\fInumChars\fR?
.TP
\fBchan read \fR?\fB\-nonewline\fR? \fIchannelName\fR
.
Reads and returns the next \fInumChars\fR characters from the channel. If
\fInumChars\fR is omitted, all available characters up to the end of the file
are read, or if the channel is in non-blocking mode, all currently-available
characters are read. If there is an error on the channel, reading ceases and
an error is returned. If \fInumChars\fR is not given, \fB\-nonewline\fR
may be given, causing any any trailing line feed to be trimmed.
.RS
.PP
If the channel is in non-blocking mode, fewer characters than requested may be
returned. If the channel is configured to use a multi-byte encoding, bytes
that do not form a complete character are retained in the buffers until enough
bytes to complete the character accumulate, or the end of the data is reached.
\fB\-nonewline\fR is ignored if characters are returned before reaching the end
of the file.
.PP
Each end-of-line sequence according to the value of \fB\-translation\fR is
translated into a line feed.
.PP
When reading from a serial port, most applications should configure the serial
port channel to be in non-blocking mode, but not necessarily use an event
handler since most serial ports are comparatively slow. It is entirely
possible to get a \fBreadable\fR event for each individual character. In
blocking mode, \fBchan read\fR blocks forever when reading to the end of the
data if there is no \fBchan configure -eofchar\fR configured for the channel.
.RE
.TP
\fBchan seek \fIchannelName offset\fR ?\fIorigin\fR?
.
Sets the current position for the data in the channel to integer \fIoffset\fR
bytes relative to \fIorigin\fR. A negative offset moves the current position
backwards from the origin. \fIorigin\fR is one of the
following:
.RS
.PP
.TP 10
\fBstart\fR
.
The origin is the start of the data. This is the default.
.TP 10
\fBcurrent\fR
.
The origin is the current position.
.TP 10
\fBend\fR
.
The origin is the end of the data.
.PP
\fBChan seek\fR flushes all buffered output even if the channel is in
non-blocking mode, discards any buffered and unread input, and returns the
empty string or an error if the channel does not support seeking.
.PP
\fIoffset\fR values are byte offsets, not character offsets. Unlike \fBchan
read\fR, both \fBchan seek\fR and \fBchan tell\fR operate in terms of bytes,
not characters,
.RE
.TP
\fBchan tell \fIchannelName\fR
.
Returns the offset in bytes of the current position in the underlying data, or
-1 if the channel does not suport seeking. The value can be passed to \fBchan
seek\fR to set current position to that offset.
.TP
\fBchan truncate \fIchannelName\fR ?\fIlength\fR?
.
Flushes the channel and truncates the data in the channel to \fIlength\fR
bytes, or to the current position in bytes if \fIlength\fR is omitted.
.
.SH EXAMPLES
.PP
In the following example a file is opened using the encoding CP1252, which is
common on Windows, searches for a string, rewrites that part, and truncates the
file two lines later.
.PP
.CS
set f [open somefile.txt r+]
\fBchan configure\fR $f -encoding cp1252
set offset 0
\fI# Search for string "FOOBAR" in the file\fR
|
| ︙ | ︙ | |||
789 790 791 792 793 794 795 |
\fI# Save offset of start of next line for later\fR
set offset [\fBchan tell\fR $f]
}
\fBchan close\fR $f
.CE
.PP
| | | | | 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 |
\fI# Save offset of start of next line for later\fR
set offset [\fBchan tell\fR $f]
}
\fBchan close\fR $f
.CE
.PP
A network server that echoes its input line-by-line without
preventing servicing of other connections at the same time:
.PP
.CS
# This is a very simple logger...
proc log message {
\fBchan puts\fR stdout $message
}
# This is called whenever a new client connects to the server
proc connect {chan host port} {
set clientName [format <%s:%d> $host $port]
log "connection from $clientName"
|
| ︙ | ︙ |
Changes to doc/clock.n.
| ︙ | ︙ | |||
819 820 821 822 823 824 825 | hours, minutes, and seconds (if six digits are present) from UTC. The plus sign denotes a sign east of Greenwich; the minus sign one west of Greenwich. .PP A time zone string conforming to the Posix specification of the \fBTZ\fR environment variable will be recognized. The specification may be found at | | | 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 | hours, minutes, and seconds (if six digits are present) from UTC. The plus sign denotes a sign east of Greenwich; the minus sign one west of Greenwich. .PP A time zone string conforming to the Posix specification of the \fBTZ\fR environment variable will be recognized. The specification may be found at \fIhttps://pubs.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html\fR. .PP If the Posix time zone string contains a DST (Daylight Savings Time) part, but doesn't contain a rule stating when DST starts or ends, then default rules are used. For Timezones with an offset between 0 and +12, the current European/Russian rules are used, otherwise the current US rules are used. In Europe (offset +0 to +2) the switch to summertime is done each last Sunday in March at 1:00 GMT, and |
| ︙ | ︙ | |||
843 844 845 846 847 848 849 | rules change again. .PP Any other time zone string is processed by prefixing a colon and attempting to use it as a location name, as above. .SH "LOCALIZATION" .PP Developers wishing to localize the date and time formatting and parsing | | | 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 | rules change again. .PP Any other time zone string is processed by prefixing a colon and attempting to use it as a location name, as above. .SH "LOCALIZATION" .PP Developers wishing to localize the date and time formatting and parsing are referred to \fIhttps://tip.tcl-lang.org/173\fR for a specification. .SH "FREE FORM SCAN" .PP If the \fBclock scan\fR command is invoked without a \fB\-format\fR option, then it requests a \fIfree-form scan.\fR \fI This form of scan is deprecated.\fR The reason for the deprecation is that there are too many ambiguities. (Does the string |
| ︙ | ︙ |
Changes to doc/cookiejar.n.
| ︙ | ︙ | |||
178 179 180 181 182 183 184 | package require http \fBpackage require cookiejar\fR set cookiedb ~/.tclcookies.db http::configure -cookiejar [\fBhttp::cookiejar new\fR $cookiedb] # No further explicit steps are required to use cookies | | | 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 | package require http \fBpackage require cookiejar\fR set cookiedb ~/.tclcookies.db http::configure -cookiejar [\fBhttp::cookiejar new\fR $cookiedb] # No further explicit steps are required to use cookies set tok [http::geturl http://core.tcl-lang.org/] .CE .PP To only allow a particular domain to use cookies, perhaps because you only want to enable a particular host to create and manipulate sessions, create a subclass that imposes that policy. .PP .CS |
| ︙ | ︙ | |||
201 202 203 204 205 206 207 |
}
}
set cookiedb ~/.tclcookies.db
http::configure -cookiejar [MyCookieJar new $cookiedb]
# No further explicit steps are required to use cookies
| | | 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 |
}
}
set cookiedb ~/.tclcookies.db
http::configure -cookiejar [MyCookieJar new $cookiedb]
# No further explicit steps are required to use cookies
set tok [http::geturl http://core.tcl-lang.org/]
.CE
.SH "SEE ALSO"
http(n), oo::class(n), sqlite3(n)
.SH KEYWORDS
cookie, internet, security policy, www
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
|
Changes to doc/dde.n.
| ︙ | ︙ | |||
168 169 170 171 172 173 174 | .SH EXAMPLE .PP This asks Internet Explorer (which must already be running) to go to a particularly important website: .PP .CS package require dde | | | 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 | .SH EXAMPLE .PP This asks Internet Explorer (which must already be running) to go to a particularly important website: .PP .CS package require dde \fBdde execute\fR -async iexplore WWW_OpenURL http://www.tcl-lang.org/ .CE .SH "SEE ALSO" tk(n), winfo(n), send(n) .SH KEYWORDS application, dde, name, remote execution '\"Local Variables: '\"mode: nroff |
| ︙ | ︙ |
Changes to doc/encoding.n.
| ︙ | ︙ | |||
77 78 79 80 81 82 83 | \fBencoding system\fR ?\fIencoding\fR? . Set the system encoding to \fIencoding\fR. If \fIencoding\fR is omitted then the command returns the current system encoding. The system encoding is used whenever Tcl passes strings to system calls. .SH EXAMPLE .PP | < | < < < < < < < < < < < < < < < | | 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 | \fBencoding system\fR ?\fIencoding\fR? . Set the system encoding to \fIencoding\fR. If \fIencoding\fR is omitted then the command returns the current system encoding. The system encoding is used whenever Tcl passes strings to system calls. .SH EXAMPLE .PP The following example converts a byte sequence in Japanese euc-jp encoding to a TCL string: .PP .CS set s [\fBencoding convertfrom\fR euc-jp "\exA4\exCF"] .CE .PP The result is the unicode codepoint: .QW "\eu306F" , which is the Hiragana letter HA. .SH "SEE ALSO" Tcl_GetEncoding(3) .SH KEYWORDS encoding, unicode .\" Local Variables: |
| ︙ | ︙ |
Changes to doc/exec.n.
| ︙ | ︙ | |||
18 19 20 21 22 23 24 25 26 27 28 29 30 31 | .SH DESCRIPTION .PP This command treats its arguments as the specification of one or more subprocesses to execute. The arguments take the form of a standard shell pipeline where each \fIarg\fR becomes one word of a command, and each distinct command becomes a subprocess. .PP If the initial arguments to \fBexec\fR start with \fB\-\fR then they are treated as command-line switches and are not part of the pipeline specification. The following switches are currently supported: .TP 13 \fB\-ignorestderr\fR | > > > > | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | .SH DESCRIPTION .PP This command treats its arguments as the specification of one or more subprocesses to execute. The arguments take the form of a standard shell pipeline where each \fIarg\fR becomes one word of a command, and each distinct command becomes a subprocess. The result of the command is the standard output of the final subprocess in the pipeline, interpreted using the system \fBencoding\fR; to use any other encoding (especially including binary data), the pipeline must be \fBopen\fRed, configured and read explicitly. .PP If the initial arguments to \fBexec\fR start with \fB\-\fR then they are treated as command-line switches and are not part of the pipeline specification. The following switches are currently supported: .TP 13 \fB\-ignorestderr\fR |
| ︙ | ︙ | |||
407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 | .CE .PP With the file \fIcmp.bat\fR looking something like: .PP .CS @gcc %* .CE or like another variant using single parameters: .CS @gcc %1 %2 %3 %4 %5 %6 %7 %8 %9 .CE .SS "WORKING WITH COMMAND BUILT-INS" .PP Sometimes you need to be careful, as different programs may have the same name and be in the path. It can then happen that typing a command | > > | 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 | .CE .PP With the file \fIcmp.bat\fR looking something like: .PP .CS @gcc %* .CE .PP or like another variant using single parameters: .PP .CS @gcc %1 %2 %3 %4 %5 %6 %7 %8 %9 .CE .SS "WORKING WITH COMMAND BUILT-INS" .PP Sometimes you need to be careful, as different programs may have the same name and be in the path. It can then happen that typing a command |
| ︙ | ︙ |
Changes to doc/expr.n.
| ︙ | ︙ | |||
13 14 15 16 17 18 19 | .SH NAME expr \- Evaluate an expression .SH SYNOPSIS \fBexpr \fIarg \fR?\fIarg arg ...\fR? .BE .SH DESCRIPTION .PP | | | | | < | | | | | > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > | | > > | | | | > | > > > > | < < < | > | > | | > | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 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 |
.SH NAME
expr \- Evaluate an expression
.SH SYNOPSIS
\fBexpr \fIarg \fR?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
Concatenates \fIarg\fRs, separated by a space, into an expression, and evaluates
that expression, returning its value.
The operators permitted in an expression include a subset of
the operators permitted in C expressions. For those operators
common to both Tcl and C, Tcl applies the same meaning and precedence
as the corresponding C operators.
The value of an expression is often a numeric result, either an integer or a
floating-point value, but may also be a non-numeric value.
For example, the expression
.PP
.CS
\fBexpr\fR 8.2 + 6
.CE
.PP
evaluates to 14.2.
Expressions differ from C expressions in the way that
operands are specified. Expressions also support
non-numeric operands, string comparisons, and some
additional operators not found in C.
.PP
When the result of expression is an integer, it is in decimal form, and when
the result is a floating-point number, it is in the form produced by the
\fB%g\fR format specifier of \fBformat\fR.
.PP
.VS "TIP 582"
At any point in the expression except within double quotes or braces, \fB#\fR
is the beginning of a comment, which lasts to the end of the line or
the end of the expression, whichever comes first.
.VE "TIP 582"
.SS OPERANDS
.PP
An expression consists of a combination of operands, operators, parentheses and
commas, possibly with whitespace between any of these elements, which is
ignored. Each operand is intepreted as a numeric value if at all possible.
.PP
Each operand has one of the following forms:
.RS
.PP
.TP
A \fBnumeric value\fR
.PP
.RS
.
Either integer or floating-point. The first two characters of an integer may
also be \fB0d\fR for decimal, \fB0b\fR for binary, \fB0o\fR for octal or
\fB0x\fR for hexadicimal. For compatibility with older Tcl releases, an
operand that begins with \fB0\fR is interpreted as an octal integer even if the
second character is not \fBo\fR.
.PP
A floating-point number may be take any of several
common decimal formats, and may use the decimal point \fB.\fR,
\fBe\fR or \fBE\fR for scientific notation, and
the sign characters \fB+\fR and \fB\-\fR. The
following are all valid floating-point numbers: 2.1, 3., 6e4, 7.91e+16.
The strings \fBInf\fR
and \fBNaN\fR, in any combination of case, are also recognized as floating point
values. An operand that doesn't have a numeric interpretation must be quoted
with either braces or with double quotes.
.PP
Digits in any numeric value may be separated with one or more underscore
characters, "\fB_\fR". A separator may only
appear between digits, not appear at the start of a
numeric value, between the leading 0 and radix specifier, or at the
end of a numeric value. Here are some examples:
.PP
.CS
.ta 9c
\fBexpr\fR 100_000_000 \fI100000000\fR
\fBexpr\fR 0xffff_ffff \fI4294967295\fR
\fBformat\fR 0x%x 0b1111_1110_1101_1011 \fI0xfedb\fR
.CE
.RE
.TP
A \fBboolean value\fR
.
Using any form understood by \fBstring is\fR
\fBboolean\fR.
.TP
A \fBvariable\fR
.
Using standard \fB$\fR notation.
The value of the variable is the value of the operand.
.TP
A string enclosed in \fBdouble-quotes\fR
.
Backslash, variable, and command substitution are performed according to the
rules for \fBTcl\fR.
.TP
A string enclosed in \fBbraces\fR.
The operand is treated as a braced value according to the rule for braces in
\fBTcl\fR.
.TP
A Tcl command enclosed in \fBbrackets\fR
.
Command substitution is performed as according to the command substitution rule
for \fBTcl\fR.
.TP
A mathematical function such as \fBsin($x)\fR, whose arguments have any of the above
forms for operands. See \fBMATH FUNCTIONS\fR below for
a discussion of how mathematical functions are handled.
.RE
.PP
Because \fBexpr\fR parses and performs substitutions on values that have
already been parsed and substituted by \fBTcl\fR, it is usually best to enclose
expressions in braces to avoid the first round of substitutions by
\fBTcl\fR.
.PP
Below are some examples of simple expressions where the value of \fBa\fR is 3
and the value of \fBb\fR is 6. The command on the left side of each line
produces the value on the right side.
.PP
.CS
.ta 9c
\fBexpr\fR {3.1 + $a} \fI6.1\fR
\fBexpr\fR {2 + "$a.$b"} \fI5.6\fR
\fBexpr\fR {4*[llength {6 2}]} \fI8\fR
\fBexpr\fR {{word one} < "word $a"} \fI0\fR
.CE
.PP
.SS OPERATORS
.PP
For operators having both a numeric mode and a string mode, the numeric mode is
chosen when all operands have a numeric interpretation. The integer
interpretation of an operand is preferred over the floating-point
interpretation. To ensure string operations on arbitrary values it is generally a
|
| ︙ | ︙ |
Changes to doc/http.n.
1 2 3 4 5 6 7 8 | '\" '\" 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. '\" | | | | 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) 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 .SH SYNOPSIS \fBpackage require http\fI ?\fB2.10\fR? .\" See Also -useragent option documentation in body! .sp \fB::http::config\fR ?\fI\-option value\fR ...? .sp \fB::http::geturl \fIurl\fR ?\fI\-option value\fR ...? .sp \fB::http::formatQuery\fR \fIkey value\fR ?\fIkey value\fR ...? |
| ︙ | ︙ |
Changes to doc/load.n.
| ︙ | ︙ | |||
52 53 54 55 56 57 58 | initializes the safe interpreter only with partial functionality provided by the library that is safe for use by untrusted code. For more information on Safe\-Tcl, see the \fBsafe\fR manual entry. .PP The initialization procedure must match the following prototype: .PP .CS | | | 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 |
initializes the safe interpreter only with partial functionality provided
by the library that is safe for use by untrusted code. For more information
on Safe\-Tcl, see the \fBsafe\fR manual entry.
.PP
The initialization procedure must match the following prototype:
.PP
.CS
typedef int \fBTcl_LibraryInitProc\fR(
Tcl_Interp *\fIinterp\fR);
.CE
.PP
The \fIinterp\fR argument identifies the interpreter in which the
library is to be loaded. The initialization procedure must return
\fBTCL_OK\fR or \fBTCL_ERROR\fR to indicate whether or not it completed
successfully; in the event of an error it should set the interpreter's result
|
| ︙ | ︙ | |||
75 76 77 78 79 80 81 | For Tcl versions lower than 8.5, it is not possible to unload or reload a library. From version 8.5 however, the \fBunload\fR command allows the unloading of libraries loaded with \fBload\fR, for libraries that are aware of the Tcl's unloading mechanism. .PP The \fBload\fR command also supports libraries that are statically linked with the application, if those libraries have been registered | | | | 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 |
For Tcl versions lower than 8.5, it is not possible to unload or reload a
library. From version 8.5 however, the \fBunload\fR command allows the unloading
of libraries loaded with \fBload\fR, for libraries that are aware of the
Tcl's unloading mechanism.
.PP
The \fBload\fR command also supports libraries that are statically
linked with the application, if those libraries have been registered
by calling the \fBTcl_StaticLibrary\fR procedure.
If \fIfileName\fR is an empty string, then \fIprefix\fR must
be specified.
.PP
If \fIprefix\fR is omitted or specified as an empty string,
Tcl tries to guess the prefix. This may be done differently on
different platforms. The default guess, which is used on most
UNIX platforms, is to take the last element of
\fIfileName\fR, strip off the first three characters if they
are \fBlib\fR, then strip off the next three characters if they
are \fBtcl\fR, and use any following alphabetic and
underline characters, converted to titlecase as the prefix.
For example, the command \fBload libxyz4.2.so\fR uses the prefix
\fBXyz\fR and the command \fBload bin/last.so {}\fR uses the
prefix \fBLast\fR.
.PP
If \fIfileName\fR is an empty string, then \fIprefix\fR must
be specified.
The \fBload\fR command first searches for a statically loaded library
(one that has been registered by calling the \fBTcl_StaticLibrary\fR
procedure) by that name; if one is found, it is used.
Otherwise, the \fBload\fR command searches for a dynamically loaded
library by that name, and uses it if it is found. If several
different files have been \fBload\fRed with different versions of
the library, Tcl picks the file that was loaded first.
.PP
If \fB\-global\fR is specified preceding the filename, all symbols
|
| ︙ | ︙ | |||
184 185 186 187 188 189 190 |
}
}
# Now execute the command defined by the extension
foo
.CE
.SH "SEE ALSO"
| | | 184 185 186 187 188 189 190 191 192 193 194 195 196 |
}
}
# Now execute the command defined by the extension
foo
.CE
.SH "SEE ALSO"
info sharedlibextension, package(n), Tcl_StaticLibrary(3), safe(n)
.SH KEYWORDS
binary code, dynamic library, load, safe interpreter, shared library
'\"Local Variables:
'\"mode: nroff
'\"End:
|
Changes to doc/msgcat.n.
| ︙ | ︙ | |||
731 732 733 734 735 736 737 |
.SH EXAMPLES
Packages which display a GUI may update their widgets when the global locale changes.
To register to a callback, use:
.CS
namespace eval gui {
msgcat::mcpackageconfig changecmd updateGUI
| | | 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 |
.SH EXAMPLES
Packages which display a GUI may update their widgets when the global locale changes.
To register to a callback, use:
.CS
namespace eval gui {
msgcat::mcpackageconfig changecmd updateGUI
proc updateGUI args {
puts "New locale is '[lindex $args 0]'."
}
}
% msgcat::mclocale fr
fr
% New locale is 'fr'.
.CE
|
| ︙ | ︙ | |||
765 766 767 768 769 770 771 | First, a package locale is initialized and the generic unknown function is desactivated: .CS msgcat::mcpackagelocale set msgcat::mcpackageconfig unknowncmd "" .CE As an example, the user requires the week day in a certain locale as follows: .CS | | | 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 | First, a package locale is initialized and the generic unknown function is desactivated: .CS msgcat::mcpackagelocale set msgcat::mcpackageconfig unknowncmd "" .CE As an example, the user requires the week day in a certain locale as follows: .CS clock format [clock seconds] -format %A -locale fr .CE \fBclock\fR sets the package locale to \fBfr\fR and looks for the day name as follows: .CS msgcat::mcpackagelocale set $locale return [lindex [msgcat::mc DAYS_OF_WEEK_FULL] $day] ### Returns "mercredi" .CE |
| ︙ | ︙ |
Changes to doc/open.n.
| ︙ | ︙ | |||
68 69 70 71 72 73 74 | All of the legal \fIaccess\fR values above may have the character \fBb\fR added as the second or third character in the value to indicate that the opened channel should be configured as if with the \fBfconfigure\fR \fB\-translation binary\fR option, making the channel suitable for reading or writing of binary data. .PP In the second form, \fIaccess\fR consists of a list of any of the | | | 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 | All of the legal \fIaccess\fR values above may have the character \fBb\fR added as the second or third character in the value to indicate that the opened channel should be configured as if with the \fBfconfigure\fR \fB\-translation binary\fR option, making the channel suitable for reading or writing of binary data. .PP In the second form, \fIaccess\fR consists of a list of any of the following flags, most of which have the standard POSIX meanings. One of the flags must be either \fBRDONLY\fR, \fBWRONLY\fR or \fBRDWR\fR. .TP 15 \fBRDONLY\fR . Open the file for reading only. .TP 15 \fBWRONLY\fR |
| ︙ | ︙ | |||
449 450 451 452 453 454 455 456 457 458 459 460 461 462 | some will be sent to the Tcl evaluator. If a command pipeline is opened for writing, keystrokes entered into the console are not visible until the pipe is closed. These problems only occur because both Tcl and the child application are competing for the console at the same time. If the command pipeline is started from a script, so that Tcl is not accessing the console, or if the command pipeline does not use standard input or output, but is redirected from or to a file, then the above problems do not occur. .RE .TP \fBUnix\fR\0\0\0\0\0\0\0 . Valid values for \fIfileName\fR to open a serial port are generally of the form \fB/dev/tty\fIX\fR, where \fIX\fR is \fBa\fR or \fBb\fR, but the name of any pseudo-file that maps to a serial port may be used. | > > > > > > | 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 | some will be sent to the Tcl evaluator. If a command pipeline is opened for writing, keystrokes entered into the console are not visible until the pipe is closed. These problems only occur because both Tcl and the child application are competing for the console at the same time. If the command pipeline is started from a script, so that Tcl is not accessing the console, or if the command pipeline does not use standard input or output, but is redirected from or to a file, then the above problems do not occur. .PP Files opened in the .QW \fBa\fR mode or with the \fBAPPEND\fR flag set are implemented by seeking immediately before each write, which is not an atomic operation and does not carry the guarantee of strict appending that is present on POSIX platforms. .RE .TP \fBUnix\fR\0\0\0\0\0\0\0 . Valid values for \fIfileName\fR to open a serial port are generally of the form \fB/dev/tty\fIX\fR, where \fIX\fR is \fBa\fR or \fBb\fR, but the name of any pseudo-file that maps to a serial port may be used. |
| ︙ | ︙ | |||
523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 |
It retrieves a two-element list with the the current width and height of the
console that this channel is talking to.
.PP
Note that the equivalent options exist on Unix, but are on the serial channel
type.
.VE "8.7, TIP 160"
.SH "EXAMPLES"
.PP
Open a command pipeline and catch any errors:
.PP
.CS
set fl [\fBopen\fR "| ls this_file_does_not_exist"]
set data [read $fl]
if {[catch {close $fl} err]} {
puts "ls command failed: $err"
}
.CE
.PP
.VS "8.7, TIP 160"
Read a password securely from the user (assuming that the script is being run
interactively):
.PP
.CS
chan configure stdin \fB-inputmode password\fR
| > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
It retrieves a two-element list with the the current width and height of the
console that this channel is talking to.
.PP
Note that the equivalent options exist on Unix, but are on the serial channel
type.
.VE "8.7, TIP 160"
.SH "EXAMPLES"
Open a file for writing, forcing it to be created and raising an error if it
already exists.
.PP
.CS
set myNewFile [\fBopen\fR filename.txt {WRONLY CREAT EXCL}]
.CE
.PP
Open a file for writing as a log file.
.PP
.CS
set myLogFile [\fBopen\fR filename.log "a"]
fconfigure $myLogFile -buffering line
.CE
.PP
Open a command pipeline and catch any errors:
.PP
.CS
set fl [\fBopen\fR "| ls this_file_does_not_exist"]
set data [read $fl]
if {[catch {close $fl} err]} {
puts "ls command failed: $err"
}
.CE
.PP
Open a command pipeline and read binary data from it. Note the unusual form
with
.QW |[list
that handles non-trivial edge cases with arguments that potentially have
spaces in.
.PP
.CS
set fl [\fBopen\fR |[list create_image_data $input] "rb"]
set binData [read $fl]
close $fl
.CE
.PP
.VS "8.7, TIP 160"
Read a password securely from the user (assuming that the script is being run
interactively):
.PP
.CS
chan configure stdin \fB-inputmode password\fR
|
| ︙ | ︙ |
Changes to doc/refchan.n.
| ︙ | ︙ | |||
318 319 320 321 322 323 324 325 326 327 328 329 330 331 | The return value of the subcommand is ignored. .PP If the subcommand throws an error the command which caused its invocation (usually \fBfconfigure\fR or \fBchan configure\fR) will appear to have thrown this error. Any exception beyond \fBerror\fR (e.g.,\ \fBbreak\fR, etc.) is treated as and converted to an error. .RE .SH NOTES Some of the functions supported in channels defined in Tcl's C interface are not available to channels reflected to the Tcl level. .PP The function \fBTcl_DriverGetHandleProc\fR is not supported; i.e.,\ reflected channels do not have OS specific handles. .PP | > > > > > > > > > > > > > | 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 | The return value of the subcommand is ignored. .PP If the subcommand throws an error the command which caused its invocation (usually \fBfconfigure\fR or \fBchan configure\fR) will appear to have thrown this error. Any exception beyond \fBerror\fR (e.g.,\ \fBbreak\fR, etc.) is treated as and converted to an error. .RE .TP \fIcmdPrefix \fBtruncate\fR \fIchannelId length\fR . This \fIoptional\fR subcommand handles changing the length of the underlying data stream for the channel \fIchannelId\fR. Its length gets set to \fIlength\fR. .RS .PP If the subcommand throws an error the command which caused its invocation (usually \fBchan truncate\fR) will appear to have thrown this error. Any exception beyond \fBerror\fR (e.g.,\ \fBbreak\fR, etc.) is treated as and converted to an error. .RE .SH NOTES Some of the functions supported in channels defined in Tcl's C interface are not available to channels reflected to the Tcl level. .PP The function \fBTcl_DriverGetHandleProc\fR is not supported; i.e.,\ reflected channels do not have OS specific handles. .PP |
| ︙ | ︙ |
Changes to doc/string.n.
| ︙ | ︙ | |||
315 316 317 318 319 320 321 | character whose index is \fIlast\fR (using the forms described in \fBSTRING INDICES\fR). An index of 0 refers to the first character of the string. \fIFirst\fR and \fIlast\fR may be specified as for the \fBindex\fR method. If \fInewstring\fR is specified, then it is placed in the removed character range. If \fIfirst\fR is less than zero then it is treated as if it were zero, and if \fIlast\fR is greater than or equal to the length of the string | | | > | | 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 | character whose index is \fIlast\fR (using the forms described in \fBSTRING INDICES\fR). An index of 0 refers to the first character of the string. \fIFirst\fR and \fIlast\fR may be specified as for the \fBindex\fR method. If \fInewstring\fR is specified, then it is placed in the removed character range. If \fIfirst\fR is less than zero then it is treated as if it were zero, and if \fIlast\fR is greater than or equal to the length of the string then it is treated as if it were \fBend\fR. The initial string is returned untouched, if \fIfirst\fR is greater than \fIlast\fR, or if \fIfirst\fR is equal to or greater than the length of the initial string, or \fIlast\fR is less than 0. .TP \fBstring reverse \fIstring\fR . Returns a string that is the same length as \fIstring\fR but with its characters in the reverse order. .TP \fBstring tolower \fIstring\fR ?\fIfirst\fR? ?\fIlast\fR? |
| ︙ | ︙ | |||
400 401 402 403 404 405 406 | Tcl byte array value). Refer to the \fBTcl_NumUtfChars\fR manual entry for more details on the UTF\-8 representation. .PP Formally, the \fBstring bytelength\fR operation returns the content of the \fIlength\fR field of the \fBTcl_Obj\fR structure, after calling \fBTcl_GetString\fR to ensure that the \fIbytes\fR field is populated. This is highly unlikely to be useful to Tcl scripts, as Tcl's internal | | | | | | | 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 | Tcl byte array value). Refer to the \fBTcl_NumUtfChars\fR manual entry for more details on the UTF\-8 representation. .PP Formally, the \fBstring bytelength\fR operation returns the content of the \fIlength\fR field of the \fBTcl_Obj\fR structure, after calling \fBTcl_GetString\fR to ensure that the \fIbytes\fR field is populated. This is highly unlikely to be useful to Tcl scripts, as Tcl's internal encoding is not strict UTF\-8, but rather a modified WTF\-8 with a denormalized NUL (identical to that used in a number of places by Java's serialization mechanism) to enable basic processing with non-Unicode-aware C functions. As this representation should only ever be used by Tcl's implementation, the number of bytes used to store the representation is of very low value (except to C extension code, which has direct access for the purpose of memory management, etc.) .PP \fICompatibility note:\fR This subcommand is deprecated and will be removed in Tcl 9.0. It is better to use the \fBencoding convertto\fR command to convert a string to a known encoding (e.g. "utf-8" or "cesu-8") and then apply \fBstring length\fR to that. .PP .CS \fBstring length\fR [encoding convertto utf-8 $theString] .CE .RE .TP \fBstring wordend \fIstring charIndex\fR |
| ︙ | ︙ |
Changes to doc/tm.n.
| ︙ | ︙ | |||
294 295 296 297 298 299 300 | \fB$::env(TCL8.2_TM_PATH)\fR \fB$::env(TCL8_2_TM_PATH)\fR \fB$::env(TCL8.1_TM_PATH)\fR \fB$::env(TCL8_1_TM_PATH)\fR \fB$::env(TCL8.0_TM_PATH)\fR \fB$::env(TCL8_0_TM_PATH)\fR .CE .SH "SEE ALSO" package(n), Tcl Improvement Proposal #189 .QW "\fITcl Modules\fR" | | | | 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 | \fB$::env(TCL8.2_TM_PATH)\fR \fB$::env(TCL8_2_TM_PATH)\fR \fB$::env(TCL8.1_TM_PATH)\fR \fB$::env(TCL8_1_TM_PATH)\fR \fB$::env(TCL8.0_TM_PATH)\fR \fB$::env(TCL8_0_TM_PATH)\fR .CE .SH "SEE ALSO" package(n), Tcl Improvement Proposal #189 .QW "\fITcl Modules\fR" (online at https://tip.tcl-lang.org/189.html), Tcl Improvement Proposal #190 .QW "\fIImplementation Choices for Tcl Modules\fR" (online at https://tip.tcl-lang.org/190.html) .SH "KEYWORDS" modules, package .\" Local Variables: .\" mode: nroff .\" End: |
Changes to doc/try.n.
| ︙ | ︙ | |||
83 84 85 86 87 88 89 |
}
.CE
.PP
Handle different reasons for a file to not be openable for reading:
.PP
.CS
\fBtry\fR {
| | | 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 |
}
.CE
.PP
Handle different reasons for a file to not be openable for reading:
.PP
.CS
\fBtry\fR {
set f [open /some/file/name r]
} \fBtrap\fR {POSIX EISDIR} {} {
puts "failed to open /some/file/name: it's a directory"
} \fBtrap\fR {POSIX ENOENT} {} {
puts "failed to open /some/file/name: it doesn't exist"
}
.CE
.SH "SEE ALSO"
|
| ︙ | ︙ |
Changes to doc/unload.n.
| ︙ | ︙ | |||
86 87 88 89 90 91 92 | type). When both reference counts have reached 0, the library will be detached from the process. .SS "UNLOAD HOOK PROTOTYPE" .PP The unload procedure must match the following prototype: .PP .CS | | | 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 |
type). When both reference counts have reached 0, the library will be
detached from the process.
.SS "UNLOAD HOOK PROTOTYPE"
.PP
The unload procedure must match the following prototype:
.PP
.CS
typedef int \fBTcl_LibraryUnloadProc\fR(
Tcl_Interp *\fIinterp\fR,
int \fIflags\fR);
.CE
.PP
The \fIinterp\fR argument identifies the interpreter from which the
library is to be unloaded. The unload procedure must return
\fBTCL_OK\fR or \fBTCL_ERROR\fR to indicate whether or not it completed
|
| ︙ | ︙ |
Changes to doc/zipfs.3.
| ︙ | ︙ | |||
9 10 11 12 13 14 15 | .TH Tclzipfs 3 8.7 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME TclZipfs_AppHook, Tclzipfs_Mount, TclZipfs_MountBuffer, Tclzipfs_Unmount \- handle ZIP files as Tcl virtual filesystems .SH SYNOPSIS .nf | | | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | .TH Tclzipfs 3 8.7 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME TclZipfs_AppHook, Tclzipfs_Mount, TclZipfs_MountBuffer, Tclzipfs_Unmount \- handle ZIP files as Tcl virtual filesystems .SH SYNOPSIS .nf const char * \fBTclZipfs_AppHook(\fIargcPtr, argvPtr\fR) .sp int \fBTclzipfs_Mount\fR(\fIinterp, mountpoint, zipname, password\fR) .sp int \fBTclZipfs_MountBuffer\fR(\fIinterp, mountpoint, data, dataLen, copy\fR) |
| ︙ | ︙ | |||
83 84 85 86 87 88 89 | \fBlibtcl_8_7_2.zip\fR.) That archive, if located, is also mounted read-only. .PP On Windows, \fBTclZipfs_AppHook\fR has a slightly different signature, since it uses WCHAR instead of char. As a result, it requires your application to be compiled with the UNICODE preprocessor symbol defined (e.g., via the \fB-DUNICODE\fR compiler flag). .PP | | > | | < | | 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 | \fBlibtcl_8_7_2.zip\fR.) That archive, if located, is also mounted read-only. .PP On Windows, \fBTclZipfs_AppHook\fR has a slightly different signature, since it uses WCHAR instead of char. As a result, it requires your application to be compiled with the UNICODE preprocessor symbol defined (e.g., via the \fB-DUNICODE\fR compiler flag). .PP The result of \fBTclZipfs_AppHook\fR is the full Tcl version (e.g., \fB8.7.0+abcdef...abcdef.gcc-1002.utf16\fR). The function \fImay\fR modify the variables pointed to by \fIargcPtr\fR and \fIargvPtr\fR to remove arguments; the current implementation does not do so, but callers \fIshould not\fR assume that this will be true in the future. .PP \fBTclzipfs_Mount\fR mounts the ZIP archive \fIzipname\fR on the mount point given in \fImountpoint\fR using the optional ZIP password \fIpassword\fR. Errors during that process are reported in the interpreter \fIinterp\fR. If \fImountpoint\fR is a NULL pointer, information on all currently mounted ZIP file systems is written into \fIinterp\fR's result as a sequence of mount points and ZIP file names. The result of this call is a standard Tcl result |
| ︙ | ︙ |
Changes to generic/regc_locale.c.
| ︙ | ︙ | |||
136 137 138 139 140 141 142 |
static const crange alphaRangeTable[] = {
{0x41, 0x5A}, {0x61, 0x7A}, {0xC0, 0xD6}, {0xD8, 0xF6},
{0xF8, 0x2C1}, {0x2C6, 0x2D1}, {0x2E0, 0x2E4}, {0x370, 0x374},
{0x37A, 0x37D}, {0x388, 0x38A}, {0x38E, 0x3A1}, {0x3A3, 0x3F5},
{0x3F7, 0x481}, {0x48A, 0x52F}, {0x531, 0x556}, {0x560, 0x588},
{0x5D0, 0x5EA}, {0x5EF, 0x5F2}, {0x620, 0x64A}, {0x671, 0x6D3},
{0x6FA, 0x6FC}, {0x712, 0x72F}, {0x74D, 0x7A5}, {0x7CA, 0x7EA},
| | | | | | | | | | | | | | | | | | | | | | | | | | < | | | | | | | | | | | | | | | | | | | | | | | > | > | | | | | | | | | | | | | | > | | | | | | | | > | | | | | | | | | > | | | | | | | | | | | | > | | | | | | | | | | | 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 |
static const crange alphaRangeTable[] = {
{0x41, 0x5A}, {0x61, 0x7A}, {0xC0, 0xD6}, {0xD8, 0xF6},
{0xF8, 0x2C1}, {0x2C6, 0x2D1}, {0x2E0, 0x2E4}, {0x370, 0x374},
{0x37A, 0x37D}, {0x388, 0x38A}, {0x38E, 0x3A1}, {0x3A3, 0x3F5},
{0x3F7, 0x481}, {0x48A, 0x52F}, {0x531, 0x556}, {0x560, 0x588},
{0x5D0, 0x5EA}, {0x5EF, 0x5F2}, {0x620, 0x64A}, {0x671, 0x6D3},
{0x6FA, 0x6FC}, {0x712, 0x72F}, {0x74D, 0x7A5}, {0x7CA, 0x7EA},
{0x800, 0x815}, {0x840, 0x858}, {0x860, 0x86A}, {0x870, 0x887},
{0x889, 0x88E}, {0x8A0, 0x8C9}, {0x904, 0x939}, {0x958, 0x961},
{0x971, 0x980}, {0x985, 0x98C}, {0x993, 0x9A8}, {0x9AA, 0x9B0},
{0x9B6, 0x9B9}, {0x9DF, 0x9E1}, {0xA05, 0xA0A}, {0xA13, 0xA28},
{0xA2A, 0xA30}, {0xA59, 0xA5C}, {0xA72, 0xA74}, {0xA85, 0xA8D},
{0xA8F, 0xA91}, {0xA93, 0xAA8}, {0xAAA, 0xAB0}, {0xAB5, 0xAB9},
{0xB05, 0xB0C}, {0xB13, 0xB28}, {0xB2A, 0xB30}, {0xB35, 0xB39},
{0xB5F, 0xB61}, {0xB85, 0xB8A}, {0xB8E, 0xB90}, {0xB92, 0xB95},
{0xBA8, 0xBAA}, {0xBAE, 0xBB9}, {0xC05, 0xC0C}, {0xC0E, 0xC10},
{0xC12, 0xC28}, {0xC2A, 0xC39}, {0xC58, 0xC5A}, {0xC85, 0xC8C},
{0xC8E, 0xC90}, {0xC92, 0xCA8}, {0xCAA, 0xCB3}, {0xCB5, 0xCB9},
{0xD04, 0xD0C}, {0xD0E, 0xD10}, {0xD12, 0xD3A}, {0xD54, 0xD56},
{0xD5F, 0xD61}, {0xD7A, 0xD7F}, {0xD85, 0xD96}, {0xD9A, 0xDB1},
{0xDB3, 0xDBB}, {0xDC0, 0xDC6}, {0xE01, 0xE30}, {0xE40, 0xE46},
{0xE86, 0xE8A}, {0xE8C, 0xEA3}, {0xEA7, 0xEB0}, {0xEC0, 0xEC4},
{0xEDC, 0xEDF}, {0xF40, 0xF47}, {0xF49, 0xF6C}, {0xF88, 0xF8C},
{0x1000, 0x102A}, {0x1050, 0x1055}, {0x105A, 0x105D}, {0x106E, 0x1070},
{0x1075, 0x1081}, {0x10A0, 0x10C5}, {0x10D0, 0x10FA}, {0x10FC, 0x1248},
{0x124A, 0x124D}, {0x1250, 0x1256}, {0x125A, 0x125D}, {0x1260, 0x1288},
{0x128A, 0x128D}, {0x1290, 0x12B0}, {0x12B2, 0x12B5}, {0x12B8, 0x12BE},
{0x12C2, 0x12C5}, {0x12C8, 0x12D6}, {0x12D8, 0x1310}, {0x1312, 0x1315},
{0x1318, 0x135A}, {0x1380, 0x138F}, {0x13A0, 0x13F5}, {0x13F8, 0x13FD},
{0x1401, 0x166C}, {0x166F, 0x167F}, {0x1681, 0x169A}, {0x16A0, 0x16EA},
{0x16F1, 0x16F8}, {0x1700, 0x1711}, {0x171F, 0x1731}, {0x1740, 0x1751},
{0x1760, 0x176C}, {0x176E, 0x1770}, {0x1780, 0x17B3}, {0x1820, 0x1878},
{0x1880, 0x1884}, {0x1887, 0x18A8}, {0x18B0, 0x18F5}, {0x1900, 0x191E},
{0x1950, 0x196D}, {0x1970, 0x1974}, {0x1980, 0x19AB}, {0x19B0, 0x19C9},
{0x1A00, 0x1A16}, {0x1A20, 0x1A54}, {0x1B05, 0x1B33}, {0x1B45, 0x1B4C},
{0x1B83, 0x1BA0}, {0x1BBA, 0x1BE5}, {0x1C00, 0x1C23}, {0x1C4D, 0x1C4F},
{0x1C5A, 0x1C7D}, {0x1C80, 0x1C88}, {0x1C90, 0x1CBA}, {0x1CBD, 0x1CBF},
{0x1CE9, 0x1CEC}, {0x1CEE, 0x1CF3}, {0x1D00, 0x1DBF}, {0x1E00, 0x1F15},
{0x1F18, 0x1F1D}, {0x1F20, 0x1F45}, {0x1F48, 0x1F4D}, {0x1F50, 0x1F57},
{0x1F5F, 0x1F7D}, {0x1F80, 0x1FB4}, {0x1FB6, 0x1FBC}, {0x1FC2, 0x1FC4},
{0x1FC6, 0x1FCC}, {0x1FD0, 0x1FD3}, {0x1FD6, 0x1FDB}, {0x1FE0, 0x1FEC},
{0x1FF2, 0x1FF4}, {0x1FF6, 0x1FFC}, {0x2090, 0x209C}, {0x210A, 0x2113},
{0x2119, 0x211D}, {0x212A, 0x212D}, {0x212F, 0x2139}, {0x213C, 0x213F},
{0x2145, 0x2149}, {0x2C00, 0x2CE4}, {0x2CEB, 0x2CEE}, {0x2D00, 0x2D25},
{0x2D30, 0x2D67}, {0x2D80, 0x2D96}, {0x2DA0, 0x2DA6}, {0x2DA8, 0x2DAE},
{0x2DB0, 0x2DB6}, {0x2DB8, 0x2DBE}, {0x2DC0, 0x2DC6}, {0x2DC8, 0x2DCE},
{0x2DD0, 0x2DD6}, {0x2DD8, 0x2DDE}, {0x3031, 0x3035}, {0x3041, 0x3096},
{0x309D, 0x309F}, {0x30A1, 0x30FA}, {0x30FC, 0x30FF}, {0x3105, 0x312F},
{0x3131, 0x318E}, {0x31A0, 0x31BF}, {0x31F0, 0x31FF}, {0x3400, 0x4DBF},
{0x4E00, 0xA48C}, {0xA4D0, 0xA4FD}, {0xA500, 0xA60C}, {0xA610, 0xA61F},
{0xA640, 0xA66E}, {0xA67F, 0xA69D}, {0xA6A0, 0xA6E5}, {0xA717, 0xA71F},
{0xA722, 0xA788}, {0xA78B, 0xA7CA}, {0xA7D5, 0xA7D9}, {0xA7F2, 0xA801},
{0xA803, 0xA805}, {0xA807, 0xA80A}, {0xA80C, 0xA822}, {0xA840, 0xA873},
{0xA882, 0xA8B3}, {0xA8F2, 0xA8F7}, {0xA90A, 0xA925}, {0xA930, 0xA946},
{0xA960, 0xA97C}, {0xA984, 0xA9B2}, {0xA9E0, 0xA9E4}, {0xA9E6, 0xA9EF},
{0xA9FA, 0xA9FE}, {0xAA00, 0xAA28}, {0xAA40, 0xAA42}, {0xAA44, 0xAA4B},
{0xAA60, 0xAA76}, {0xAA7E, 0xAAAF}, {0xAAB9, 0xAABD}, {0xAADB, 0xAADD},
{0xAAE0, 0xAAEA}, {0xAAF2, 0xAAF4}, {0xAB01, 0xAB06}, {0xAB09, 0xAB0E},
{0xAB11, 0xAB16}, {0xAB20, 0xAB26}, {0xAB28, 0xAB2E}, {0xAB30, 0xAB5A},
{0xAB5C, 0xAB69}, {0xAB70, 0xABE2}, {0xAC00, 0xD7A3}, {0xD7B0, 0xD7C6},
{0xD7CB, 0xD7FB}, {0xF900, 0xFA6D}, {0xFA70, 0xFAD9}, {0xFB00, 0xFB06},
{0xFB13, 0xFB17}, {0xFB1F, 0xFB28}, {0xFB2A, 0xFB36}, {0xFB38, 0xFB3C},
{0xFB46, 0xFBB1}, {0xFBD3, 0xFD3D}, {0xFD50, 0xFD8F}, {0xFD92, 0xFDC7},
{0xFDF0, 0xFDFB}, {0xFE70, 0xFE74}, {0xFE76, 0xFEFC}, {0xFF21, 0xFF3A},
{0xFF41, 0xFF5A}, {0xFF66, 0xFFBE}, {0xFFC2, 0xFFC7}, {0xFFCA, 0xFFCF},
{0xFFD2, 0xFFD7}, {0xFFDA, 0xFFDC}
#if CHRBITS > 16
,{0x10000, 0x1000B}, {0x1000D, 0x10026}, {0x10028, 0x1003A}, {0x1003F, 0x1004D},
{0x10050, 0x1005D}, {0x10080, 0x100FA}, {0x10280, 0x1029C}, {0x102A0, 0x102D0},
{0x10300, 0x1031F}, {0x1032D, 0x10340}, {0x10342, 0x10349}, {0x10350, 0x10375},
{0x10380, 0x1039D}, {0x103A0, 0x103C3}, {0x103C8, 0x103CF}, {0x10400, 0x1049D},
{0x104B0, 0x104D3}, {0x104D8, 0x104FB}, {0x10500, 0x10527}, {0x10530, 0x10563},
{0x10570, 0x1057A}, {0x1057C, 0x1058A}, {0x1058C, 0x10592}, {0x10597, 0x105A1},
{0x105A3, 0x105B1}, {0x105B3, 0x105B9}, {0x10600, 0x10736}, {0x10740, 0x10755},
{0x10760, 0x10767}, {0x10780, 0x10785}, {0x10787, 0x107B0}, {0x107B2, 0x107BA},
{0x10800, 0x10805}, {0x1080A, 0x10835}, {0x1083F, 0x10855}, {0x10860, 0x10876},
{0x10880, 0x1089E}, {0x108E0, 0x108F2}, {0x10900, 0x10915}, {0x10920, 0x10939},
{0x10980, 0x109B7}, {0x10A10, 0x10A13}, {0x10A15, 0x10A17}, {0x10A19, 0x10A35},
{0x10A60, 0x10A7C}, {0x10A80, 0x10A9C}, {0x10AC0, 0x10AC7}, {0x10AC9, 0x10AE4},
{0x10B00, 0x10B35}, {0x10B40, 0x10B55}, {0x10B60, 0x10B72}, {0x10B80, 0x10B91},
{0x10C00, 0x10C48}, {0x10C80, 0x10CB2}, {0x10CC0, 0x10CF2}, {0x10D00, 0x10D23},
{0x10E80, 0x10EA9}, {0x10F00, 0x10F1C}, {0x10F30, 0x10F45}, {0x10F70, 0x10F81},
{0x10FB0, 0x10FC4}, {0x10FE0, 0x10FF6}, {0x11003, 0x11037}, {0x11083, 0x110AF},
{0x110D0, 0x110E8}, {0x11103, 0x11126}, {0x11150, 0x11172}, {0x11183, 0x111B2},
{0x111C1, 0x111C4}, {0x11200, 0x11211}, {0x11213, 0x1122B}, {0x11280, 0x11286},
{0x1128A, 0x1128D}, {0x1128F, 0x1129D}, {0x1129F, 0x112A8}, {0x112B0, 0x112DE},
{0x11305, 0x1130C}, {0x11313, 0x11328}, {0x1132A, 0x11330}, {0x11335, 0x11339},
{0x1135D, 0x11361}, {0x11400, 0x11434}, {0x11447, 0x1144A}, {0x1145F, 0x11461},
{0x11480, 0x114AF}, {0x11580, 0x115AE}, {0x115D8, 0x115DB}, {0x11600, 0x1162F},
{0x11680, 0x116AA}, {0x11700, 0x1171A}, {0x11740, 0x11746}, {0x11800, 0x1182B},
{0x118A0, 0x118DF}, {0x118FF, 0x11906}, {0x1190C, 0x11913}, {0x11918, 0x1192F},
{0x119A0, 0x119A7}, {0x119AA, 0x119D0}, {0x11A0B, 0x11A32}, {0x11A5C, 0x11A89},
{0x11AB0, 0x11AF8}, {0x11C00, 0x11C08}, {0x11C0A, 0x11C2E}, {0x11C72, 0x11C8F},
{0x11D00, 0x11D06}, {0x11D0B, 0x11D30}, {0x11D60, 0x11D65}, {0x11D6A, 0x11D89},
{0x11EE0, 0x11EF2}, {0x12000, 0x12399}, {0x12480, 0x12543}, {0x12F90, 0x12FF0},
{0x13000, 0x1342E}, {0x14400, 0x14646}, {0x16800, 0x16A38}, {0x16A40, 0x16A5E},
{0x16A70, 0x16ABE}, {0x16AD0, 0x16AED}, {0x16B00, 0x16B2F}, {0x16B40, 0x16B43},
{0x16B63, 0x16B77}, {0x16B7D, 0x16B8F}, {0x16E40, 0x16E7F}, {0x16F00, 0x16F4A},
{0x16F93, 0x16F9F}, {0x17000, 0x187F7}, {0x18800, 0x18CD5}, {0x18D00, 0x18D08},
{0x1AFF0, 0x1AFF3}, {0x1AFF5, 0x1AFFB}, {0x1B000, 0x1B122}, {0x1B150, 0x1B152},
{0x1B164, 0x1B167}, {0x1B170, 0x1B2FB}, {0x1BC00, 0x1BC6A}, {0x1BC70, 0x1BC7C},
{0x1BC80, 0x1BC88}, {0x1BC90, 0x1BC99}, {0x1D400, 0x1D454}, {0x1D456, 0x1D49C},
{0x1D4A9, 0x1D4AC}, {0x1D4AE, 0x1D4B9}, {0x1D4BD, 0x1D4C3}, {0x1D4C5, 0x1D505},
{0x1D507, 0x1D50A}, {0x1D50D, 0x1D514}, {0x1D516, 0x1D51C}, {0x1D51E, 0x1D539},
{0x1D53B, 0x1D53E}, {0x1D540, 0x1D544}, {0x1D54A, 0x1D550}, {0x1D552, 0x1D6A5},
{0x1D6A8, 0x1D6C0}, {0x1D6C2, 0x1D6DA}, {0x1D6DC, 0x1D6FA}, {0x1D6FC, 0x1D714},
{0x1D716, 0x1D734}, {0x1D736, 0x1D74E}, {0x1D750, 0x1D76E}, {0x1D770, 0x1D788},
{0x1D78A, 0x1D7A8}, {0x1D7AA, 0x1D7C2}, {0x1D7C4, 0x1D7CB}, {0x1DF00, 0x1DF1E},
{0x1E100, 0x1E12C}, {0x1E137, 0x1E13D}, {0x1E290, 0x1E2AD}, {0x1E2C0, 0x1E2EB},
{0x1E7E0, 0x1E7E6}, {0x1E7E8, 0x1E7EB}, {0x1E7F0, 0x1E7FE}, {0x1E800, 0x1E8C4},
{0x1E900, 0x1E943}, {0x1EE00, 0x1EE03}, {0x1EE05, 0x1EE1F}, {0x1EE29, 0x1EE32},
{0x1EE34, 0x1EE37}, {0x1EE4D, 0x1EE4F}, {0x1EE67, 0x1EE6A}, {0x1EE6C, 0x1EE72},
{0x1EE74, 0x1EE77}, {0x1EE79, 0x1EE7C}, {0x1EE80, 0x1EE89}, {0x1EE8B, 0x1EE9B},
{0x1EEA1, 0x1EEA3}, {0x1EEA5, 0x1EEA9}, {0x1EEAB, 0x1EEBB}, {0x20000, 0x2A6DF},
{0x2A700, 0x2B738}, {0x2B740, 0x2B81D}, {0x2B820, 0x2CEA1}, {0x2CEB0, 0x2EBE0},
{0x2F800, 0x2FA1D}, {0x30000, 0x3134A}
#endif
};
#define NUM_ALPHA_RANGE (sizeof(alphaRangeTable)/sizeof(crange))
static const chr alphaCharTable[] = {
0xAA, 0xB5, 0xBA, 0x2EC, 0x2EE, 0x376, 0x377, 0x37F, 0x386,
0x38C, 0x559, 0x66E, 0x66F, 0x6D5, 0x6E5, 0x6E6, 0x6EE, 0x6EF,
0x6FF, 0x710, 0x7B1, 0x7F4, 0x7F5, 0x7FA, 0x81A, 0x824, 0x828,
0x93D, 0x950, 0x98F, 0x990, 0x9B2, 0x9BD, 0x9CE, 0x9DC, 0x9DD,
0x9F0, 0x9F1, 0x9FC, 0xA0F, 0xA10, 0xA32, 0xA33, 0xA35, 0xA36,
0xA38, 0xA39, 0xA5E, 0xAB2, 0xAB3, 0xABD, 0xAD0, 0xAE0, 0xAE1,
0xAF9, 0xB0F, 0xB10, 0xB32, 0xB33, 0xB3D, 0xB5C, 0xB5D, 0xB71,
0xB83, 0xB99, 0xB9A, 0xB9C, 0xB9E, 0xB9F, 0xBA3, 0xBA4, 0xBD0,
0xC3D, 0xC5D, 0xC60, 0xC61, 0xC80, 0xCBD, 0xCDD, 0xCDE, 0xCE0,
0xCE1, 0xCF1, 0xCF2, 0xD3D, 0xD4E, 0xDBD, 0xE32, 0xE33, 0xE81,
0xE82, 0xE84, 0xEA5, 0xEB2, 0xEB3, 0xEBD, 0xEC6, 0xF00, 0x103F,
0x1061, 0x1065, 0x1066, 0x108E, 0x10C7, 0x10CD, 0x1258, 0x12C0, 0x17D7,
0x17DC, 0x18AA, 0x1AA7, 0x1BAE, 0x1BAF, 0x1CF5, 0x1CF6, 0x1CFA, 0x1F59,
0x1F5B, 0x1F5D, 0x1FBE, 0x2071, 0x207F, 0x2102, 0x2107, 0x2115, 0x2124,
0x2126, 0x2128, 0x214E, 0x2183, 0x2184, 0x2CF2, 0x2CF3, 0x2D27, 0x2D2D,
0x2D6F, 0x2E2F, 0x3005, 0x3006, 0x303B, 0x303C, 0xA62A, 0xA62B, 0xA7D0,
0xA7D1, 0xA7D3, 0xA8FB, 0xA8FD, 0xA8FE, 0xA9CF, 0xAA7A, 0xAAB1, 0xAAB5,
0xAAB6, 0xAAC0, 0xAAC2, 0xFB1D, 0xFB3E, 0xFB40, 0xFB41, 0xFB43, 0xFB44
#if CHRBITS > 16
,0x1003C, 0x1003D, 0x10594, 0x10595, 0x105BB, 0x105BC, 0x10808, 0x10837, 0x10838,
0x1083C, 0x108F4, 0x108F5, 0x109BE, 0x109BF, 0x10A00, 0x10EB0, 0x10EB1, 0x10F27,
0x11071, 0x11072, 0x11075, 0x11144, 0x11147, 0x11176, 0x111DA, 0x111DC, 0x11288,
0x1130F, 0x11310, 0x11332, 0x11333, 0x1133D, 0x11350, 0x114C4, 0x114C5, 0x114C7,
0x11644, 0x116B8, 0x11909, 0x11915, 0x11916, 0x1193F, 0x11941, 0x119E1, 0x119E3,
0x11A00, 0x11A3A, 0x11A50, 0x11A9D, 0x11C40, 0x11D08, 0x11D09, 0x11D46, 0x11D67,
0x11D68, 0x11D98, 0x11FB0, 0x16F50, 0x16FE0, 0x16FE1, 0x16FE3, 0x1AFFD, 0x1AFFE,
0x1D49E, 0x1D49F, 0x1D4A2, 0x1D4A5, 0x1D4A6, 0x1D4BB, 0x1D546, 0x1E14E, 0x1E7ED,
0x1E7EE, 0x1E94B, 0x1EE21, 0x1EE22, 0x1EE24, 0x1EE27, 0x1EE39, 0x1EE3B, 0x1EE42,
0x1EE47, 0x1EE49, 0x1EE4B, 0x1EE51, 0x1EE52, 0x1EE54, 0x1EE57, 0x1EE59, 0x1EE5B,
0x1EE5D, 0x1EE5F, 0x1EE61, 0x1EE62, 0x1EE64, 0x1EE7E
#endif
};
#define NUM_ALPHA_CHAR (sizeof(alphaCharTable)/sizeof(chr))
/*
* Unicode: control characters.
|
| ︙ | ︙ | |||
298 299 300 301 302 303 304 |
{0xF0000, 0xFFFFD}, {0x100000, 0x10FFFD}
#endif
};
#define NUM_CONTROL_RANGE (sizeof(controlRangeTable)/sizeof(crange))
static const chr controlCharTable[] = {
| | | 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 |
{0xF0000, 0xFFFFD}, {0x100000, 0x10FFFD}
#endif
};
#define NUM_CONTROL_RANGE (sizeof(controlRangeTable)/sizeof(crange))
static const chr controlCharTable[] = {
0xAD, 0x61C, 0x6DD, 0x70F, 0x890, 0x891, 0x8E2, 0x180E, 0xFEFF
#if CHRBITS > 16
,0x110BD, 0x110CD, 0xE0001
#endif
};
#define NUM_CONTROL_CHAR (sizeof(controlCharTable)/sizeof(chr))
|
| ︙ | ︙ | |||
326 327 328 329 330 331 332 |
{0xA9D0, 0xA9D9}, {0xA9F0, 0xA9F9}, {0xAA50, 0xAA59}, {0xABF0, 0xABF9},
{0xFF10, 0xFF19}
#if CHRBITS > 16
,{0x104A0, 0x104A9}, {0x10D30, 0x10D39}, {0x11066, 0x1106F}, {0x110F0, 0x110F9},
{0x11136, 0x1113F}, {0x111D0, 0x111D9}, {0x112F0, 0x112F9}, {0x11450, 0x11459},
{0x114D0, 0x114D9}, {0x11650, 0x11659}, {0x116C0, 0x116C9}, {0x11730, 0x11739},
{0x118E0, 0x118E9}, {0x11950, 0x11959}, {0x11C50, 0x11C59}, {0x11D50, 0x11D59},
| | | > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > | 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 |
{0xA9D0, 0xA9D9}, {0xA9F0, 0xA9F9}, {0xAA50, 0xAA59}, {0xABF0, 0xABF9},
{0xFF10, 0xFF19}
#if CHRBITS > 16
,{0x104A0, 0x104A9}, {0x10D30, 0x10D39}, {0x11066, 0x1106F}, {0x110F0, 0x110F9},
{0x11136, 0x1113F}, {0x111D0, 0x111D9}, {0x112F0, 0x112F9}, {0x11450, 0x11459},
{0x114D0, 0x114D9}, {0x11650, 0x11659}, {0x116C0, 0x116C9}, {0x11730, 0x11739},
{0x118E0, 0x118E9}, {0x11950, 0x11959}, {0x11C50, 0x11C59}, {0x11D50, 0x11D59},
{0x11DA0, 0x11DA9}, {0x16A60, 0x16A69}, {0x16AC0, 0x16AC9}, {0x16B50, 0x16B59},
{0x1D7CE, 0x1D7FF}, {0x1E140, 0x1E149}, {0x1E2F0, 0x1E2F9}, {0x1E950, 0x1E959},
{0x1FBF0, 0x1FBF9}
#endif
};
#define NUM_DIGIT_RANGE (sizeof(digitRangeTable)/sizeof(crange))
/*
* no singletons of digit characters.
*/
/*
* Unicode: punctuation characters.
*/
static const crange punctRangeTable[] = {
{0x21, 0x23}, {0x25, 0x2A}, {0x2C, 0x2F}, {0x5B, 0x5D},
{0x55A, 0x55F}, {0x61D, 0x61F}, {0x66A, 0x66D}, {0x700, 0x70D},
{0x7F7, 0x7F9}, {0x830, 0x83E}, {0xF04, 0xF12}, {0xF3A, 0xF3D},
{0xFD0, 0xFD4}, {0x104A, 0x104F}, {0x1360, 0x1368}, {0x16EB, 0x16ED},
{0x17D4, 0x17D6}, {0x17D8, 0x17DA}, {0x1800, 0x180A}, {0x1AA0, 0x1AA6},
{0x1AA8, 0x1AAD}, {0x1B5A, 0x1B60}, {0x1BFC, 0x1BFF}, {0x1C3B, 0x1C3F},
{0x1CC0, 0x1CC7}, {0x2010, 0x2027}, {0x2030, 0x2043}, {0x2045, 0x2051},
{0x2053, 0x205E}, {0x2308, 0x230B}, {0x2768, 0x2775}, {0x27E6, 0x27EF},
{0x2983, 0x2998}, {0x29D8, 0x29DB}, {0x2CF9, 0x2CFC}, {0x2E00, 0x2E2E},
{0x2E30, 0x2E4F}, {0x2E52, 0x2E5D}, {0x3001, 0x3003}, {0x3008, 0x3011},
{0x3014, 0x301F}, {0xA60D, 0xA60F}, {0xA6F2, 0xA6F7}, {0xA874, 0xA877},
{0xA8F8, 0xA8FA}, {0xA9C1, 0xA9CD}, {0xAA5C, 0xAA5F}, {0xFE10, 0xFE19},
{0xFE30, 0xFE52}, {0xFE54, 0xFE61}, {0xFF01, 0xFF03}, {0xFF05, 0xFF0A},
{0xFF0C, 0xFF0F}, {0xFF3B, 0xFF3D}, {0xFF5F, 0xFF65}
#if CHRBITS > 16
,{0x10100, 0x10102}, {0x10A50, 0x10A58}, {0x10AF0, 0x10AF6}, {0x10B39, 0x10B3F},
{0x10B99, 0x10B9C}, {0x10F55, 0x10F59}, {0x10F86, 0x10F89}, {0x11047, 0x1104D},
{0x110BE, 0x110C1}, {0x11140, 0x11143}, {0x111C5, 0x111C8}, {0x111DD, 0x111DF},
{0x11238, 0x1123D}, {0x1144B, 0x1144F}, {0x115C1, 0x115D7}, {0x11641, 0x11643},
{0x11660, 0x1166C}, {0x1173C, 0x1173E}, {0x11944, 0x11946}, {0x11A3F, 0x11A46},
{0x11A9A, 0x11A9C}, {0x11A9E, 0x11AA2}, {0x11C41, 0x11C45}, {0x12470, 0x12474},
{0x16B37, 0x16B3B}, {0x16E97, 0x16E9A}, {0x1DA87, 0x1DA8B}
#endif
};
#define NUM_PUNCT_RANGE (sizeof(punctRangeTable)/sizeof(crange))
static const chr punctCharTable[] = {
0x3A, 0x3B, 0x3F, 0x40, 0x5F, 0x7B, 0x7D, 0xA1, 0xA7,
0xAB, 0xB6, 0xB7, 0xBB, 0xBF, 0x37E, 0x387, 0x589, 0x58A,
0x5BE, 0x5C0, 0x5C3, 0x5C6, 0x5F3, 0x5F4, 0x609, 0x60A, 0x60C,
0x60D, 0x61B, 0x6D4, 0x85E, 0x964, 0x965, 0x970, 0x9FD, 0xA76,
0xAF0, 0xC77, 0xC84, 0xDF4, 0xE4F, 0xE5A, 0xE5B, 0xF14, 0xF85,
0xFD9, 0xFDA, 0x10FB, 0x1400, 0x166E, 0x169B, 0x169C, 0x1735, 0x1736,
0x1944, 0x1945, 0x1A1E, 0x1A1F, 0x1B7D, 0x1B7E, 0x1C7E, 0x1C7F, 0x1CD3,
0x207D, 0x207E, 0x208D, 0x208E, 0x2329, 0x232A, 0x27C5, 0x27C6, 0x29FC,
0x29FD, 0x2CFE, 0x2CFF, 0x2D70, 0x3030, 0x303D, 0x30A0, 0x30FB, 0xA4FE,
0xA4FF, 0xA673, 0xA67E, 0xA8CE, 0xA8CF, 0xA8FC, 0xA92E, 0xA92F, 0xA95F,
0xA9DE, 0xA9DF, 0xAADE, 0xAADF, 0xAAF0, 0xAAF1, 0xABEB, 0xFD3E, 0xFD3F,
0xFE63, 0xFE68, 0xFE6A, 0xFE6B, 0xFF1A, 0xFF1B, 0xFF1F, 0xFF20, 0xFF3F,
0xFF5B, 0xFF5D
#if CHRBITS > 16
,0x1039F, 0x103D0, 0x1056F, 0x10857, 0x1091F, 0x1093F, 0x10A7F, 0x10EAD, 0x110BB,
0x110BC, 0x11174, 0x11175, 0x111CD, 0x111DB, 0x112A9, 0x1145A, 0x1145B, 0x1145D,
0x114C6, 0x116B9, 0x1183B, 0x119E2, 0x11C70, 0x11C71, 0x11EF7, 0x11EF8, 0x11FFF,
0x12FF1, 0x12FF2, 0x16A6E, 0x16A6F, 0x16AF5, 0x16B44, 0x16FE2, 0x1BC9F, 0x1E95E,
0x1E95F
#endif
};
#define NUM_PUNCT_CHAR (sizeof(punctCharTable)/sizeof(chr))
/*
* Unicode: white space characters.
|
| ︙ | ︙ | |||
425 426 427 428 429 430 431 |
{0x3EF, 0x3F3}, {0x430, 0x45F}, {0x560, 0x588}, {0x10D0, 0x10FA},
{0x10FD, 0x10FF}, {0x13F8, 0x13FD}, {0x1C80, 0x1C88}, {0x1D00, 0x1D2B},
{0x1D6B, 0x1D77}, {0x1D79, 0x1D9A}, {0x1E95, 0x1E9D}, {0x1EFF, 0x1F07},
{0x1F10, 0x1F15}, {0x1F20, 0x1F27}, {0x1F30, 0x1F37}, {0x1F40, 0x1F45},
{0x1F50, 0x1F57}, {0x1F60, 0x1F67}, {0x1F70, 0x1F7D}, {0x1F80, 0x1F87},
{0x1F90, 0x1F97}, {0x1FA0, 0x1FA7}, {0x1FB0, 0x1FB4}, {0x1FC2, 0x1FC4},
{0x1FD0, 0x1FD3}, {0x1FE0, 0x1FE7}, {0x1FF2, 0x1FF4}, {0x2146, 0x2149},
| | | > | | | | | | | > | 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 |
{0x3EF, 0x3F3}, {0x430, 0x45F}, {0x560, 0x588}, {0x10D0, 0x10FA},
{0x10FD, 0x10FF}, {0x13F8, 0x13FD}, {0x1C80, 0x1C88}, {0x1D00, 0x1D2B},
{0x1D6B, 0x1D77}, {0x1D79, 0x1D9A}, {0x1E95, 0x1E9D}, {0x1EFF, 0x1F07},
{0x1F10, 0x1F15}, {0x1F20, 0x1F27}, {0x1F30, 0x1F37}, {0x1F40, 0x1F45},
{0x1F50, 0x1F57}, {0x1F60, 0x1F67}, {0x1F70, 0x1F7D}, {0x1F80, 0x1F87},
{0x1F90, 0x1F97}, {0x1FA0, 0x1FA7}, {0x1FB0, 0x1FB4}, {0x1FC2, 0x1FC4},
{0x1FD0, 0x1FD3}, {0x1FE0, 0x1FE7}, {0x1FF2, 0x1FF4}, {0x2146, 0x2149},
{0x2C30, 0x2C5F}, {0x2C76, 0x2C7B}, {0x2D00, 0x2D25}, {0xA72F, 0xA731},
{0xA771, 0xA778}, {0xA793, 0xA795}, {0xAB30, 0xAB5A}, {0xAB60, 0xAB68},
{0xAB70, 0xABBF}, {0xFB00, 0xFB06}, {0xFB13, 0xFB17}, {0xFF41, 0xFF5A}
#if CHRBITS > 16
,{0x10428, 0x1044F}, {0x104D8, 0x104FB}, {0x10597, 0x105A1}, {0x105A3, 0x105B1},
{0x105B3, 0x105B9}, {0x10CC0, 0x10CF2}, {0x118C0, 0x118DF}, {0x16E60, 0x16E7F},
{0x1D41A, 0x1D433}, {0x1D44E, 0x1D454}, {0x1D456, 0x1D467}, {0x1D482, 0x1D49B},
{0x1D4B6, 0x1D4B9}, {0x1D4BD, 0x1D4C3}, {0x1D4C5, 0x1D4CF}, {0x1D4EA, 0x1D503},
{0x1D51E, 0x1D537}, {0x1D552, 0x1D56B}, {0x1D586, 0x1D59F}, {0x1D5BA, 0x1D5D3},
{0x1D5EE, 0x1D607}, {0x1D622, 0x1D63B}, {0x1D656, 0x1D66F}, {0x1D68A, 0x1D6A5},
{0x1D6C2, 0x1D6DA}, {0x1D6DC, 0x1D6E1}, {0x1D6FC, 0x1D714}, {0x1D716, 0x1D71B},
{0x1D736, 0x1D74E}, {0x1D750, 0x1D755}, {0x1D770, 0x1D788}, {0x1D78A, 0x1D78F},
{0x1D7AA, 0x1D7C2}, {0x1D7C4, 0x1D7C9}, {0x1DF00, 0x1DF09}, {0x1DF0B, 0x1DF1E},
{0x1E922, 0x1E943}
#endif
};
#define NUM_LOWER_RANGE (sizeof(lowerRangeTable)/sizeof(crange))
static const chr lowerCharTable[] = {
0xB5, 0x101, 0x103, 0x105, 0x107, 0x109, 0x10B, 0x10D, 0x10F,
|
| ︙ | ︙ | |||
506 507 508 509 510 511 512 |
0xA691, 0xA693, 0xA695, 0xA697, 0xA699, 0xA69B, 0xA723, 0xA725, 0xA727,
0xA729, 0xA72B, 0xA72D, 0xA733, 0xA735, 0xA737, 0xA739, 0xA73B, 0xA73D,
0xA73F, 0xA741, 0xA743, 0xA745, 0xA747, 0xA749, 0xA74B, 0xA74D, 0xA74F,
0xA751, 0xA753, 0xA755, 0xA757, 0xA759, 0xA75B, 0xA75D, 0xA75F, 0xA761,
0xA763, 0xA765, 0xA767, 0xA769, 0xA76B, 0xA76D, 0xA76F, 0xA77A, 0xA77C,
0xA77F, 0xA781, 0xA783, 0xA785, 0xA787, 0xA78C, 0xA78E, 0xA791, 0xA797,
0xA799, 0xA79B, 0xA79D, 0xA79F, 0xA7A1, 0xA7A3, 0xA7A5, 0xA7A7, 0xA7A9,
| | | | | | > | | | | | | < | 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 |
0xA691, 0xA693, 0xA695, 0xA697, 0xA699, 0xA69B, 0xA723, 0xA725, 0xA727,
0xA729, 0xA72B, 0xA72D, 0xA733, 0xA735, 0xA737, 0xA739, 0xA73B, 0xA73D,
0xA73F, 0xA741, 0xA743, 0xA745, 0xA747, 0xA749, 0xA74B, 0xA74D, 0xA74F,
0xA751, 0xA753, 0xA755, 0xA757, 0xA759, 0xA75B, 0xA75D, 0xA75F, 0xA761,
0xA763, 0xA765, 0xA767, 0xA769, 0xA76B, 0xA76D, 0xA76F, 0xA77A, 0xA77C,
0xA77F, 0xA781, 0xA783, 0xA785, 0xA787, 0xA78C, 0xA78E, 0xA791, 0xA797,
0xA799, 0xA79B, 0xA79D, 0xA79F, 0xA7A1, 0xA7A3, 0xA7A5, 0xA7A7, 0xA7A9,
0xA7AF, 0xA7B5, 0xA7B7, 0xA7B9, 0xA7BB, 0xA7BD, 0xA7BF, 0xA7C1, 0xA7C3,
0xA7C8, 0xA7CA, 0xA7D1, 0xA7D3, 0xA7D5, 0xA7D7, 0xA7D9, 0xA7F6, 0xA7FA
#if CHRBITS > 16
,0x105BB, 0x105BC, 0x1D4BB, 0x1D7CB
#endif
};
#define NUM_LOWER_CHAR (sizeof(lowerCharTable)/sizeof(chr))
/*
* Unicode: uppercase characters.
*/
static const crange upperRangeTable[] = {
{0x41, 0x5A}, {0xC0, 0xD6}, {0xD8, 0xDE}, {0x189, 0x18B},
{0x18E, 0x191}, {0x196, 0x198}, {0x1B1, 0x1B3}, {0x1F6, 0x1F8},
{0x243, 0x246}, {0x388, 0x38A}, {0x391, 0x3A1}, {0x3A3, 0x3AB},
{0x3D2, 0x3D4}, {0x3FD, 0x42F}, {0x531, 0x556}, {0x10A0, 0x10C5},
{0x13A0, 0x13F5}, {0x1C90, 0x1CBA}, {0x1CBD, 0x1CBF}, {0x1F08, 0x1F0F},
{0x1F18, 0x1F1D}, {0x1F28, 0x1F2F}, {0x1F38, 0x1F3F}, {0x1F48, 0x1F4D},
{0x1F68, 0x1F6F}, {0x1FB8, 0x1FBB}, {0x1FC8, 0x1FCB}, {0x1FD8, 0x1FDB},
{0x1FE8, 0x1FEC}, {0x1FF8, 0x1FFB}, {0x210B, 0x210D}, {0x2110, 0x2112},
{0x2119, 0x211D}, {0x212A, 0x212D}, {0x2130, 0x2133}, {0x2C00, 0x2C2F},
{0x2C62, 0x2C64}, {0x2C6D, 0x2C70}, {0x2C7E, 0x2C80}, {0xA7AA, 0xA7AE},
{0xA7B0, 0xA7B4}, {0xA7C4, 0xA7C7}, {0xFF21, 0xFF3A}
#if CHRBITS > 16
,{0x10400, 0x10427}, {0x104B0, 0x104D3}, {0x10570, 0x1057A}, {0x1057C, 0x1058A},
{0x1058C, 0x10592}, {0x10C80, 0x10CB2}, {0x118A0, 0x118BF}, {0x16E40, 0x16E5F},
{0x1D400, 0x1D419}, {0x1D434, 0x1D44D}, {0x1D468, 0x1D481}, {0x1D4A9, 0x1D4AC},
{0x1D4AE, 0x1D4B5}, {0x1D4D0, 0x1D4E9}, {0x1D507, 0x1D50A}, {0x1D50D, 0x1D514},
{0x1D516, 0x1D51C}, {0x1D53B, 0x1D53E}, {0x1D540, 0x1D544}, {0x1D54A, 0x1D550},
{0x1D56C, 0x1D585}, {0x1D5A0, 0x1D5B9}, {0x1D5D4, 0x1D5ED}, {0x1D608, 0x1D621},
{0x1D63C, 0x1D655}, {0x1D670, 0x1D689}, {0x1D6A8, 0x1D6C0}, {0x1D6E2, 0x1D6FA},
{0x1D71C, 0x1D734}, {0x1D756, 0x1D76E}, {0x1D790, 0x1D7A8}, {0x1E900, 0x1E921}
#endif
};
#define NUM_UPPER_RANGE (sizeof(upperRangeTable)/sizeof(crange))
static const chr upperCharTable[] = {
0x100, 0x102, 0x104, 0x106, 0x108, 0x10A, 0x10C, 0x10E, 0x110,
|
| ︙ | ︙ | |||
609 610 611 612 613 614 615 |
0xA698, 0xA69A, 0xA722, 0xA724, 0xA726, 0xA728, 0xA72A, 0xA72C, 0xA72E,
0xA732, 0xA734, 0xA736, 0xA738, 0xA73A, 0xA73C, 0xA73E, 0xA740, 0xA742,
0xA744, 0xA746, 0xA748, 0xA74A, 0xA74C, 0xA74E, 0xA750, 0xA752, 0xA754,
0xA756, 0xA758, 0xA75A, 0xA75C, 0xA75E, 0xA760, 0xA762, 0xA764, 0xA766,
0xA768, 0xA76A, 0xA76C, 0xA76E, 0xA779, 0xA77B, 0xA77D, 0xA77E, 0xA780,
0xA782, 0xA784, 0xA786, 0xA78B, 0xA78D, 0xA790, 0xA792, 0xA796, 0xA798,
0xA79A, 0xA79C, 0xA79E, 0xA7A0, 0xA7A2, 0xA7A4, 0xA7A6, 0xA7A8, 0xA7B6,
| | > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < | | | | | | | | | | | | | | | | | | | | | | < | | | | | | | | | | | > > | | | | | | | | | > | | | | | | | | | | | | | | | | | | | | | | | | | > | | > | | | | | | | | | > | | | | | | | | | | < | | > | | | | | | | | | | | | | | > | | | | | 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 |
0xA698, 0xA69A, 0xA722, 0xA724, 0xA726, 0xA728, 0xA72A, 0xA72C, 0xA72E,
0xA732, 0xA734, 0xA736, 0xA738, 0xA73A, 0xA73C, 0xA73E, 0xA740, 0xA742,
0xA744, 0xA746, 0xA748, 0xA74A, 0xA74C, 0xA74E, 0xA750, 0xA752, 0xA754,
0xA756, 0xA758, 0xA75A, 0xA75C, 0xA75E, 0xA760, 0xA762, 0xA764, 0xA766,
0xA768, 0xA76A, 0xA76C, 0xA76E, 0xA779, 0xA77B, 0xA77D, 0xA77E, 0xA780,
0xA782, 0xA784, 0xA786, 0xA78B, 0xA78D, 0xA790, 0xA792, 0xA796, 0xA798,
0xA79A, 0xA79C, 0xA79E, 0xA7A0, 0xA7A2, 0xA7A4, 0xA7A6, 0xA7A8, 0xA7B6,
0xA7B8, 0xA7BA, 0xA7BC, 0xA7BE, 0xA7C0, 0xA7C2, 0xA7C9, 0xA7D0, 0xA7D6,
0xA7D8, 0xA7F5
#if CHRBITS > 16
,0x10594, 0x10595, 0x1D49C, 0x1D49E, 0x1D49F, 0x1D4A2, 0x1D4A5, 0x1D4A6, 0x1D504,
0x1D505, 0x1D538, 0x1D539, 0x1D546, 0x1D7CA
#endif
};
#define NUM_UPPER_CHAR (sizeof(upperCharTable)/sizeof(chr))
/*
* Unicode: unicode print characters excluding space.
*/
static const crange graphRangeTable[] = {
{0x21, 0x7E}, {0xA1, 0xAC}, {0xAE, 0x377}, {0x37A, 0x37F},
{0x384, 0x38A}, {0x38E, 0x3A1}, {0x3A3, 0x52F}, {0x531, 0x556},
{0x559, 0x58A}, {0x58D, 0x58F}, {0x591, 0x5C7}, {0x5D0, 0x5EA},
{0x5EF, 0x5F4}, {0x606, 0x61B}, {0x61D, 0x6DC}, {0x6DE, 0x70D},
{0x710, 0x74A}, {0x74D, 0x7B1}, {0x7C0, 0x7FA}, {0x7FD, 0x82D},
{0x830, 0x83E}, {0x840, 0x85B}, {0x860, 0x86A}, {0x870, 0x88E},
{0x898, 0x8E1}, {0x8E3, 0x983}, {0x985, 0x98C}, {0x993, 0x9A8},
{0x9AA, 0x9B0}, {0x9B6, 0x9B9}, {0x9BC, 0x9C4}, {0x9CB, 0x9CE},
{0x9DF, 0x9E3}, {0x9E6, 0x9FE}, {0xA01, 0xA03}, {0xA05, 0xA0A},
{0xA13, 0xA28}, {0xA2A, 0xA30}, {0xA3E, 0xA42}, {0xA4B, 0xA4D},
{0xA59, 0xA5C}, {0xA66, 0xA76}, {0xA81, 0xA83}, {0xA85, 0xA8D},
{0xA8F, 0xA91}, {0xA93, 0xAA8}, {0xAAA, 0xAB0}, {0xAB5, 0xAB9},
{0xABC, 0xAC5}, {0xAC7, 0xAC9}, {0xACB, 0xACD}, {0xAE0, 0xAE3},
{0xAE6, 0xAF1}, {0xAF9, 0xAFF}, {0xB01, 0xB03}, {0xB05, 0xB0C},
{0xB13, 0xB28}, {0xB2A, 0xB30}, {0xB35, 0xB39}, {0xB3C, 0xB44},
{0xB4B, 0xB4D}, {0xB55, 0xB57}, {0xB5F, 0xB63}, {0xB66, 0xB77},
{0xB85, 0xB8A}, {0xB8E, 0xB90}, {0xB92, 0xB95}, {0xBA8, 0xBAA},
{0xBAE, 0xBB9}, {0xBBE, 0xBC2}, {0xBC6, 0xBC8}, {0xBCA, 0xBCD},
{0xBE6, 0xBFA}, {0xC00, 0xC0C}, {0xC0E, 0xC10}, {0xC12, 0xC28},
{0xC2A, 0xC39}, {0xC3C, 0xC44}, {0xC46, 0xC48}, {0xC4A, 0xC4D},
{0xC58, 0xC5A}, {0xC60, 0xC63}, {0xC66, 0xC6F}, {0xC77, 0xC8C},
{0xC8E, 0xC90}, {0xC92, 0xCA8}, {0xCAA, 0xCB3}, {0xCB5, 0xCB9},
{0xCBC, 0xCC4}, {0xCC6, 0xCC8}, {0xCCA, 0xCCD}, {0xCE0, 0xCE3},
{0xCE6, 0xCEF}, {0xD00, 0xD0C}, {0xD0E, 0xD10}, {0xD12, 0xD44},
{0xD46, 0xD48}, {0xD4A, 0xD4F}, {0xD54, 0xD63}, {0xD66, 0xD7F},
{0xD81, 0xD83}, {0xD85, 0xD96}, {0xD9A, 0xDB1}, {0xDB3, 0xDBB},
{0xDC0, 0xDC6}, {0xDCF, 0xDD4}, {0xDD8, 0xDDF}, {0xDE6, 0xDEF},
{0xDF2, 0xDF4}, {0xE01, 0xE3A}, {0xE3F, 0xE5B}, {0xE86, 0xE8A},
{0xE8C, 0xEA3}, {0xEA7, 0xEBD}, {0xEC0, 0xEC4}, {0xEC8, 0xECD},
{0xED0, 0xED9}, {0xEDC, 0xEDF}, {0xF00, 0xF47}, {0xF49, 0xF6C},
{0xF71, 0xF97}, {0xF99, 0xFBC}, {0xFBE, 0xFCC}, {0xFCE, 0xFDA},
{0x1000, 0x10C5}, {0x10D0, 0x1248}, {0x124A, 0x124D}, {0x1250, 0x1256},
{0x125A, 0x125D}, {0x1260, 0x1288}, {0x128A, 0x128D}, {0x1290, 0x12B0},
{0x12B2, 0x12B5}, {0x12B8, 0x12BE}, {0x12C2, 0x12C5}, {0x12C8, 0x12D6},
{0x12D8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135A}, {0x135D, 0x137C},
{0x1380, 0x1399}, {0x13A0, 0x13F5}, {0x13F8, 0x13FD}, {0x1400, 0x167F},
{0x1681, 0x169C}, {0x16A0, 0x16F8}, {0x1700, 0x1715}, {0x171F, 0x1736},
{0x1740, 0x1753}, {0x1760, 0x176C}, {0x176E, 0x1770}, {0x1780, 0x17DD},
{0x17E0, 0x17E9}, {0x17F0, 0x17F9}, {0x1800, 0x180D}, {0x180F, 0x1819},
{0x1820, 0x1878}, {0x1880, 0x18AA}, {0x18B0, 0x18F5}, {0x1900, 0x191E},
{0x1920, 0x192B}, {0x1930, 0x193B}, {0x1944, 0x196D}, {0x1970, 0x1974},
{0x1980, 0x19AB}, {0x19B0, 0x19C9}, {0x19D0, 0x19DA}, {0x19DE, 0x1A1B},
{0x1A1E, 0x1A5E}, {0x1A60, 0x1A7C}, {0x1A7F, 0x1A89}, {0x1A90, 0x1A99},
{0x1AA0, 0x1AAD}, {0x1AB0, 0x1ACE}, {0x1B00, 0x1B4C}, {0x1B50, 0x1B7E},
{0x1B80, 0x1BF3}, {0x1BFC, 0x1C37}, {0x1C3B, 0x1C49}, {0x1C4D, 0x1C88},
{0x1C90, 0x1CBA}, {0x1CBD, 0x1CC7}, {0x1CD0, 0x1CFA}, {0x1D00, 0x1F15},
{0x1F18, 0x1F1D}, {0x1F20, 0x1F45}, {0x1F48, 0x1F4D}, {0x1F50, 0x1F57},
{0x1F5F, 0x1F7D}, {0x1F80, 0x1FB4}, {0x1FB6, 0x1FC4}, {0x1FC6, 0x1FD3},
{0x1FD6, 0x1FDB}, {0x1FDD, 0x1FEF}, {0x1FF2, 0x1FF4}, {0x1FF6, 0x1FFE},
{0x2010, 0x2027}, {0x2030, 0x205E}, {0x2074, 0x208E}, {0x2090, 0x209C},
{0x20A0, 0x20C0}, {0x20D0, 0x20F0}, {0x2100, 0x218B}, {0x2190, 0x2426},
{0x2440, 0x244A}, {0x2460, 0x2B73}, {0x2B76, 0x2B95}, {0x2B97, 0x2CF3},
{0x2CF9, 0x2D25}, {0x2D30, 0x2D67}, {0x2D7F, 0x2D96}, {0x2DA0, 0x2DA6},
{0x2DA8, 0x2DAE}, {0x2DB0, 0x2DB6}, {0x2DB8, 0x2DBE}, {0x2DC0, 0x2DC6},
{0x2DC8, 0x2DCE}, {0x2DD0, 0x2DD6}, {0x2DD8, 0x2DDE}, {0x2DE0, 0x2E5D},
{0x2E80, 0x2E99}, {0x2E9B, 0x2EF3}, {0x2F00, 0x2FD5}, {0x2FF0, 0x2FFB},
{0x3001, 0x303F}, {0x3041, 0x3096}, {0x3099, 0x30FF}, {0x3105, 0x312F},
{0x3131, 0x318E}, {0x3190, 0x31E3}, {0x31F0, 0x321E}, {0x3220, 0xA48C},
{0xA490, 0xA4C6}, {0xA4D0, 0xA62B}, {0xA640, 0xA6F7}, {0xA700, 0xA7CA},
{0xA7D5, 0xA7D9}, {0xA7F2, 0xA82C}, {0xA830, 0xA839}, {0xA840, 0xA877},
{0xA880, 0xA8C5}, {0xA8CE, 0xA8D9}, {0xA8E0, 0xA953}, {0xA95F, 0xA97C},
{0xA980, 0xA9CD}, {0xA9CF, 0xA9D9}, {0xA9DE, 0xA9FE}, {0xAA00, 0xAA36},
{0xAA40, 0xAA4D}, {0xAA50, 0xAA59}, {0xAA5C, 0xAAC2}, {0xAADB, 0xAAF6},
{0xAB01, 0xAB06}, {0xAB09, 0xAB0E}, {0xAB11, 0xAB16}, {0xAB20, 0xAB26},
{0xAB28, 0xAB2E}, {0xAB30, 0xAB6B}, {0xAB70, 0xABED}, {0xABF0, 0xABF9},
{0xAC00, 0xD7A3}, {0xD7B0, 0xD7C6}, {0xD7CB, 0xD7FB}, {0xF900, 0xFA6D},
{0xFA70, 0xFAD9}, {0xFB00, 0xFB06}, {0xFB13, 0xFB17}, {0xFB1D, 0xFB36},
{0xFB38, 0xFB3C}, {0xFB46, 0xFBC2}, {0xFBD3, 0xFD8F}, {0xFD92, 0xFDC7},
{0xFDF0, 0xFE19}, {0xFE20, 0xFE52}, {0xFE54, 0xFE66}, {0xFE68, 0xFE6B},
{0xFE70, 0xFE74}, {0xFE76, 0xFEFC}, {0xFF01, 0xFFBE}, {0xFFC2, 0xFFC7},
{0xFFCA, 0xFFCF}, {0xFFD2, 0xFFD7}, {0xFFDA, 0xFFDC}, {0xFFE0, 0xFFE6},
{0xFFE8, 0xFFEE}
#if CHRBITS > 16
,{0x10000, 0x1000B}, {0x1000D, 0x10026}, {0x10028, 0x1003A}, {0x1003F, 0x1004D},
{0x10050, 0x1005D}, {0x10080, 0x100FA}, {0x10100, 0x10102}, {0x10107, 0x10133},
{0x10137, 0x1018E}, {0x10190, 0x1019C}, {0x101D0, 0x101FD}, {0x10280, 0x1029C},
{0x102A0, 0x102D0}, {0x102E0, 0x102FB}, {0x10300, 0x10323}, {0x1032D, 0x1034A},
{0x10350, 0x1037A}, {0x10380, 0x1039D}, {0x1039F, 0x103C3}, {0x103C8, 0x103D5},
{0x10400, 0x1049D}, {0x104A0, 0x104A9}, {0x104B0, 0x104D3}, {0x104D8, 0x104FB},
{0x10500, 0x10527}, {0x10530, 0x10563}, {0x1056F, 0x1057A}, {0x1057C, 0x1058A},
{0x1058C, 0x10592}, {0x10597, 0x105A1}, {0x105A3, 0x105B1}, {0x105B3, 0x105B9},
{0x10600, 0x10736}, {0x10740, 0x10755}, {0x10760, 0x10767}, {0x10780, 0x10785},
{0x10787, 0x107B0}, {0x107B2, 0x107BA}, {0x10800, 0x10805}, {0x1080A, 0x10835},
{0x1083F, 0x10855}, {0x10857, 0x1089E}, {0x108A7, 0x108AF}, {0x108E0, 0x108F2},
{0x108FB, 0x1091B}, {0x1091F, 0x10939}, {0x10980, 0x109B7}, {0x109BC, 0x109CF},
{0x109D2, 0x10A03}, {0x10A0C, 0x10A13}, {0x10A15, 0x10A17}, {0x10A19, 0x10A35},
{0x10A38, 0x10A3A}, {0x10A3F, 0x10A48}, {0x10A50, 0x10A58}, {0x10A60, 0x10A9F},
{0x10AC0, 0x10AE6}, {0x10AEB, 0x10AF6}, {0x10B00, 0x10B35}, {0x10B39, 0x10B55},
{0x10B58, 0x10B72}, {0x10B78, 0x10B91}, {0x10B99, 0x10B9C}, {0x10BA9, 0x10BAF},
{0x10C00, 0x10C48}, {0x10C80, 0x10CB2}, {0x10CC0, 0x10CF2}, {0x10CFA, 0x10D27},
{0x10D30, 0x10D39}, {0x10E60, 0x10E7E}, {0x10E80, 0x10EA9}, {0x10EAB, 0x10EAD},
{0x10F00, 0x10F27}, {0x10F30, 0x10F59}, {0x10F70, 0x10F89}, {0x10FB0, 0x10FCB},
{0x10FE0, 0x10FF6}, {0x11000, 0x1104D}, {0x11052, 0x11075}, {0x1107F, 0x110BC},
{0x110BE, 0x110C2}, {0x110D0, 0x110E8}, {0x110F0, 0x110F9}, {0x11100, 0x11134},
{0x11136, 0x11147}, {0x11150, 0x11176}, {0x11180, 0x111DF}, {0x111E1, 0x111F4},
{0x11200, 0x11211}, {0x11213, 0x1123E}, {0x11280, 0x11286}, {0x1128A, 0x1128D},
{0x1128F, 0x1129D}, {0x1129F, 0x112A9}, {0x112B0, 0x112EA}, {0x112F0, 0x112F9},
{0x11300, 0x11303}, {0x11305, 0x1130C}, {0x11313, 0x11328}, {0x1132A, 0x11330},
{0x11335, 0x11339}, {0x1133B, 0x11344}, {0x1134B, 0x1134D}, {0x1135D, 0x11363},
{0x11366, 0x1136C}, {0x11370, 0x11374}, {0x11400, 0x1145B}, {0x1145D, 0x11461},
{0x11480, 0x114C7}, {0x114D0, 0x114D9}, {0x11580, 0x115B5}, {0x115B8, 0x115DD},
{0x11600, 0x11644}, {0x11650, 0x11659}, {0x11660, 0x1166C}, {0x11680, 0x116B9},
{0x116C0, 0x116C9}, {0x11700, 0x1171A}, {0x1171D, 0x1172B}, {0x11730, 0x11746},
{0x11800, 0x1183B}, {0x118A0, 0x118F2}, {0x118FF, 0x11906}, {0x1190C, 0x11913},
{0x11918, 0x11935}, {0x1193B, 0x11946}, {0x11950, 0x11959}, {0x119A0, 0x119A7},
{0x119AA, 0x119D7}, {0x119DA, 0x119E4}, {0x11A00, 0x11A47}, {0x11A50, 0x11AA2},
{0x11AB0, 0x11AF8}, {0x11C00, 0x11C08}, {0x11C0A, 0x11C36}, {0x11C38, 0x11C45},
{0x11C50, 0x11C6C}, {0x11C70, 0x11C8F}, {0x11C92, 0x11CA7}, {0x11CA9, 0x11CB6},
{0x11D00, 0x11D06}, {0x11D0B, 0x11D36}, {0x11D3F, 0x11D47}, {0x11D50, 0x11D59},
{0x11D60, 0x11D65}, {0x11D6A, 0x11D8E}, {0x11D93, 0x11D98}, {0x11DA0, 0x11DA9},
{0x11EE0, 0x11EF8}, {0x11FC0, 0x11FF1}, {0x11FFF, 0x12399}, {0x12400, 0x1246E},
{0x12470, 0x12474}, {0x12480, 0x12543}, {0x12F90, 0x12FF2}, {0x13000, 0x1342E},
{0x14400, 0x14646}, {0x16800, 0x16A38}, {0x16A40, 0x16A5E}, {0x16A60, 0x16A69},
{0x16A6E, 0x16ABE}, {0x16AC0, 0x16AC9}, {0x16AD0, 0x16AED}, {0x16AF0, 0x16AF5},
{0x16B00, 0x16B45}, {0x16B50, 0x16B59}, {0x16B5B, 0x16B61}, {0x16B63, 0x16B77},
{0x16B7D, 0x16B8F}, {0x16E40, 0x16E9A}, {0x16F00, 0x16F4A}, {0x16F4F, 0x16F87},
{0x16F8F, 0x16F9F}, {0x16FE0, 0x16FE4}, {0x17000, 0x187F7}, {0x18800, 0x18CD5},
{0x18D00, 0x18D08}, {0x1AFF0, 0x1AFF3}, {0x1AFF5, 0x1AFFB}, {0x1B000, 0x1B122},
{0x1B150, 0x1B152}, {0x1B164, 0x1B167}, {0x1B170, 0x1B2FB}, {0x1BC00, 0x1BC6A},
{0x1BC70, 0x1BC7C}, {0x1BC80, 0x1BC88}, {0x1BC90, 0x1BC99}, {0x1BC9C, 0x1BC9F},
{0x1CF00, 0x1CF2D}, {0x1CF30, 0x1CF46}, {0x1CF50, 0x1CFC3}, {0x1D000, 0x1D0F5},
{0x1D100, 0x1D126}, {0x1D129, 0x1D172}, {0x1D17B, 0x1D1EA}, {0x1D200, 0x1D245},
{0x1D2E0, 0x1D2F3}, {0x1D300, 0x1D356}, {0x1D360, 0x1D378}, {0x1D400, 0x1D454},
{0x1D456, 0x1D49C}, {0x1D4A9, 0x1D4AC}, {0x1D4AE, 0x1D4B9}, {0x1D4BD, 0x1D4C3},
{0x1D4C5, 0x1D505}, {0x1D507, 0x1D50A}, {0x1D50D, 0x1D514}, {0x1D516, 0x1D51C},
{0x1D51E, 0x1D539}, {0x1D53B, 0x1D53E}, {0x1D540, 0x1D544}, {0x1D54A, 0x1D550},
{0x1D552, 0x1D6A5}, {0x1D6A8, 0x1D7CB}, {0x1D7CE, 0x1DA8B}, {0x1DA9B, 0x1DA9F},
{0x1DAA1, 0x1DAAF}, {0x1DF00, 0x1DF1E}, {0x1E000, 0x1E006}, {0x1E008, 0x1E018},
{0x1E01B, 0x1E021}, {0x1E026, 0x1E02A}, {0x1E100, 0x1E12C}, {0x1E130, 0x1E13D},
{0x1E140, 0x1E149}, {0x1E290, 0x1E2AE}, {0x1E2C0, 0x1E2F9}, {0x1E7E0, 0x1E7E6},
{0x1E7E8, 0x1E7EB}, {0x1E7F0, 0x1E7FE}, {0x1E800, 0x1E8C4}, {0x1E8C7, 0x1E8D6},
{0x1E900, 0x1E94B}, {0x1E950, 0x1E959}, {0x1EC71, 0x1ECB4}, {0x1ED01, 0x1ED3D},
{0x1EE00, 0x1EE03}, {0x1EE05, 0x1EE1F}, {0x1EE29, 0x1EE32}, {0x1EE34, 0x1EE37},
{0x1EE4D, 0x1EE4F}, {0x1EE67, 0x1EE6A}, {0x1EE6C, 0x1EE72}, {0x1EE74, 0x1EE77},
{0x1EE79, 0x1EE7C}, {0x1EE80, 0x1EE89}, {0x1EE8B, 0x1EE9B}, {0x1EEA1, 0x1EEA3},
{0x1EEA5, 0x1EEA9}, {0x1EEAB, 0x1EEBB}, {0x1F000, 0x1F02B}, {0x1F030, 0x1F093},
{0x1F0A0, 0x1F0AE}, {0x1F0B1, 0x1F0BF}, {0x1F0C1, 0x1F0CF}, {0x1F0D1, 0x1F0F5},
{0x1F100, 0x1F1AD}, {0x1F1E6, 0x1F202}, {0x1F210, 0x1F23B}, {0x1F240, 0x1F248},
{0x1F260, 0x1F265}, {0x1F300, 0x1F6D7}, {0x1F6DD, 0x1F6EC}, {0x1F6F0, 0x1F6FC},
{0x1F700, 0x1F773}, {0x1F780, 0x1F7D8}, {0x1F7E0, 0x1F7EB}, {0x1F800, 0x1F80B},
{0x1F810, 0x1F847}, {0x1F850, 0x1F859}, {0x1F860, 0x1F887}, {0x1F890, 0x1F8AD},
{0x1F900, 0x1FA53}, {0x1FA60, 0x1FA6D}, {0x1FA70, 0x1FA74}, {0x1FA78, 0x1FA7C},
{0x1FA80, 0x1FA86}, {0x1FA90, 0x1FAAC}, {0x1FAB0, 0x1FABA}, {0x1FAC0, 0x1FAC5},
{0x1FAD0, 0x1FAD9}, {0x1FAE0, 0x1FAE7}, {0x1FAF0, 0x1FAF6}, {0x1FB00, 0x1FB92},
{0x1FB94, 0x1FBCA}, {0x1FBF0, 0x1FBF9}, {0x20000, 0x2A6DF}, {0x2A700, 0x2B738},
{0x2B740, 0x2B81D}, {0x2B820, 0x2CEA1}, {0x2CEB0, 0x2EBE0}, {0x2F800, 0x2FA1D},
{0x30000, 0x3134A}, {0xE0100, 0xE01EF}
#endif
};
#define NUM_GRAPH_RANGE (sizeof(graphRangeTable)/sizeof(crange))
static const chr graphCharTable[] = {
0x38C, 0x85E, 0x98F, 0x990, 0x9B2, 0x9C7, 0x9C8, 0x9D7, 0x9DC,
0x9DD, 0xA0F, 0xA10, 0xA32, 0xA33, 0xA35, 0xA36, 0xA38, 0xA39,
0xA3C, 0xA47, 0xA48, 0xA51, 0xA5E, 0xAB2, 0xAB3, 0xAD0, 0xB0F,
0xB10, 0xB32, 0xB33, 0xB47, 0xB48, 0xB5C, 0xB5D, 0xB82, 0xB83,
0xB99, 0xB9A, 0xB9C, 0xB9E, 0xB9F, 0xBA3, 0xBA4, 0xBD0, 0xBD7,
0xC55, 0xC56, 0xC5D, 0xCD5, 0xCD6, 0xCDD, 0xCDE, 0xCF1, 0xCF2,
0xDBD, 0xDCA, 0xDD6, 0xE81, 0xE82, 0xE84, 0xEA5, 0xEC6, 0x10C7,
0x10CD, 0x1258, 0x12C0, 0x1772, 0x1773, 0x1940, 0x1F59, 0x1F5B, 0x1F5D,
0x2070, 0x2071, 0x2D27, 0x2D2D, 0x2D6F, 0x2D70, 0xA7D0, 0xA7D1, 0xA7D3,
0xFB3E, 0xFB40, 0xFB41, 0xFB43, 0xFB44, 0xFDCF, 0xFFFC, 0xFFFD
#if CHRBITS > 16
,0x1003C, 0x1003D, 0x101A0, 0x10594, 0x10595, 0x105BB, 0x105BC, 0x10808, 0x10837,
0x10838, 0x1083C, 0x108F4, 0x108F5, 0x1093F, 0x10A05, 0x10A06, 0x10EB0, 0x10EB1,
0x11288, 0x1130F, 0x11310, 0x11332, 0x11333, 0x11347, 0x11348, 0x11350, 0x11357,
0x11909, 0x11915, 0x11916, 0x11937, 0x11938, 0x11D08, 0x11D09, 0x11D3A, 0x11D3C,
0x11D3D, 0x11D67, 0x11D68, 0x11D90, 0x11D91, 0x11FB0, 0x16FF0, 0x16FF1, 0x1AFFD,
0x1AFFE, 0x1D49E, 0x1D49F, 0x1D4A2, 0x1D4A5, 0x1D4A6, 0x1D4BB, 0x1D546, 0x1E023,
0x1E024, 0x1E14E, 0x1E14F, 0x1E2FF, 0x1E7ED, 0x1E7EE, 0x1E95E, 0x1E95F, 0x1EE21,
0x1EE22, 0x1EE24, 0x1EE27, 0x1EE39, 0x1EE3B, 0x1EE42, 0x1EE47, 0x1EE49, 0x1EE4B,
0x1EE51, 0x1EE52, 0x1EE54, 0x1EE57, 0x1EE59, 0x1EE5B, 0x1EE5D, 0x1EE5F, 0x1EE61,
0x1EE62, 0x1EE64, 0x1EE7E, 0x1EEF0, 0x1EEF1, 0x1F250, 0x1F251, 0x1F7F0, 0x1F8B0,
0x1F8B1
#endif
};
#define NUM_GRAPH_CHAR (sizeof(graphCharTable)/sizeof(chr))
/*
* End of auto-generated Unicode character ranges declarations.
|
| ︙ | ︙ |
Changes to generic/tcl.decls.
| ︙ | ︙ | |||
104 105 106 107 108 109 110 |
declare 21 {
int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line)
}
declare 22 {deprecated {No longer in use, changed to macro}} {
Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line)
}
declare 23 {
| | | 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 |
declare 21 {
int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line)
}
declare 22 {deprecated {No longer in use, changed to macro}} {
Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line)
}
declare 23 {
Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, int numBytes,
const char *file, int line)
}
declare 24 {
Tcl_Obj *Tcl_DbNewDoubleObj(double doubleValue, const char *file,
int line)
}
declare 25 {
|
| ︙ | ︙ | |||
139 140 141 142 143 144 145 |
int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *boolPtr)
}
declare 32 {
int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
int *boolPtr)
}
declare 33 {
| | | 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 |
int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *boolPtr)
}
declare 32 {
int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
int *boolPtr)
}
declare 33 {
unsigned char *Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, int *numBytesPtr)
}
declare 34 {
int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr)
}
declare 35 {
int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
double *doublePtr)
|
| ︙ | ︙ | |||
198 199 200 201 202 203 204 |
int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first,
int count, int objc, Tcl_Obj *const objv[])
}
declare 49 {deprecated {No longer in use, changed to macro}} {
Tcl_Obj *Tcl_NewBooleanObj(int boolValue)
}
declare 50 {
| | | 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 |
int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first,
int count, int objc, Tcl_Obj *const objv[])
}
declare 49 {deprecated {No longer in use, changed to macro}} {
Tcl_Obj *Tcl_NewBooleanObj(int boolValue)
}
declare 50 {
Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, int numBytes)
}
declare 51 {
Tcl_Obj *Tcl_NewDoubleObj(double doubleValue)
}
declare 52 {deprecated {No longer in use, changed to macro}} {
Tcl_Obj *Tcl_NewIntObj(int intValue)
}
|
| ︙ | ︙ | |||
222 223 224 225 226 227 228 |
declare 56 {
Tcl_Obj *Tcl_NewStringObj(const char *bytes, int length)
}
declare 57 {deprecated {No longer in use, changed to macro}} {
void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
}
declare 58 {
| | | | 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 |
declare 56 {
Tcl_Obj *Tcl_NewStringObj(const char *bytes, int length)
}
declare 57 {deprecated {No longer in use, changed to macro}} {
void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
}
declare 58 {
unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int numBytes)
}
declare 59 {
void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, const unsigned char *bytes,
int numBytes)
}
declare 60 {
void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue)
}
declare 61 {deprecated {No longer in use, changed to macro}} {
void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)
}
|
| ︙ | ︙ | |||
510 511 512 513 514 515 516 |
declare 142 {
int Tcl_ExprString(Tcl_Interp *interp, const char *expr)
}
declare 143 {
void Tcl_Finalize(void)
}
declare 144 {nostub {Don't use this function in a stub-enabled extension}} {
| | | 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 |
declare 142 {
int Tcl_ExprString(Tcl_Interp *interp, const char *expr)
}
declare 143 {
void Tcl_Finalize(void)
}
declare 144 {nostub {Don't use this function in a stub-enabled extension}} {
const char *Tcl_FindExecutable(const char *argv0)
}
declare 145 {
Tcl_HashEntry *Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
Tcl_HashSearch *searchPtr)
}
declare 146 {
int Tcl_Flush(Tcl_Channel chan)
|
| ︙ | ︙ | |||
809 810 811 812 813 814 815 |
declare 228 {
void Tcl_SetErrorCode(Tcl_Interp *interp, ...)
}
declare 229 {
void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr)
}
declare 230 {nostub {Don't use this function in a stub-enabled extension}} {
| | | 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 |
declare 228 {
void Tcl_SetErrorCode(Tcl_Interp *interp, ...)
}
declare 229 {
void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr)
}
declare 230 {nostub {Don't use this function in a stub-enabled extension}} {
const char *Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc)
}
declare 231 {
int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth)
}
declare 232 {
void Tcl_SetResult(Tcl_Interp *interp, char *result,
Tcl_FreeProc *freeProc)
|
| ︙ | ︙ | |||
856 857 858 859 860 861 862 |
const char ***argvPtr)
}
# Obsolete, use Tcl_FSSplitPath
declare 243 {
void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr)
}
declare 244 {nostub {Don't use this function in a stub-enabled extension}} {
| | | | 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 |
const char ***argvPtr)
}
# Obsolete, use Tcl_FSSplitPath
declare 243 {
void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr)
}
declare 244 {nostub {Don't use this function in a stub-enabled extension}} {
void Tcl_StaticLibrary(Tcl_Interp *interp, const char *prefix,
Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc)
}
declare 245 {deprecated {No longer in use, changed to macro}} {
int Tcl_StringMatch(const char *str, const char *pattern)
}
declare 246 {deprecated {}} {
int Tcl_TellOld(Tcl_Channel chan)
}
|
| ︙ | ︙ | |||
1088 1089 1090 1091 1092 1093 1094 |
}
declare 303 {
void Tcl_GetEncodingNames(Tcl_Interp *interp)
}
declare 304 {
int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr,
const void *tablePtr, int offset, const char *msg, int flags,
| | | 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 |
}
declare 303 {
void Tcl_GetEncodingNames(Tcl_Interp *interp)
}
declare 304 {
int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr,
const void *tablePtr, int offset, const char *msg, int flags,
void *indexPtr)
}
declare 305 {
void *Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, int size)
}
declare 306 {
Tcl_Obj *Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1,
const char *part2, int flags)
|
| ︙ | ︙ | |||
1240 1241 1242 1243 1244 1245 1246 |
}
declare 350 {
int Tcl_UniCharIsUpper(int ch)
}
declare 351 {
int Tcl_UniCharIsWordChar(int ch)
}
| | | | 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 |
}
declare 350 {
int Tcl_UniCharIsUpper(int ch)
}
declare 351 {
int Tcl_UniCharIsWordChar(int ch)
}
declare 352 {
int Tcl_Char16Len(const unsigned short *uniStr)
}
declare 353 {deprecated {Use Tcl_UtfNcmp}} {
int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct,
unsigned long numChars)
}
declare 354 {
char *Tcl_Char16ToUtfDString(const unsigned short *uniStr,
|
| ︙ | ︙ | |||
1361 1362 1363 1364 1365 1366 1367 |
int length)
}
declare 385 {
int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj,
Tcl_Obj *patternObj)
}
declare 386 {
| | | 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 |
int length)
}
declare 385 {
int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj,
Tcl_Obj *patternObj)
}
declare 386 {
void Tcl_SetNotifier(const Tcl_NotifierProcs *notifierProcPtr)
}
declare 387 {
Tcl_Mutex *Tcl_GetAllocMutex(void)
}
declare 388 {
int Tcl_GetChannelNames(Tcl_Interp *interp)
}
|
| ︙ | ︙ | |||
1577 1578 1579 1580 1581 1582 1583 |
int Tcl_FSCreateDirectory(Tcl_Obj *pathPtr)
}
declare 443 {
int Tcl_FSDeleteFile(Tcl_Obj *pathPtr)
}
declare 444 {
int Tcl_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *sym1,
| | | | 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 |
int Tcl_FSCreateDirectory(Tcl_Obj *pathPtr)
}
declare 443 {
int Tcl_FSDeleteFile(Tcl_Obj *pathPtr)
}
declare 444 {
int Tcl_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *sym1,
const char *sym2, Tcl_LibraryInitProc **proc1Ptr,
Tcl_LibraryInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr,
Tcl_FSUnloadFileProc **unloadProcPtr)
}
declare 445 {
int Tcl_FSMatchInDirectory(Tcl_Interp *interp, Tcl_Obj *result,
Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types)
}
declare 446 {
|
| ︙ | ︙ | |||
2344 2345 2346 2347 2348 2349 2350 |
declare 635 {
int TclZipfs_MountBuffer(Tcl_Interp *interp, const char *mountPoint,
unsigned char *data, size_t datalen, int copy)
}
# TIP #445
declare 636 {
| | | | | | 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 |
declare 635 {
int TclZipfs_MountBuffer(Tcl_Interp *interp, const char *mountPoint,
unsigned char *data, size_t datalen, int copy)
}
# TIP #445
declare 636 {
void Tcl_FreeInternalRep(Tcl_Obj *objPtr)
}
declare 637 {
char *Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes,
unsigned int numBytes)
}
declare 638 {
Tcl_ObjInternalRep *Tcl_FetchInternalRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr)
}
declare 639 {
void Tcl_StoreInternalRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr,
const Tcl_ObjInternalRep *irPtr)
}
declare 640 {
int Tcl_HasStringRep(Tcl_Obj *objPtr)
}
# TIP #506
declare 641 {
|
| ︙ | ︙ | |||
2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 |
char *Tcl_UniCharToUtfDString(const int *uniStr,
int uniLength, Tcl_DString *dsPtr)
}
declare 648 {
int *Tcl_UtfToUniCharDString(const char *src,
int length, Tcl_DString *dsPtr)
}
# TIP #481
declare 651 {
char *TclGetStringFromObj(Tcl_Obj *objPtr, size_t *lengthPtr)
}
declare 652 {
Tcl_UniChar *TclGetUnicodeFromObj(Tcl_Obj *objPtr, size_t *lengthPtr)
}
declare 653 {
| > > > > > > > > > > | > > > > > > > > > > > > > > | 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 |
char *Tcl_UniCharToUtfDString(const int *uniStr,
int uniLength, Tcl_DString *dsPtr)
}
declare 648 {
int *Tcl_UtfToUniCharDString(const char *src,
int length, Tcl_DString *dsPtr)
}
# TIP #568
declare 649 {
unsigned char *TclGetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
int *numBytesPtr)
}
declare 650 {
unsigned char *Tcl_GetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
size_t *numBytesPtr)
}
# TIP #481
declare 651 {
char *TclGetStringFromObj(Tcl_Obj *objPtr, size_t *lengthPtr)
}
declare 652 {
Tcl_UniChar *TclGetUnicodeFromObj(Tcl_Obj *objPtr, size_t *lengthPtr)
}
declare 653 {
unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, size_t *numBytesPtr)
}
# TIP #575
declare 654 {
int Tcl_UtfCharComplete(const char *src, int length)
}
declare 655 {
const char *Tcl_UtfNext(const char *src)
}
declare 656 {
const char *Tcl_UtfPrev(const char *src, const char *start)
}
declare 657 {
int Tcl_UniCharIsUnicode(int ch)
}
# TIP #511
declare 660 {
int Tcl_AsyncMarkFromSignal(Tcl_AsyncHandler async, int sigNumber)
}
# TIP #617
declare 668 {
int Tcl_UniCharLen(const int *uniStr)
}
# ----- BASELINE -- FOR -- 8.7.0 ----- #
##############################################################################
# Define the platform specific public Tcl interface. These functions are only
# available on the designated platform.
|
| ︙ | ︙ | |||
2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 |
declare 0 win {
TCHAR *Tcl_WinUtfToTChar(const char *str, int len, Tcl_DString *dsPtr)
}
declare 1 win {
char *Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr)
}
################################
# Mac OS X specific functions
declare 0 macosx {
int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
const char *bundleName, int hasResourceFile,
| > > > | 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 |
declare 0 win {
TCHAR *Tcl_WinUtfToTChar(const char *str, int len, Tcl_DString *dsPtr)
}
declare 1 win {
char *Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr)
}
declare 3 win {
void Tcl_WinConvertError(unsigned errCode)
}
################################
# Mac OS X specific functions
declare 0 macosx {
int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
const char *bundleName, int hasResourceFile,
|
| ︙ | ︙ | |||
2474 2475 2476 2477 2478 2479 2480 |
void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc)
}
export {
void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc,
Tcl_Interp *interp)
}
export {
| | | | | | | | 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 |
void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc)
}
export {
void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc,
Tcl_Interp *interp)
}
export {
void Tcl_StaticLibrary(Tcl_Interp *interp, const char *prefix,
Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc)
}
export {
const char *Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc)
}
export {
Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc)
}
export {
const char *Tcl_FindExecutable(const char *argv0)
}
export {
const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version,
int exact)
}
export {
const char *TclTomMathInitializeStubs(Tcl_Interp* interp,
const char* version, int epoch, int revision)
}
export {
const char *Tcl_PkgInitStubsCheck(Tcl_Interp *interp, const char *version,
int exact)
}
export {
void Tcl_GetMemoryInfo(Tcl_DString *dsPtr)
}
export {
const char *Tcl_InitSubsystems(void)
}
export {
const char *TclZipfs_AppHook(int *argc, char ***argv)
}
# Local Variables:
# mode: tcl
# End:
|
Changes to generic/tcl.h.
| ︙ | ︙ | |||
46 47 48 49 50 51 52 | * win/README (not patchlevel) (sections 0 and 2) * unix/tcl.spec (1 LOC patch) */ #define TCL_MAJOR_VERSION 8 #define TCL_MINOR_VERSION 7 #define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE | | | | 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 | * win/README (not patchlevel) (sections 0 and 2) * unix/tcl.spec (1 LOC patch) */ #define TCL_MAJOR_VERSION 8 #define TCL_MINOR_VERSION 7 #define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE #define TCL_RELEASE_SERIAL 6 #define TCL_VERSION "8.7" #define TCL_PATCH_LEVEL "8.7a6" #if !defined(TCL_NO_DEPRECATED) || defined(RC_INVOKED) /* *---------------------------------------------------------------------------- * The following definitions set up the proper options for Windows compilers. * We use this method because there is no autoconf equivalent. */ |
| ︙ | ︙ | |||
693 694 695 696 697 698 699 | typedef void (Tcl_InterpDeleteProc) (ClientData clientData, Tcl_Interp *interp); typedef int (Tcl_MathProc) (ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr); typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData); typedef int (Tcl_ObjCmdProc) (ClientData clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); | | | | > > > > > | 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 | typedef void (Tcl_InterpDeleteProc) (ClientData clientData, Tcl_Interp *interp); typedef int (Tcl_MathProc) (ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr); typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData); typedef int (Tcl_ObjCmdProc) (ClientData clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); 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) (ClientData callbackData, Tcl_Channel chan, char *address, int port); typedef void (Tcl_TimerProc) (ClientData clientData); typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr); typedef void (Tcl_UpdateStringProc) (struct Tcl_Obj *objPtr); typedef char * (Tcl_VarTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *part1, const char *part2, int flags); typedef void (Tcl_CommandTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *oldName, const char *newName, int flags); typedef void (Tcl_CreateFileHandlerProc) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); typedef void (Tcl_DeleteFileHandlerProc) (int fd); typedef void (Tcl_AlertNotifierProc) (ClientData clientData); typedef void (Tcl_ServiceModeHookProc) (int mode); typedef ClientData (Tcl_InitNotifierProc) (void); typedef void (Tcl_FinalizeNotifierProc) (ClientData clientData); typedef void (Tcl_MainLoopProc) (void); #ifndef TCL_NO_DEPRECATED # define Tcl_PackageInitProc Tcl_LibraryInitProc # define Tcl_PackageUnloadProc Tcl_LibraryUnloadProc #endif /* *---------------------------------------------------------------------------- * The following structure represents a type of object, which is a particular * internal representation for an object plus a set of functions that provide * standard operations on objects of that type. */ |
| ︙ | ︙ | |||
740 741 742 743 744 745 746 |
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. */
} Tcl_ObjType;
/*
| | | | | | | 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 |
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. */
} 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.
*/
typedef union Tcl_ObjInternalRep { /* The internal representation: */
long longValue; /* - an long integer value. */
double doubleValue; /* - a double-precision floating value. */
void *otherValuePtr; /* - another, type-specific value, */
/* not used internally any more. */
Tcl_WideInt wideValue; /* - an integer value >= 64bits */
struct { /* - internal rep as two pointers. */
void *ptr1;
void *ptr2;
} twoPtrValue;
struct { /* - internal rep as a pointer and a long, */
void *ptr; /* not used internally any more. */
unsigned long value;
} ptrAndLongRep;
} Tcl_ObjInternalRep;
/*
* 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.
*/
|
| ︙ | ︙ | |||
787 788 789 790 791 792 793 |
* array as a readonly value. */
int 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). */
| | | 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 |
* array as a readonly value. */
int length; /* The number of bytes at *bytes, not
* including the terminating null. */
const Tcl_ObjType *typePtr; /* Denotes the object's type. Always
* corresponds to the type of the object's
* internal rep. NULL indicates the object has
* no internal rep (has no type). */
Tcl_ObjInternalRep internalRep; /* The internal representation: */
} Tcl_Obj;
/*
*----------------------------------------------------------------------------
* The following structure contains the state needed by Tcl_SaveResult. No-one
* outside of Tcl should access any of these fields. This structure is
|
| ︙ | ︙ | |||
970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 | #define TCL_DONT_QUOTE_HASH 8 /* * Flags that may be passed to Tcl_GetIndexFromObj. * TCL_EXACT disallows abbreviated strings. * TCL_INDEX_TEMP_TABLE disallows caching of lookups. A possible use case is * a table that will not live long enough to make it worthwhile. */ #define TCL_EXACT 1 #define TCL_INDEX_TEMP_TABLE 2 /* *---------------------------------------------------------------------------- * 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! * | > > > | 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 | #define TCL_DONT_QUOTE_HASH 8 /* * Flags that may be passed to Tcl_GetIndexFromObj. * TCL_EXACT disallows abbreviated strings. * TCL_INDEX_TEMP_TABLE disallows caching of lookups. A possible use case is * a table that will not live long enough to make it worthwhile. * TCL_INDEX_NULL_OK allows the empty string or NULL to return TCL_OK. * The returned value will be -1; */ #define TCL_EXACT 1 #define TCL_INDEX_TEMP_TABLE 2 #define TCL_INDEX_NULL_OK 4 /* *---------------------------------------------------------------------------- * 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! * |
| ︙ | ︙ | |||
2127 2128 2129 2130 2131 2132 2133 |
* This represents a Unicode character. Any changes to this should also be
* reflected in regcustom.h.
*/
#if TCL_UTF_MAX > 3
/*
* int isn't 100% accurate as it should be a strict 4-byte value
| | | 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 |
* This represents a Unicode character. Any changes to this should also be
* reflected in regcustom.h.
*/
#if TCL_UTF_MAX > 3
/*
* 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;
#else
typedef unsigned short Tcl_UniChar;
#endif
|
| ︙ | ︙ | |||
2374 2375 2376 2377 2378 2379 2380 | #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \ ((Tcl_SetPanicProc(Tcl_ConsolePanic), Tcl_CreateInterp)())) EXTERN void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp, const char *version, int exact); | | > > > > | | | 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 | #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \ ((Tcl_SetPanicProc(Tcl_ConsolePanic), Tcl_CreateInterp)())) EXTERN void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp, const char *version, int exact); EXTERN const char * Tcl_InitSubsystems(void); EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); EXTERN const char * Tcl_SetPreInitScript(const char *string); #ifndef TCL_NO_DEPRECATED # define Tcl_StaticPackage Tcl_StaticLibrary #endif #ifdef _WIN32 EXTERN const char *TclZipfs_AppHook(int *argc, wchar_t ***argv); #else EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); #endif /* *---------------------------------------------------------------------------- * Include the public function declarations that are accessible via the stubs * table. */ |
| ︙ | ︙ | |||
2466 2467 2468 2469 2470 2471 2472 |
Tcl_DbIsShared(objPtr, __FILE__, __LINE__)
#else
# undef Tcl_IncrRefCount
# define Tcl_IncrRefCount(objPtr) \
++(objPtr)->refCount
/*
* Use do/while0 idiom for optimum correctness without compiler warnings.
| | | 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 |
Tcl_DbIsShared(objPtr, __FILE__, __LINE__)
#else
# undef Tcl_IncrRefCount
# define Tcl_IncrRefCount(objPtr) \
++(objPtr)->refCount
/*
* Use do/while0 idiom for optimum correctness without compiler warnings.
* https://wiki.c2.com/?TrivialDoWhileLoop
*/
# undef Tcl_DecrRefCount
# define Tcl_DecrRefCount(objPtr) \
do { \
Tcl_Obj *_objPtr = (objPtr); \
if (_objPtr->refCount-- <= 1) { \
TclFreeObj(_objPtr); \
|
| ︙ | ︙ |
Changes to generic/tclAlloc.c.
| ︙ | ︙ | |||
744 745 746 747 748 749 750 751 752 753 754 755 756 757 |
void *oldPtr, /* Pointer to alloced block. */
unsigned int numBytes) /* New size of memory. */
{
return realloc(oldPtr, numBytes);
}
#endif /* !USE_TCLALLOC */
#endif /* !TCL_THREADS */
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
| > > | 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 |
void *oldPtr, /* Pointer to alloced block. */
unsigned int numBytes) /* New size of memory. */
{
return realloc(oldPtr, numBytes);
}
#endif /* !USE_TCLALLOC */
#else
TCL_MAC_EMPTY_FILE(generic_tclAlloc_c)
#endif /* !TCL_THREADS */
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
|
| ︙ | ︙ |
Changes to generic/tclAssembly.c.
| ︙ | ︙ | |||
861 862 863 864 865 866 867 |
int sourceLen; /* Length of the source code in bytes */
/*
* Get the expression ByteCode from the object. If it exists, make sure it
* is valid in the current context.
*/
| | | | 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 |
int sourceLen; /* Length of the source code in bytes */
/*
* Get the expression ByteCode from the object. If it exists, make sure it
* is valid in the current context.
*/
ByteCodeGetInternalRep(objPtr, &assembleCodeType, codePtr);
if (codePtr) {
namespacePtr = iPtr->varFramePtr->nsPtr;
if (((Interp *) *codePtr->interpHandle == iPtr)
&& (codePtr->compileEpoch == iPtr->compileEpoch)
&& (codePtr->nsPtr == namespacePtr)
&& (codePtr->nsEpoch == namespacePtr->resolverEpoch)
&& (codePtr->localCachePtr
== iPtr->varFramePtr->localCachePtr)) {
return codePtr;
}
/*
* Not valid, so free it and regenerate.
*/
Tcl_StoreInternalRep(objPtr, &assembleCodeType, NULL);
}
/*
* Set up the compilation environment, and assemble the code.
*/
source = TclGetStringFromObj(objPtr, &sourceLen);
|
| ︙ | ︙ | |||
1981 1982 1983 1984 1985 1986 1987 |
JumptableInfo* jtPtr;
Tcl_HashTable* jtHashPtr; /* Hashtable in the JumptableInfo */
Tcl_HashEntry* hashEntry; /* Entry for a key in the hashtable */
int isNew; /* Flag==1 if the key is not yet in the
* table. */
int i;
| | | 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 |
JumptableInfo* jtPtr;
Tcl_HashTable* jtHashPtr; /* Hashtable in the JumptableInfo */
Tcl_HashEntry* hashEntry; /* Entry for a key in the hashtable */
int isNew; /* Flag==1 if the key is not yet in the
* table. */
int i;
if (TclListObjGetElements(interp, jumps, &objc, &objv) != TCL_OK) {
return TCL_ERROR;
}
if (objc % 2 != 0) {
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"jump table must have an even number of list elements",
-1));
|
| ︙ | ︙ | |||
4285 4286 4287 4288 4289 4290 4291 | /* *----------------------------------------------------------------------------- * * DupAssembleCodeInternalRep -- * * Part of the Tcl object type implementation for Tcl assembly language | | | | 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 | /* *----------------------------------------------------------------------------- * * DupAssembleCodeInternalRep -- * * Part of the Tcl object type implementation for Tcl assembly language * bytecode. We do not copy the bytecode internalrep. Instead, we return * without setting copyPtr->typePtr, so the copy is a plain string copy * of the assembly source, and if it is to be used as a compiled * expression, it will need to be reprocessed. * * This makes sense, because with Tcl's copy-on-write practices, the * usual (only?) time Tcl_DuplicateObj() will be called is when the copy * is about to be modified, which would invalidate any copied bytecode * anyway. The only reason it might make sense to copy the bytecode is if * we had some modifying routines that operated directly on the internalrep, * as we do for lists and dicts. * * Results: * None. * * Side effects: * None. |
| ︙ | ︙ | |||
4338 4339 4340 4341 4342 4343 4344 |
static void
FreeAssembleCodeInternalRep(
Tcl_Obj *objPtr)
{
ByteCode *codePtr;
| | | 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 |
static void
FreeAssembleCodeInternalRep(
Tcl_Obj *objPtr)
{
ByteCode *codePtr;
ByteCodeGetInternalRep(objPtr, &assembleCodeType, codePtr);
assert(codePtr != NULL);
TclReleaseByteCode(codePtr);
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Changes to generic/tclAsync.c.
| ︙ | ︙ | |||
21 22 23 24 25 26 27 |
* One of the following structures exists for each asynchronous handler:
*/
typedef struct AsyncHandler {
int ready; /* Non-zero means this handler should be
* invoked in the next call to
* Tcl_AsyncInvoke. */
| | | | > < < < < < < < < < > > > > > > > | | > > | > > > > > > > > > > > > > > > > | > > > > > > > > | > > > > | 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 |
* One of the following structures exists for each asynchronous handler:
*/
typedef struct AsyncHandler {
int ready; /* Non-zero means this handler should be
* invoked in the next call to
* Tcl_AsyncInvoke. */
struct AsyncHandler *nextPtr, *prevPtr;
/* Next, previous in list of all handlers
* for the process. */
Tcl_AsyncProc *proc; /* Procedure to call when handler is
* invoked. */
ClientData clientData; /* Value to pass to handler when it is
* invoked. */
struct ThreadSpecificData *originTsd;
/* Used in Tcl_AsyncMark to modify thread-
* specific data from outside the thread it is
* associated to. */
Tcl_ThreadId originThrdId; /* Origin thread where this token was created
* and where it will be yielded. */
ClientData notifierData; /* Platform notifier data or NULL. */
} AsyncHandler;
typedef struct ThreadSpecificData {
int asyncReady; /* This is set to 1 whenever a handler becomes
* ready and it is cleared to zero whenever
* Tcl_AsyncInvoke is called. It can be
* checked elsewhere in the application by
* calling Tcl_AsyncReady to see if
* Tcl_AsyncInvoke should be invoked. */
int asyncActive; /* Indicates whether Tcl_AsyncInvoke is
* currently working. If so then we won't set
* asyncReady again until Tcl_AsyncInvoke
* returns. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
/* Mutex to protect linked-list of AsyncHandlers in the process. */
TCL_DECLARE_MUTEX(asyncMutex)
/* List of all existing handlers of the process. */
static AsyncHandler *firstHandler = NULL;
static AsyncHandler *lastHandler = NULL;
/*
*----------------------------------------------------------------------
*
* TclFinalizeAsync --
*
* Finalizes the thread local data structure for the async
* subsystem.
*
* Results:
* None.
*
* Side effects:
* Cleans up left-over async handlers for the calling thread.
*
*----------------------------------------------------------------------
*/
void
TclFinalizeAsync(void)
{
AsyncHandler *token, *toDelete = NULL;
Tcl_ThreadId self = Tcl_GetCurrentThread();
Tcl_MutexLock(&asyncMutex);
for (token = firstHandler; token != NULL;) {
AsyncHandler *nextToken = token->nextPtr;
if (token->originThrdId == self) {
if (token->prevPtr == NULL) {
firstHandler = token->nextPtr;
if (firstHandler == NULL) {
lastHandler = NULL;
break;
}
} else {
token->prevPtr->nextPtr = token->nextPtr;
if (token == lastHandler) {
lastHandler = token->prevPtr;
}
}
if (token->nextPtr != NULL) {
token->nextPtr->prevPtr = token->prevPtr;
}
token->nextPtr = toDelete;
token->prevPtr = NULL;
toDelete = token;
}
token = nextToken;
}
Tcl_MutexUnlock(&asyncMutex);
while (toDelete != NULL) {
token = toDelete;
toDelete = toDelete->nextPtr;
ckfree(token);
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_AsyncCreate --
|
| ︙ | ︙ | |||
117 118 119 120 121 122 123 124 125 126 127 128 |
{
AsyncHandler *asyncPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
asyncPtr = (AsyncHandler*)ckalloc(sizeof(AsyncHandler));
asyncPtr->ready = 0;
asyncPtr->nextPtr = NULL;
asyncPtr->proc = proc;
asyncPtr->clientData = clientData;
asyncPtr->originTsd = tsdPtr;
asyncPtr->originThrdId = Tcl_GetCurrentThread();
| > > | | | > | | | | 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 |
{
AsyncHandler *asyncPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
asyncPtr = (AsyncHandler*)ckalloc(sizeof(AsyncHandler));
asyncPtr->ready = 0;
asyncPtr->nextPtr = NULL;
asyncPtr->prevPtr = NULL;
asyncPtr->proc = proc;
asyncPtr->clientData = clientData;
asyncPtr->originTsd = tsdPtr;
asyncPtr->originThrdId = Tcl_GetCurrentThread();
asyncPtr->notifierData = TclpNotifierData();
Tcl_MutexLock(&asyncMutex);
if (firstHandler == NULL) {
firstHandler = asyncPtr;
} else {
asyncPtr->prevPtr = lastHandler;
lastHandler->nextPtr = asyncPtr;
}
lastHandler = asyncPtr;
Tcl_MutexUnlock(&asyncMutex);
return (Tcl_AsyncHandler) asyncPtr;
}
/*
*----------------------------------------------------------------------
*
* Tcl_AsyncMark --
|
| ︙ | ︙ | |||
158 159 160 161 162 163 164 |
void
Tcl_AsyncMark(
Tcl_AsyncHandler async) /* Token for handler. */
{
AsyncHandler *token = (AsyncHandler *) async;
| | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
void
Tcl_AsyncMark(
Tcl_AsyncHandler async) /* Token for handler. */
{
AsyncHandler *token = (AsyncHandler *) async;
Tcl_MutexLock(&asyncMutex);
token->ready = 1;
if (!token->originTsd->asyncActive) {
token->originTsd->asyncReady = 1;
Tcl_ThreadAlert(token->originThrdId);
}
Tcl_MutexUnlock(&asyncMutex);
}
/*
*----------------------------------------------------------------------
*
* Tcl_AsyncMarkFromSignal --
*
* This procedure is similar to Tcl_AsyncMark but must be used
* in POSIX signal contexts. In addition to Tcl_AsyncMark the
* signal number is passed.
*
* Results:
* True, when the handler will be marked, false otherwise.
*
* Side effects:
* The handler gets marked for invocation later.
*
*----------------------------------------------------------------------
*/
int
Tcl_AsyncMarkFromSignal(
Tcl_AsyncHandler async, /* Token for handler. */
int sigNumber) /* Signal number. */
{
#if TCL_THREADS
AsyncHandler *token = (AsyncHandler *) async;
return TclAsyncNotifier(sigNumber, token->originThrdId,
token->notifierData, &token->ready, -1);
#else
(void)sigNumber;
Tcl_AsyncMark(async);
return 1;
#endif
}
/*
*----------------------------------------------------------------------
*
* TclAsyncMarkFromNotifier --
*
* This procedure is called from the notifier thread and
* invokes Tcl_AsyncMark for specifically marked handlers.
*
* Results:
* None.
*
* Side effects:
* Handlers get marked for invocation later.
*
*----------------------------------------------------------------------
*/
void
TclAsyncMarkFromNotifier(void)
{
AsyncHandler *token;
Tcl_MutexLock(&asyncMutex);
for (token = firstHandler; token != NULL;
token = token->nextPtr) {
if (token->ready == -1) {
token->ready = 1;
if (!token->originTsd->asyncActive) {
token->originTsd->asyncReady = 1;
Tcl_ThreadAlert(token->originThrdId);
}
}
}
Tcl_MutexUnlock(&asyncMutex);
}
/*
*----------------------------------------------------------------------
*
* Tcl_AsyncInvoke --
*
|
| ︙ | ︙ | |||
196 197 198 199 200 201 202 203 |
* interpreter. Otherwise it is NULL. */
int code) /* If interp is non-NULL, this gives
* completion code from command that just
* completed. */
{
AsyncHandler *asyncPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
| > | | | > > > | | | | 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 |
* interpreter. Otherwise it is NULL. */
int code) /* If interp is non-NULL, this gives
* completion code from command that just
* completed. */
{
AsyncHandler *asyncPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
Tcl_ThreadId self = Tcl_GetCurrentThread();
Tcl_MutexLock(&asyncMutex);
if (tsdPtr->asyncReady == 0) {
Tcl_MutexUnlock(&asyncMutex);
return code;
}
tsdPtr->asyncReady = 0;
tsdPtr->asyncActive = 1;
if (interp == NULL) {
code = 0;
}
/*
* Make one or more passes over the list of handlers, invoking at most one
* handler in each pass. After invoking a handler, go back to the start of
* the list again so that (a) if a new higher-priority handler gets marked
* while executing a lower priority handler, we execute the higher-
* priority handler next, and (b) if a handler gets deleted during the
* execution of a handler, then the list structure may change so it isn't
* safe to continue down the list anyway.
*/
while (1) {
for (asyncPtr = firstHandler; asyncPtr != NULL;
asyncPtr = asyncPtr->nextPtr) {
if (asyncPtr->originThrdId != self) {
continue;
}
if (asyncPtr->ready) {
break;
}
}
if (asyncPtr == NULL) {
break;
}
asyncPtr->ready = 0;
Tcl_MutexUnlock(&asyncMutex);
code = asyncPtr->proc(asyncPtr->clientData, interp, code);
Tcl_MutexLock(&asyncMutex);
}
tsdPtr->asyncActive = 0;
Tcl_MutexUnlock(&asyncMutex);
return code;
}
/*
*----------------------------------------------------------------------
*
* Tcl_AsyncDelete --
|
| ︙ | ︙ | |||
267 268 269 270 271 272 273 |
*----------------------------------------------------------------------
*/
void
Tcl_AsyncDelete(
Tcl_AsyncHandler async) /* Token for handler to delete. */
{
| < < < < < < < < < | < < < | | < | | < < | | < | | > > > | | 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 |
*----------------------------------------------------------------------
*/
void
Tcl_AsyncDelete(
Tcl_AsyncHandler async) /* Token for handler to delete. */
{
AsyncHandler *asyncPtr = (AsyncHandler *) async;
/*
* Assure early handling of the constraint
*/
if (asyncPtr->originThrdId != Tcl_GetCurrentThread()) {
Tcl_Panic("Tcl_AsyncDelete: async handler deleted by the wrong thread");
}
Tcl_MutexLock(&asyncMutex);
if (asyncPtr->prevPtr == NULL) {
firstHandler = asyncPtr->nextPtr;
if (firstHandler == NULL) {
lastHandler = NULL;
}
} else {
asyncPtr->prevPtr->nextPtr = asyncPtr->nextPtr;
if (asyncPtr == lastHandler) {
lastHandler = asyncPtr->prevPtr;
}
}
if (asyncPtr->nextPtr != NULL) {
asyncPtr->nextPtr->prevPtr = asyncPtr->prevPtr;
}
Tcl_MutexUnlock(&asyncMutex);
ckfree(asyncPtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_AsyncReady --
|
| ︙ | ︙ |
Changes to generic/tclBasic.c.
| ︙ | ︙ | |||
603 604 605 606 607 608 609 610 611 612 613 614 615 616 |
}
Tcl_MutexUnlock(&commandTypeLock);
}
/*
*----------------------------------------------------------------------
*
* Tcl_CreateInterp --
*
* Create a new TCL command interpreter.
*
* Results:
* The return value is a token for the interpreter, which may be used in
* calls to functions like Tcl_CreateCmd, Tcl_Eval, or Tcl_DeleteInterp.
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
}
Tcl_MutexUnlock(&commandTypeLock);
}
/*
*----------------------------------------------------------------------
*
* buildInfoObjCmd --
*
* Implements tcl::build-info command.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
buildInfoObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?option?");
return TCL_ERROR;
}
if (objc == 2) {
int len;
const char *arg = TclGetStringFromObj(objv[1], &len);
if (len == 7 && !strcmp(arg, "version")) {
char buf[80];
const char *p = strchr((char *)clientData, '.');
if (p) {
const char *q = strchr(p+1, '.');
const char *r = strchr(p+1, '+');
p = (q < r) ? q : r;
}
if (p) {
memcpy(buf, (char *)clientData, p - (char *)clientData);
buf[p - (char *)clientData] = '\0';
Tcl_AppendResult(interp, buf, NULL);
}
return TCL_OK;
} else if (len == 10 && !strcmp(arg, "patchlevel")) {
char buf[80];
const char *p = strchr((char *)clientData, '+');
if (p) {
memcpy(buf, (char *)clientData, p - (char *)clientData);
buf[p - (char *)clientData] = '\0';
Tcl_AppendResult(interp, buf, NULL);
}
return TCL_OK;
} else if (len == 6 && !strcmp(arg, "commit")) {
const char *q, *p = strchr((char *)clientData, '+');
if (p) {
if ((q = strchr(p, '.'))) {
char buf[80];
memcpy(buf, p+1, q - p - 1);
buf[q - p - 1] = '\0';
Tcl_AppendResult(interp, buf, NULL);
} else {
Tcl_AppendResult(interp, p+1, NULL);
}
}
return TCL_OK;
} else if (len == 8 && !strcmp(arg, "compiler")) {
const char *p = strchr((char *)clientData, '.');
while (p) {
if (!strncmp(p+1, "clang-", 6) || !strncmp(p+1, "gcc-", 4)
|| !strncmp(p+1, "icc-", 4) || !strncmp(p+1, "msvc-", 5)) {
const char *q = strchr(p+1, '.');
if (q) {
char buf[16];
memcpy(buf, p+1, q - p - 1);
buf[q - p - 1] = '\0';
Tcl_AppendResult(interp, buf, NULL);
} else {
Tcl_AppendResult(interp, p+1, NULL);
}
return TCL_OK;
}
p = strchr(p+1, '.');
}
Tcl_AppendResult(interp, "0", NULL);
return TCL_OK;
}
const char *p = strchr((char *)clientData, '.');
while (p) {
if (!strncmp(p+1, arg, len) && ((p[len+1] == '.') || (p[len+1] == '\0'))) {
Tcl_AppendResult(interp, "1", NULL);
return TCL_OK;
}
p = strchr(p+1, '.');
}
Tcl_AppendResult(interp, "0", NULL);
return TCL_OK;
}
Tcl_AppendResult(interp, (char *)clientData, NULL);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Tcl_CreateInterp --
*
* Create a new TCL command interpreter.
*
* Results:
* The return value is a token for the interpreter, which may be used in
* calls to functions like Tcl_CreateCmd, Tcl_Eval, or Tcl_DeleteInterp.
|
| ︙ | ︙ | |||
640 641 642 643 644 645 646 |
short s;
} order;
#ifdef TCL_COMPILE_STATS
ByteCodeStats *statsPtr;
#endif /* TCL_COMPILE_STATS */
char mathFuncName[32];
CallFrame *framePtr;
| < | | 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 |
short s;
} order;
#ifdef TCL_COMPILE_STATS
ByteCodeStats *statsPtr;
#endif /* TCL_COMPILE_STATS */
char mathFuncName[32];
CallFrame *framePtr;
const char *version = Tcl_InitSubsystems();
/*
* Panic if someone updated the CallFrame structure without also updating
* the Tcl_CallFrame structure (or vice versa).
*/
if (sizeof(Tcl_CallFrame) < sizeof(CallFrame)) {
|
| ︙ | ︙ | |||
1158 1159 1160 1161 1162 1163 1164 |
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
Tcl_TraceVar2(interp, "tcl_precision", NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
TclPrecTraceProc, NULL);
#endif /* !TCL_NO_DEPRECATED */
TclpSetVariables(interp);
| | > > > > | 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 |
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
Tcl_TraceVar2(interp, "tcl_precision", NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
TclPrecTraceProc, NULL);
#endif /* !TCL_NO_DEPRECATED */
TclpSetVariables(interp);
#if TCL_THREADS && !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/*
* The existence of the "threaded" element of the tcl_platform array
* indicates that this particular Tcl shell has been compiled with threads
* turned on. Using "info exists tcl_platform(threaded)" a Tcl script can
* introspect on the interpreter level of thread safety.
*/
Tcl_SetVar2(interp, "tcl_platform", "threaded", "1", TCL_GLOBAL_ONLY);
#endif
/*
* Register Tcl's version number.
* TIP #268: Full patchlevel instead of just major.minor
* TIP #599: Extended build information "+<UUID>.<tag1>.<tag2>...."
*/
Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);
Tcl_PkgProvideEx(interp, "tcl", TCL_PATCH_LEVEL, &tclStubs);
Tcl_CreateObjCommand(interp, "::tcl::build-info",
buildInfoObjCmd, (void *)version, NULL);
if (TclTommath_Init(interp) != TCL_OK) {
Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));
}
if (TclOOInit(interp) != TCL_OK) {
Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));
|
| ︙ | ︙ | |||
1822 1823 1824 1825 1826 1827 1828 |
for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
Tcl_DeleteCommandFromToken(interp, (Tcl_Command)Tcl_GetHashValue(hPtr));
}
Tcl_DeleteHashTable(hTablePtr);
ckfree(hTablePtr);
}
| < < < < | < > > > > < > > | 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 |
for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
Tcl_DeleteCommandFromToken(interp, (Tcl_Command)Tcl_GetHashValue(hPtr));
}
Tcl_DeleteHashTable(hTablePtr);
ckfree(hTablePtr);
}
if (iPtr->assocData != NULL) {
AssocData *dPtr;
hTablePtr = iPtr->assocData;
/*
* Invoke deletion callbacks; note that a callback can create new
* callbacks, so we iterate.
*/
for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
hPtr != NULL;
hPtr = Tcl_FirstHashEntry(hTablePtr, &search)) {
dPtr = (AssocData *)Tcl_GetHashValue(hPtr);
if (dPtr->proc != NULL) {
dPtr->proc(dPtr->clientData, interp);
}
Tcl_DeleteHashEntry(hPtr);
ckfree(dPtr);
}
Tcl_DeleteHashTable(hTablePtr);
ckfree(hTablePtr);
iPtr->assocData = NULL;
}
/*
* Pop the root frame pointer and finish deleting the global
* namespace. The order is important [Bug 1658572].
*/
|
| ︙ | ︙ | |||
3501 3502 3503 3504 3505 3506 3507 |
* declares that a delete is in progress and that recursive deletes should
* be ignored.
*/
cmdPtr->flags |= CMD_DYING;
/*
| | < > > | 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 |
* declares that a delete is in progress and that recursive deletes should
* be ignored.
*/
cmdPtr->flags |= CMD_DYING;
/*
* Call each functions and then delete the trace.
*/
cmdPtr->nsPtr->refCount++;
if (cmdPtr->tracePtr != NULL) {
CommandTrace *tracePtr;
/* CallCommandTraces() does not cmdPtr, that's
* done just before Tcl_DeleteCommandFromToken() returns */
CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE);
/*
* Now delete these traces.
*/
tracePtr = cmdPtr->tracePtr;
|
| ︙ | ︙ | |||
3678 3679 3680 3681 3682 3683 3684 |
flags &= ~TCL_TRACE_RENAME;
}
if (flags == 0) {
return NULL;
}
}
cmdPtr->flags |= CMD_TRACE_ACTIVE;
| < | 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 |
flags &= ~TCL_TRACE_RENAME;
}
if (flags == 0) {
return NULL;
}
}
cmdPtr->flags |= CMD_TRACE_ACTIVE;
result = NULL;
active.nextPtr = iPtr->activeCmdTracePtr;
active.reverseScan = 0;
iPtr->activeCmdTracePtr = &active;
if (flags & TCL_TRACE_DELETE) {
|
| ︙ | ︙ | |||
3736 3737 3738 3739 3740 3741 3742 |
/*
* Restore the variable's flags, remove the record of our active traces,
* and then return.
*/
cmdPtr->flags &= ~CMD_TRACE_ACTIVE;
| < | 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 3854 |
/*
* Restore the variable's flags, remove the record of our active traces,
* and then return.
*/
cmdPtr->flags &= ~CMD_TRACE_ACTIVE;
iPtr->activeCmdTracePtr = active.nextPtr;
Tcl_Release(iPtr);
return result;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
3893 3894 3895 3896 3897 3898 3899 |
{
Tcl_DString bigName;
OldMathFuncData *data = (OldMathFuncData *)ckalloc(sizeof(OldMathFuncData));
data->proc = proc;
data->numArgs = numArgs;
data->argTypes = (Tcl_ValueType *)ckalloc(numArgs * sizeof(Tcl_ValueType));
| > | > | 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 4013 |
{
Tcl_DString bigName;
OldMathFuncData *data = (OldMathFuncData *)ckalloc(sizeof(OldMathFuncData));
data->proc = proc;
data->numArgs = numArgs;
data->argTypes = (Tcl_ValueType *)ckalloc(numArgs * sizeof(Tcl_ValueType));
if ((numArgs > 0) && (argTypes != NULL)) {
memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType));
}
data->clientData = clientData;
Tcl_DStringInit(&bigName);
TclDStringAppendLiteral(&bigName, "::tcl::mathfunc::");
Tcl_DStringAppend(&bigName, name, -1);
Tcl_CreateObjCommand(interp, Tcl_DStringValue(&bigName),
|
| ︙ | ︙ | |||
3956 3957 3958 3959 3960 3961 3962 |
args = (Tcl_Value *)ckalloc(dataPtr->numArgs * sizeof(Tcl_Value));
for (j = 1, k = 0; j < objc; ++j, ++k) {
/* TODO: Convert to TclGetNumberFromObj? */
valuePtr = objv[j];
result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
#ifdef ACCEPT_NAN
if (result != TCL_OK) {
| | | | 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 |
args = (Tcl_Value *)ckalloc(dataPtr->numArgs * sizeof(Tcl_Value));
for (j = 1, k = 0; j < objc; ++j, ++k) {
/* TODO: Convert to TclGetNumberFromObj? */
valuePtr = objv[j];
result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
#ifdef ACCEPT_NAN
if (result != TCL_OK) {
const Tcl_ObjInternalRep *irPtr
= TclFetchInternalRep(valuePtr, &tclDoubleType);
if (irPtr) {
d = irPtr->doubleValue;
result = TCL_OK;
}
}
#endif
|
| ︙ | ︙ | |||
4863 4864 4865 4866 4867 4868 4869 4870 4871 4872 4873 4874 4875 4876 4877 |
static int
NRCommand(
ClientData data[],
Tcl_Interp *interp,
int result)
{
Interp *iPtr = (Interp *) interp;
iPtr->numLevels--;
/*
* If there is a tailcall, schedule it next
*/
if (data[1] && (data[1] != INT2PTR(1))) {
| > > > > | | 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 |
static int
NRCommand(
ClientData data[],
Tcl_Interp *interp,
int result)
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *listPtr;
iPtr->numLevels--;
/*
* If there is a tailcall, schedule it next
*/
if (data[1] && (data[1] != INT2PTR(1))) {
listPtr = (Tcl_Obj *)data[1];
data[1] = NULL;
TclNRAddCallback(interp, TclNRTailcallEval, listPtr, NULL, NULL, NULL);
}
/* OPT ??
* Do not interrupt a series of cleanups with async or limit checks:
* just check at the end?
*/
|
| ︙ | ︙ | |||
5065 5066 5067 5068 5069 5070 5071 |
/*
* Get the list of words for the unknown handler and allocate enough space
* to hold both the handler prefix and all words of the command invokation
* itself.
*/
| | | 5175 5176 5177 5178 5179 5180 5181 5182 5183 5184 5185 5186 5187 5188 5189 |
/*
* Get the list of words for the unknown handler and allocate enough space
* to hold both the handler prefix and all words of the command invokation
* itself.
*/
TclListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
&handlerObjc, &handlerObjv);
newObjc = objc + handlerObjc;
newObjv = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc);
/*
* Copy command prefix from unknown handler and add on the real command's
* full argument list. Note that we only use memcpy() once because we have
|
| ︙ | ︙ | |||
5674 5675 5676 5677 5678 5679 5680 |
objectsUsed = 0;
while (wordIdx--) {
if (expand[wordIdx]) {
int numElements;
Tcl_Obj **elements, *temp = copy[wordIdx];
| | | 5784 5785 5786 5787 5788 5789 5790 5791 5792 5793 5794 5795 5796 5797 5798 |
objectsUsed = 0;
while (wordIdx--) {
if (expand[wordIdx]) {
int numElements;
Tcl_Obj **elements, *temp = copy[wordIdx];
TclListObjGetElements(NULL, temp, &numElements,
&elements);
objectsUsed += numElements;
while (numElements--) {
lines[objIdx] = -1;
objv[objIdx--] = elements[numElements];
Tcl_IncrRefCount(elements[numElements]);
}
|
| ︙ | ︙ | |||
7530 7531 7532 7533 7534 7535 7536 |
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) {
| | | 7640 7641 7642 7643 7644 7645 7646 7647 7648 7649 7650 7651 7652 7653 7654 |
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
|
| ︙ | ︙ | |||
7570 7571 7572 7573 7574 7575 7576 |
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) {
| | | 7680 7681 7682 7683 7684 7685 7686 7687 7688 7689 7690 7691 7692 7693 7694 |
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
|
| ︙ | ︙ | |||
7716 7717 7718 7719 7720 7721 7722 |
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) {
| | | | 7826 7827 7828 7829 7830 7831 7832 7833 7834 7835 7836 7837 7838 7839 7840 7841 7842 7843 7844 7845 7846 7847 7848 7849 7850 7851 |
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
if (code != TCL_OK) {
return TCL_ERROR;
}
if ((d >= 0.0) && isinf(d)
&& (Tcl_GetBignumFromObj(NULL, objv[1], &big) == TCL_OK)) {
mp_int root;
mp_err err;
err = mp_init(&root);
if (err == MP_OKAY) {
err = mp_sqrt(&big, &root);
|
| ︙ | ︙ | |||
7770 7771 7772 7773 7774 7775 7776 |
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) {
| | | 7880 7881 7882 7883 7884 7885 7886 7887 7888 7889 7890 7891 7892 7893 7894 |
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;
}
}
|
| ︙ | ︙ | |||
7792 7793 7794 7795 7796 7797 7798 |
static int
CheckDoubleResult(
Tcl_Interp *interp,
double dResult)
{
#ifndef ACCEPT_NAN
| | | | 7902 7903 7904 7905 7906 7907 7908 7909 7910 7911 7912 7913 7914 7915 7916 7917 7918 7919 7920 7921 |
static int
CheckDoubleResult(
Tcl_Interp *interp,
double dResult)
{
#ifndef ACCEPT_NAN
if (isnan(dResult)) {
TclExprFloatError(interp, dResult);
return TCL_ERROR;
}
#endif
if ((errno == ERANGE) && ((dResult == 0.0) || isinf(dResult))) {
/*
* When ERANGE signals under/overflow, just accept 0.0 or +/-Inf
*/
} else if (errno != 0) {
/*
* Report other errno values as errors.
*/
|
| ︙ | ︙ | |||
7834 7835 7836 7837 7838 7839 7840 |
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) {
| | | | 7944 7945 7946 7947 7948 7949 7950 7951 7952 7953 7954 7955 7956 7957 7958 7959 7960 7961 7962 7963 7964 7965 7966 7967 7968 7969 7970 7971 7972 7973 |
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;
}
}
|
| ︙ | ︙ | |||
8010 8011 8012 8013 8014 8015 8016 |
if (objc != 2) {
MathFuncWrongNumArgs(interp, 2, objc, objv);
return TCL_ERROR;
}
if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) {
#ifdef ACCEPT_NAN
| | | 8120 8121 8122 8123 8124 8125 8126 8127 8128 8129 8130 8131 8132 8133 8134 |
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));
|
| ︙ | ︙ | |||
8187 8188 8189 8190 8191 8192 8193 | iPtr->flags |= RAND_SEED_INITIALIZED; /* * To ensure different seeds in different threads (bug #416643), * take into consideration the thread this interp is running in. */ | | | | | | 8297 8298 8299 8300 8301 8302 8303 8304 8305 8306 8307 8308 8309 8310 8311 8312 8313 8314 8315 8316 8317 8318 8319 |
iPtr->flags |= RAND_SEED_INITIALIZED;
/*
* To ensure different seeds in different threads (bug #416643),
* take into consideration the thread this interp is running in.
*/
iPtr->randSeed = TclpGetClicks() + PTR2UINT(Tcl_GetCurrentThread())*4093U;
/*
* Make sure 1 <= randSeed <= (2^31) - 2. See below.
*/
iPtr->randSeed &= 0x7FFFFFFFL;
if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7FFFFFFFL)) {
iPtr->randSeed ^= 123459876L;
}
}
/*
* Generate the random number using the linear congruential generator
* defined by the following recurrence:
* seed = ( IA * seed ) mod IM
|
| ︙ | ︙ | |||
9283 9284 9285 9286 9287 9288 9289 |
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *listPtr = (Tcl_Obj *)data[0], *nsObjPtr;
Tcl_Namespace *nsPtr;
int objc;
Tcl_Obj **objv;
| | | 9393 9394 9395 9396 9397 9398 9399 9400 9401 9402 9403 9404 9405 9406 9407 |
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *listPtr = (Tcl_Obj *)data[0], *nsObjPtr;
Tcl_Namespace *nsPtr;
int objc;
Tcl_Obj **objv;
TclListObjGetElements(interp, listPtr, &objc, &objv);
nsObjPtr = objv[0];
if (result == TCL_OK) {
result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
}
if (result != TCL_OK) {
|
| ︙ | ︙ | |||
9446 9447 9448 9449 9450 9451 9452 9453 9454 9455 9456 9457 9458 9459 |
/*
* Add the callback in the caller's env, then instruct TEBC to yield.
*/
iPtr->execEnvPtr = corPtr->callerEEPtr;
TclSetTailcall(interp, listPtr);
iPtr->execEnvPtr = corPtr->eePtr;
return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv);
}
static int
RewindCoroutineCallback(
| > | 9556 9557 9558 9559 9560 9561 9562 9563 9564 9565 9566 9567 9568 9569 9570 |
/*
* Add the callback in the caller's env, then instruct TEBC to yield.
*/
iPtr->execEnvPtr = corPtr->callerEEPtr;
TclSetTailcall(interp, listPtr);
corPtr->yieldPtr = listPtr;
iPtr->execEnvPtr = corPtr->eePtr;
return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv);
}
static int
RewindCoroutineCallback(
|
| ︙ | ︙ | |||
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 |
iPtr->numLevels += numLevels;
} else {
/*
* Coroutine is active: yield
*/
if (corPtr->stackLevel != stackLevel) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"cannot yield: C stack busy", -1));
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD",
NULL);
return TCL_ERROR;
}
if (type == CORO_ACTIVATE_YIELD) {
corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL;
} else if (type == CORO_ACTIVATE_YIELDM) {
corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY;
} else {
Tcl_Panic("Yield received an option which is not implemented");
}
corPtr->stackLevel = NULL;
numLevels = iPtr->numLevels;
iPtr->numLevels = corPtr->auxNumLevels;
corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;
iPtr->execEnvPtr = corPtr->callerEEPtr;
| > > > > > > > > > > > > > > > > > | 9754 9755 9756 9757 9758 9759 9760 9761 9762 9763 9764 9765 9766 9767 9768 9769 9770 9771 9772 9773 9774 9775 9776 9777 9778 9779 9780 9781 9782 9783 9784 9785 9786 9787 9788 9789 9790 9791 9792 9793 9794 9795 9796 9797 9798 9799 |
iPtr->numLevels += numLevels;
} else {
/*
* Coroutine is active: yield
*/
if (corPtr->stackLevel != stackLevel) {
NRE_callback *runPtr;
iPtr->execEnvPtr = corPtr->callerEEPtr;
if (corPtr->yieldPtr) {
for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
if (runPtr->data[1] == corPtr->yieldPtr) {
runPtr->data[1] = NULL;
Tcl_DecrRefCount(corPtr->yieldPtr);
corPtr->yieldPtr = NULL;
break;
}
}
}
iPtr->execEnvPtr = corPtr->eePtr;
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"cannot yield: C stack busy", -1));
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD",
NULL);
return TCL_ERROR;
}
if (type == CORO_ACTIVATE_YIELD) {
corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL;
} else if (type == CORO_ACTIVATE_YIELDM) {
corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY;
} else {
Tcl_Panic("Yield received an option which is not implemented");
}
corPtr->yieldPtr = NULL;
corPtr->stackLevel = NULL;
numLevels = iPtr->numLevels;
iPtr->numLevels = corPtr->auxNumLevels;
corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;
iPtr->execEnvPtr = corPtr->callerEEPtr;
|
| ︙ | ︙ |
Changes to generic/tclBinary.c.
1 2 3 4 | /* * tclBinary.c -- * * This file contains the implementation of the "binary" Tcl built-in | | | 1 2 3 4 5 6 7 8 9 10 11 12 | /* * tclBinary.c -- * * This file contains the implementation of the "binary" Tcl built-in * command and the Tcl value internal representation for binary data. * * 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. */ |
| ︙ | ︙ | |||
69 70 71 72 73 74 75 | int flags, Tcl_HashTable **numberCachePtr); static int SetByteArrayFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfByteArray(Tcl_Obj *listPtr); static void DeleteScanNumberCache(Tcl_HashTable *numberCachePtr); static int NeedReversing(int format); static void CopyNumber(const void *from, void *to, | | | < < | < < | < < | < < | < < | < < | < < | < < | 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 |
int flags, Tcl_HashTable **numberCachePtr);
static int SetByteArrayFromAny(Tcl_Interp *interp,
Tcl_Obj *objPtr);
static void UpdateStringOfByteArray(Tcl_Obj *listPtr);
static void DeleteScanNumberCache(Tcl_HashTable *numberCachePtr);
static int NeedReversing(int format);
static void CopyNumber(const void *from, void *to,
unsigned int length, int type);
/* Binary ensemble commands */
static Tcl_ObjCmdProc BinaryFormatCmd;
static Tcl_ObjCmdProc BinaryScanCmd;
/* Binary encoding sub-ensemble commands */
static Tcl_ObjCmdProc BinaryEncodeHex;
static Tcl_ObjCmdProc BinaryDecodeHex;
static Tcl_ObjCmdProc BinaryEncode64;
static Tcl_ObjCmdProc BinaryDecode64;
static Tcl_ObjCmdProc BinaryEncodeUu;
static Tcl_ObjCmdProc BinaryDecodeUu;
/*
* The following tables are used by the binary encoders
*/
static const char HexDigits[16] = {
'0', '1', '2', '3', '4', '5', '6', '7',
|
| ︙ | ︙ | |||
161 162 163 164 165 166 167 | /* * The following object types represent an array of bytes. The intent is to * allow arbitrary binary data to pass through Tcl as a Tcl value without loss * or damage. Such values are useful for things like encoded strings or Tk * images to name just two. * * It's strange to have two Tcl_ObjTypes in place for this task when one would | | < | | < < | | | < < < | < < < < < < < < < < < < < < < < < < < < | > > | < > | | | | | | < < > > > | | | | 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 |
/*
* The following object types represent an array of bytes. The intent is to
* allow arbitrary binary data to pass through Tcl as a Tcl value without loss
* or damage. Such values are useful for things like encoded strings or Tk
* images to name just two.
*
* It's strange to have two Tcl_ObjTypes in place for this task when one would
* do, so a bit of detail and history will aid understanding.
*
* A bytearray is an ordered sequence of bytes. Each byte is an integer value
* in the range [0-255]. To be a Tcl value type, we need a way to encode each
* value in the value set as a Tcl string. A simple encoding is to
* represent each byte value as the same codepoint value. A bytearray of N
* bytes is encoded into a Tcl string of N characters where the codepoint of
* each character is the value of corresponding byte. This approach creates a
* one-to-one map between all bytearray values and a subset of Tcl string
* values.
*
* When converting a Tcl string value to the bytearray internal rep, the
* question arises what to do with strings outside that subset? That is,
* those Tcl strings containing at least one codepoint greater than 255? The
* obviously correct answer is to raise an error! That string value does not
* represent any valid bytearray value.
*
* Unfortunately this was not the path taken by the authors of the original
* tclByteArrayType. They chose to accept all Tcl string values as acceptable
* string encodings of the bytearray values that result from masking away the
* high bits of any codepoint value at all. This meant that every bytearray
* value had multiple accepted string representations.
*
* The implications of this choice are truly ugly, and motivated the proposal
* of TIP 568 to migrate away from it and to the more sensible design where
* each bytearray value has only one string representation. Full details are
* recorded in that TIP for those who seek them.
*
* The Tcl_ObjType "properByteArrayType" is (nearly) a correct implementation
* of bytearrays. Any Tcl value with the type properByteArrayType can have
* its bytearray value fetched and used with confidence that acting on that
* value is equivalent to acting on the true Tcl string value. This still
* implies a side testing burden -- past mistakes will not let us avoid that
* immediately, but it is at least a conventional test of type, and can be
* implemented entirely by examining the objPtr fields, with no need to query
* the internalrep, as a canonical flag would require. This benefit is made
* available to extensions through the public routine Tcl_GetBytesFromObj(),
* first available in Tcl 8.7.
*
* The public routines Tcl_GetByteArrayFromObj() and Tcl_SetByteArrayLength()
* must continue to follow their documented behavior through the 8.* series of
* releases. To support that legacy operation, we need a mechanism to retain
* compatibility with the deployed callers of the broken interface. That's
* what the retained "tclByteArrayType" provides. In those unusual
* circumstances where we convert an invalid bytearray value to a bytearray
* type, it is to this legacy type. Essentially any time this legacy type
* shows up, it's a signal of a bug being ignored.
*
* In Tcl 9, the incompatibility in the behavior of these public routines
* has been approved, and the legacy internal rep is no longer retained.
* The internal changes seen below are the limit of what can be done
* in a Tcl 8.* release. They provide a great expansion of the histories
* over which bytearray values can be useful.
*/
static const Tcl_ObjType properByteArrayType = {
"bytearray",
FreeProperByteArrayInternalRep,
DupProperByteArrayInternalRep,
UpdateStringOfByteArray,
|
| ︙ | ︙ | |||
263 264 265 266 267 268 269 |
* The following structure is the internal rep for a ByteArray object. Keeps
* track of how much memory has been used and how much has been allocated for
* the byte array to enable growing and shrinking of the ByteArray object with
* fewer mallocs.
*/
typedef struct ByteArray {
| | | < | > > | | | | | | | | | | | | | | | | | | 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 |
* The following structure is the internal rep for a ByteArray object. Keeps
* track of how much memory has been used and how much has been allocated for
* the byte array to enable growing and shrinking of the ByteArray object with
* fewer mallocs.
*/
typedef struct ByteArray {
unsigned int bad; /* Index of first character that is a nonbyte.
* If all characters are bytes, bad = used. */
unsigned int used; /* The number of bytes used in the byte
* array. Must be <= allocated. The bytes
* used to store the value are indexed from
* 0 to used-1. */
unsigned int allocated; /* The number of bytes of space allocated. */
unsigned char bytes[TCLFLEXARRAY];
/* The array of bytes. The actual size of this
* field is stored in the 'allocated' field
* above. */
} ByteArray;
#define BYTEARRAY_SIZE(len) \
(offsetof(ByteArray, bytes) + (len))
#define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1)
#define SET_BYTEARRAY(irPtr, baPtr) \
(irPtr)->twoPtrValue.ptr1 = (void *) (baPtr)
int
TclIsPureByteArray(
Tcl_Obj * objPtr)
{
return TclHasInternalRep(objPtr, &properByteArrayType);
}
/*
*----------------------------------------------------------------------
*
* Tcl_NewByteArrayObj --
*
* This procedure is creates a new ByteArray object and initializes it
* from the given array of bytes.
*
* Results:
* The newly created object is returned. This object has no initial
* string representation. The returned object has a ref count of 0.
*
* Side effects:
* Memory allocated for new object and copy of byte array argument.
*
*----------------------------------------------------------------------
*/
#undef Tcl_NewByteArrayObj
Tcl_Obj *
Tcl_NewByteArrayObj(
const unsigned char *bytes, /* The array of bytes used to initialize the
* new object. */
int numBytes) /* Number of bytes in the array,
* must be >= 0. */
{
#ifdef TCL_MEM_DEBUG
return Tcl_DbNewByteArrayObj(bytes, numBytes, "unknown", 0);
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *objPtr;
TclNewObj(objPtr);
Tcl_SetByteArrayObj(objPtr, bytes, numBytes);
return objPtr;
#endif /* TCL_MEM_DEBUG */
}
/*
*----------------------------------------------------------------------
*
* Tcl_DbNewByteArrayObj --
*
* This procedure is normally called when debugging: i.e., when
* TCL_MEM_DEBUG is defined. It is the same as the Tcl_NewByteArrayObj
* above except that it calls Tcl_DbCkalloc directly with the file name
* and line number from its caller. This simplifies debugging since then
* the [memory active] command will report the correct file name and line
* number when reporting objects that haven't been freed.
*
* When TCL_MEM_DEBUG is not defined, this procedure just returns the
* result of calling Tcl_NewByteArrayObj.
*
* Results:
* The newly created object is returned. This object has no initial
* string representation. The returned object has a ref count of 0.
*
* Side effects:
* Memory allocated for new object and copy of byte array argument.
*
*----------------------------------------------------------------------
*/
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_DbNewByteArrayObj(
const unsigned char *bytes, /* The array of bytes used to initialize the
* new object. */
int numBytes, /* Number of bytes in the array,
* must be >= 0. */
const char *file, /* The name of the source file calling this
* procedure; used for debugging. */
int line) /* Line number in the source file; used for
* debugging. */
{
Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
Tcl_SetByteArrayObj(objPtr, bytes, numBytes);
return objPtr;
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_DbNewByteArrayObj(
const unsigned char *bytes, /* The array of bytes used to initialize the
* new object. */
int numBytes, /* Number of bytes in the array,
* must be >= 0. */
TCL_UNUSED(const char *) /*file*/,
TCL_UNUSED(int) /*line*/)
{
return Tcl_NewByteArrayObj(bytes, numBytes);
}
#endif /* TCL_MEM_DEBUG */
/*
*---------------------------------------------------------------------------
*
* Tcl_SetByteArrayObj --
|
| ︙ | ︙ | |||
405 406 407 408 409 410 411 |
*----------------------------------------------------------------------
*/
void
Tcl_SetByteArrayObj(
Tcl_Obj *objPtr, /* Object to initialize as a ByteArray. */
const unsigned char *bytes, /* The array of bytes to use as the new value.
| | | | | < | < | | | | | | | | | | | | | > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | | 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 |
*----------------------------------------------------------------------
*/
void
Tcl_SetByteArrayObj(
Tcl_Obj *objPtr, /* Object to initialize as a ByteArray. */
const unsigned char *bytes, /* The array of bytes to use as the new value.
* May be NULL even if numBytes > 0. */
int numBytes) /* Number of bytes in the array,
* must be >= 0. */
{
ByteArray *byteArrayPtr;
Tcl_ObjInternalRep ir;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
}
TclInvalidateStringRep(objPtr);
assert(numBytes >= 0);
byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(numBytes));
byteArrayPtr->bad = numBytes;
byteArrayPtr->used = numBytes;
byteArrayPtr->allocated = numBytes;
if ((bytes != NULL) && (numBytes > 0)) {
memcpy(byteArrayPtr->bytes, bytes, numBytes);
}
SET_BYTEARRAY(&ir, byteArrayPtr);
Tcl_StoreInternalRep(objPtr, &properByteArrayType, &ir);
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetBytesFromObj/TclGetBytesFromObj --
*
* Attempt to extract the value from objPtr in the representation
* of a byte sequence. On success return the extracted byte sequence.
* On failure, return NULL and record error message and code in
* interp (if not NULL).
*
* Results:
* NULL or pointer to array of bytes representing the ByteArray object.
* Writes number of bytes in array to *numBytesPtr.
*
*----------------------------------------------------------------------
*/
unsigned char *
TclGetBytesFromObj(
Tcl_Interp *interp, /* For error reporting */
Tcl_Obj *objPtr, /* Value to extract from */
int *numBytesPtr) /* If non-NULL, write the number of bytes
* in the array here */
{
ByteArray *baPtr;
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &properByteArrayType);
if (irPtr == NULL) {
SetByteArrayFromAny(NULL, objPtr);
irPtr = TclFetchInternalRep(objPtr, &properByteArrayType);
if (irPtr == NULL) {
if (interp) {
const char *nonbyte;
int ucs4;
irPtr = TclFetchInternalRep(objPtr, &tclByteArrayType);
baPtr = GET_BYTEARRAY(irPtr);
nonbyte = Tcl_UtfAtIndex(Tcl_GetString(objPtr), baPtr->bad);
TclUtfToUCS4(nonbyte, &ucs4);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected byte sequence but character %d "
"was '%1s' (U+%06X)", baPtr->bad, nonbyte, ucs4));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "BYTES", NULL);
}
return NULL;
}
}
baPtr = GET_BYTEARRAY(irPtr);
if (numBytesPtr != NULL) {
*numBytesPtr = baPtr->used;
}
return baPtr->bytes;
}
#undef Tcl_GetBytesFromObj
unsigned char *
Tcl_GetBytesFromObj(
Tcl_Interp *interp, /* For error reporting */
Tcl_Obj *objPtr, /* Value to extract from */
size_t *numBytesPtr) /* If non-NULL, write the number of bytes
* in the array here */
{
ByteArray *baPtr;
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &properByteArrayType);
if (irPtr == NULL) {
SetByteArrayFromAny(NULL, objPtr);
irPtr = TclFetchInternalRep(objPtr, &properByteArrayType);
if (irPtr == NULL) {
if (interp) {
const char *nonbyte;
int ucs4;
irPtr = TclFetchInternalRep(objPtr, &tclByteArrayType);
baPtr = GET_BYTEARRAY(irPtr);
nonbyte = Tcl_UtfAtIndex(Tcl_GetString(objPtr), baPtr->bad);
TclUtfToUCS4(nonbyte, &ucs4);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected byte sequence but character %d "
"was '%1s' (U+%06X)", baPtr->bad, nonbyte, ucs4));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "BYTES", NULL);
}
return NULL;
}
}
baPtr = GET_BYTEARRAY(irPtr);
if (numBytesPtr != NULL) {
*numBytesPtr = baPtr->used;
}
return baPtr->bytes;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
511 512 513 514 515 516 517 |
*----------------------------------------------------------------------
*/
#undef Tcl_GetByteArrayFromObj
unsigned char *
Tcl_GetByteArrayFromObj(
Tcl_Obj *objPtr, /* The ByteArray object. */
| | | | | | | | | | | | | | | > | | 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 |
*----------------------------------------------------------------------
*/
#undef Tcl_GetByteArrayFromObj
unsigned char *
Tcl_GetByteArrayFromObj(
Tcl_Obj *objPtr, /* The ByteArray object. */
int *numBytesPtr) /* If non-NULL, write the number of bytes
* in the array here */
{
ByteArray *baPtr;
const Tcl_ObjInternalRep *irPtr;
unsigned char *result = TclGetBytesFromObj(NULL, objPtr, numBytesPtr);
if (result) {
return result;
}
irPtr = TclFetchInternalRep(objPtr, &tclByteArrayType);
assert(irPtr != NULL);
baPtr = GET_BYTEARRAY(irPtr);
if (numBytesPtr != NULL) {
*numBytesPtr = baPtr->used;
}
return (unsigned char *) baPtr->bytes;
}
unsigned char *
TclGetByteArrayFromObj(
Tcl_Obj *objPtr, /* The ByteArray object. */
size_t *numBytesPtr) /* If non-NULL, write the number of bytes
* in the array here */
{
ByteArray *baPtr;
const Tcl_ObjInternalRep *irPtr;
unsigned char *result = Tcl_GetBytesFromObj(NULL, objPtr, numBytesPtr);
if (result) {
return result;
}
irPtr = TclFetchInternalRep(objPtr, &tclByteArrayType);
assert(irPtr != NULL);
baPtr = GET_BYTEARRAY(irPtr);
if (numBytesPtr != NULL) {
#if TCL_MAJOR_VERSION > 8
*numBytesPtr = baPtr->used;
#else
/* TODO: What's going on here? Document or eliminate. */
*numBytesPtr = ((size_t)(unsigned int)(baPtr->used + 1)) - 1;
#endif
}
return baPtr->bytes;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
587 588 589 590 591 592 593 |
*
*----------------------------------------------------------------------
*/
unsigned char *
Tcl_SetByteArrayLength(
Tcl_Obj *objPtr, /* The ByteArray object. */
| | | | | | | | | > > > | 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 |
*
*----------------------------------------------------------------------
*/
unsigned char *
Tcl_SetByteArrayLength(
Tcl_Obj *objPtr, /* The ByteArray object. */
int numBytes) /* Number of bytes in resized array */
{
ByteArray *byteArrayPtr;
unsigned newLength;
Tcl_ObjInternalRep *irPtr;
assert(numBytes >= 0);
newLength = (unsigned int)numBytes;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength");
}
irPtr = TclFetchInternalRep(objPtr, &properByteArrayType);
if (irPtr == NULL) {
irPtr = TclFetchInternalRep(objPtr, &tclByteArrayType);
if (irPtr == NULL) {
SetByteArrayFromAny(NULL, objPtr);
irPtr = TclFetchInternalRep(objPtr, &properByteArrayType);
if (irPtr == NULL) {
irPtr = TclFetchInternalRep(objPtr, &tclByteArrayType);
}
}
}
/* Note that during truncation, the implementation does not free
* memory that is no longer needed. */
byteArrayPtr = GET_BYTEARRAY(irPtr);
if (newLength > byteArrayPtr->allocated) {
byteArrayPtr = (ByteArray *)ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(newLength));
byteArrayPtr->allocated = newLength;
SET_BYTEARRAY(irPtr, byteArrayPtr);
}
|
| ︙ | ︙ | |||
651 652 653 654 655 656 657 |
Tcl_Obj *objPtr) /* The object to convert to type ByteArray. */
{
size_t length, bad;
const char *src, *srcEnd;
unsigned char *dst;
Tcl_UniChar ch = 0;
ByteArray *byteArrayPtr;
| | | | > > > | | | 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 |
Tcl_Obj *objPtr) /* The object to convert to type ByteArray. */
{
size_t length, bad;
const char *src, *srcEnd;
unsigned char *dst;
Tcl_UniChar ch = 0;
ByteArray *byteArrayPtr;
Tcl_ObjInternalRep ir;
if (TclHasInternalRep(objPtr, &properByteArrayType)) {
return TCL_OK;
}
if (TclHasInternalRep(objPtr, &tclByteArrayType)) {
return TCL_OK;
}
src = TclGetString(objPtr);
length = bad = objPtr->length;
srcEnd = src + length;
/* Note the allocation is over-sized, possibly by a factor of four,
* or even a factor of two with a proper byte array value. */
byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length));
for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
src += TclUtfToUniChar(src, &ch);
if ((bad == length) && (ch > 255)) {
bad = dst - byteArrayPtr->bytes;
}
*dst++ = UCHAR(ch);
}
SET_BYTEARRAY(&ir, byteArrayPtr);
byteArrayPtr->allocated = length;
byteArrayPtr->used = dst - byteArrayPtr->bytes;
if (bad == length) {
byteArrayPtr->bad = byteArrayPtr->used;
Tcl_StoreInternalRep(objPtr, &properByteArrayType, &ir);
} else {
byteArrayPtr->bad = bad;
Tcl_StoreInternalRep(objPtr, &tclByteArrayType, &ir);
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
709 710 711 712 713 714 715 |
*----------------------------------------------------------------------
*/
static void
FreeByteArrayInternalRep(
Tcl_Obj *objPtr) /* Object with internal rep to free. */
{
| | | | 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 |
*----------------------------------------------------------------------
*/
static void
FreeByteArrayInternalRep(
Tcl_Obj *objPtr) /* Object with internal rep to free. */
{
ckfree(GET_BYTEARRAY(TclFetchInternalRep(objPtr, &tclByteArrayType)));
}
static void
FreeProperByteArrayInternalRep(
Tcl_Obj *objPtr) /* Object with internal rep to free. */
{
ckfree(GET_BYTEARRAY(TclFetchInternalRep(objPtr, &properByteArrayType)));
}
/*
*----------------------------------------------------------------------
*
* DupByteArrayInternalRep --
*
|
| ︙ | ︙ | |||
743 744 745 746 747 748 749 |
static void
DupByteArrayInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
unsigned int length;
ByteArray *srcArrayPtr, *copyArrayPtr;
| | | | | | | | 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 |
static void
DupByteArrayInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
unsigned int length;
ByteArray *srcArrayPtr, *copyArrayPtr;
Tcl_ObjInternalRep ir;
srcArrayPtr = GET_BYTEARRAY(TclFetchInternalRep(srcPtr, &tclByteArrayType));
length = srcArrayPtr->used;
copyArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length));
copyArrayPtr->bad = srcArrayPtr->bad;
copyArrayPtr->used = length;
copyArrayPtr->allocated = length;
memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length);
SET_BYTEARRAY(&ir, copyArrayPtr);
Tcl_StoreInternalRep(copyPtr, &tclByteArrayType, &ir);
}
static void
DupProperByteArrayInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
unsigned int length;
ByteArray *srcArrayPtr, *copyArrayPtr;
Tcl_ObjInternalRep ir;
srcArrayPtr = GET_BYTEARRAY(TclFetchInternalRep(srcPtr, &properByteArrayType));
length = srcArrayPtr->used;
copyArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length));
copyArrayPtr->bad = length;
copyArrayPtr->used = length;
copyArrayPtr->allocated = length;
memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length);
SET_BYTEARRAY(&ir, copyArrayPtr);
Tcl_StoreInternalRep(copyPtr, &properByteArrayType, &ir);
}
/*
*----------------------------------------------------------------------
*
* UpdateStringOfByteArray --
*
|
| ︙ | ︙ | |||
802 803 804 805 806 807 808 |
*/
static void
UpdateStringOfByteArray(
Tcl_Obj *objPtr) /* ByteArray object whose string rep to
* update. */
{
| | | < | 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 |
*/
static void
UpdateStringOfByteArray(
Tcl_Obj *objPtr) /* ByteArray object whose string rep to
* update. */
{
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &properByteArrayType);
ByteArray *byteArrayPtr = GET_BYTEARRAY(irPtr);
unsigned char *src = byteArrayPtr->bytes;
unsigned int i, length = byteArrayPtr->used;
unsigned int size = length;
/*
* How much space will string rep need?
*/
for (i = 0; i < length && size <= INT_MAX; i++) {
if ((src[i] == 0) || (src[i] > 127)) {
size += 1U;
}
}
if (size > INT_MAX) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
if (size == length) {
char *dst = Tcl_InitStringRep(objPtr, (char *)src, size);
TclOOM(dst, size);
} else {
char *dst = Tcl_InitStringRep(objPtr, NULL, size);
TclOOM(dst, size);
for (i = 0; i < length; i++) {
dst += Tcl_UniCharToUtf(src[i], dst);
}
}
}
/*
*----------------------------------------------------------------------
*
* TclAppendBytesToByteArray --
|
| ︙ | ︙ | |||
863 864 865 866 867 868 869 |
TclAppendBytesToByteArray(
Tcl_Obj *objPtr,
const unsigned char *bytes,
int len)
{
ByteArray *byteArrayPtr;
unsigned int length, needed;
| | | | | | | 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 |
TclAppendBytesToByteArray(
Tcl_Obj *objPtr,
const unsigned char *bytes,
int len)
{
ByteArray *byteArrayPtr;
unsigned int length, needed;
Tcl_ObjInternalRep *irPtr;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
}
if (len < 0) {
Tcl_Panic("%s must be called with definite number of bytes to append",
"TclAppendBytesToByteArray");
}
if (len == 0) {
/*
* Append zero bytes is a no-op.
*/
return;
}
length = (unsigned int) len;
irPtr = TclFetchInternalRep(objPtr, &properByteArrayType);
if (irPtr == NULL) {
irPtr = TclFetchInternalRep(objPtr, &tclByteArrayType);
if (irPtr == NULL) {
SetByteArrayFromAny(NULL, objPtr);
irPtr = TclFetchInternalRep(objPtr, &properByteArrayType);
if (irPtr == NULL) {
irPtr = TclFetchInternalRep(objPtr, &tclByteArrayType);
}
}
}
byteArrayPtr = GET_BYTEARRAY(irPtr);
if (length > INT_MAX - byteArrayPtr->used) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
|
| ︙ | ︙ | |||
1499 1500 1501 1502 1503 1504 1505 | * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ | | | 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 |
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
BinaryScanCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int arg; /* Index of next argument to consume. */
|
| ︙ | ︙ | |||
1919 1920 1921 1922 1923 1924 1925 |
(*formatPtr)++;
*flagsPtr |= BINARY_UNSIGNED;
}
if (**formatPtr == '*') {
(*formatPtr)++;
*countPtr = BINARY_ALL;
} else if (isdigit(UCHAR(**formatPtr))) { /* INTL: digit */
| | | 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 |
(*formatPtr)++;
*flagsPtr |= BINARY_UNSIGNED;
}
if (**formatPtr == '*') {
(*formatPtr)++;
*countPtr = BINARY_ALL;
} else if (isdigit(UCHAR(**formatPtr))) { /* INTL: digit */
unsigned long count;
errno = 0;
count = strtoul(*formatPtr, (char **) formatPtr, 10);
if (errno || (count > (unsigned long) INT_MAX)) {
*countPtr = INT_MAX;
} else {
*countPtr = (int) count;
|
| ︙ | ︙ | |||
2119 2120 2121 2122 2123 2124 2125 | } /* *---------------------------------------------------------------------- * * FormatNumber -- * | | | 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 | } /* *---------------------------------------------------------------------- * * FormatNumber -- * * This routine is called by BinaryFormatCmd to format a number into a * location pointed at by cursor. * * Results: * A standard Tcl result. * * Side effects: * Moves the cursor to the next location to be written into. |
| ︙ | ︙ | |||
2154 2155 2156 2157 2158 2159 2160 |
/*
* 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) {
| | | | 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 |
/*
* 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;
}
|
| ︙ | ︙ | |||
2288 2289 2290 2291 2292 2293 2294 | } /* *---------------------------------------------------------------------- * * ScanNumber -- * | | | 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 | } /* *---------------------------------------------------------------------- * * ScanNumber -- * * This routine is called by BinaryScanCmd to scan a number out of a * buffer. * * Results: * Returns a newly created object containing the scanned number. This * object has a ref count of zero. * * Side effects: |
| ︙ | ︙ | |||
2374 2375 2376 2377 2378 2379 2380 |
case 'i':
case 'I':
case 'n':
if (NeedReversing(type)) {
value = (long) (buffer[0]
+ (buffer[1] << 8)
+ (buffer[2] << 16)
| | | | 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 |
case 'i':
case 'I':
case 'n':
if (NeedReversing(type)) {
value = (long) (buffer[0]
+ (buffer[1] << 8)
+ (buffer[2] << 16)
+ (((unsigned long)buffer[3]) << 24));
} else {
value = (long) (buffer[3]
+ (buffer[2] << 8)
+ (buffer[1] << 16)
+ (((unsigned long) buffer[0]) << 24));
}
/*
* Check to see if the value was sign extended properly on systems
* where an int is more than 32-bits.
*
* We avoid caching unsigned integers as we cannot distinguish between
|
| ︙ | ︙ | |||
2875 2876 2877 2878 2879 2880 2881 |
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *resultObj;
unsigned char *data, *start, *cursor;
| | > | 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 |
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *resultObj;
unsigned char *data, *start, *cursor;
int offset, count, rawLength, i, j, bits, index;
unsigned int n;
int lineLength = 61;
const unsigned char SingleNewline[] = { UCHAR('\n') };
const unsigned char *wrapchar = SingleNewline;
int wrapcharlen = sizeof(SingleNewline);
enum { OPT_MAXLEN, OPT_WRAPCHAR };
static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };
|
| ︙ | ︙ |
Changes to generic/tclCkalloc.c.
| ︙ | ︙ | |||
37 38 39 40 41 42 43 |
size_t refCount; /* Number of mem_headers referencing this
* tag. */
char string[1]; /* Actual size of string will be as large as
* needed for actual tag. This must be the
* last field in the structure. */
} MemTag;
| | | 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 |
size_t refCount; /* Number of mem_headers referencing this
* tag. */
char string[1]; /* Actual size of string will be as large as
* needed for actual tag. This must be the
* last field in the structure. */
} MemTag;
#define TAG_SIZE(bytesInString) ((offsetof(MemTag, string) + 1U) + (bytesInString))
static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set
* by "memory tag" command). */
/*
* One of the following structures is allocated just before each dynamically
* allocated chunk of memory, both to record information about the chunk and
|
| ︙ | ︙ | |||
127 128 129 130 131 132 133 | static Tcl_Mutex *ckallocMutexPtr; static int ckallocInit = 0; /* * Prototypes for procedures defined in this file: */ | | | | 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 | static Tcl_Mutex *ckallocMutexPtr; static int ckallocInit = 0; /* * Prototypes for procedures defined in this file: */ static int CheckmemCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int MemoryCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void ValidateMemory(struct mem_header *memHeaderP, const char *file, int line, int nukeGuards); /* *---------------------------------------------------------------------- |
| ︙ | ︙ | |||
173 174 175 176 177 178 179 | * Display the global memory management statistics. * *---------------------------------------------------------------------- */ int TclDumpMemoryInfo( | | | 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 |
* Display the global memory management statistics.
*
*----------------------------------------------------------------------
*/
int
TclDumpMemoryInfo(
void *clientData,
int flags)
{
char buf[1024];
if (clientData == NULL) {
return 0;
}
|
| ︙ | ︙ | |||
377 378 379 380 381 382 383 | /* *---------------------------------------------------------------------- * * Tcl_DbCkalloc - debugging ckalloc * * Allocate the requested amount of space plus some extra for guard bands | | | 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 | /* *---------------------------------------------------------------------- * * Tcl_DbCkalloc - debugging ckalloc * * Allocate the requested amount of space plus some extra for guard bands * at both ends of the request, plus a size, panicking if there isn't * enough space, then write in the guard bands and return the address of * the space in the middle that the user asked for. * * The second and third arguments are file and line, these contain the * filename and line number corresponding to the caller. These are sent * by the ckalloc macro; it uses the preprocessor autodefines __FILE__ * and __LINE__. |
| ︙ | ︙ | |||
806 807 808 809 810 811 812 | * Results: * Standard TCL results. * *---------------------------------------------------------------------- */ static int MemoryCmd( | | | 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 |
* Results:
* Standard TCL results.
*
*----------------------------------------------------------------------
*/
static int
MemoryCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Obj values of arguments. */
{
const char *fileName;
FILE *fileP;
Tcl_DString buffer;
|
| ︙ | ︙ | |||
976 977 978 979 980 981 982 | * Returns a standard Tcl completion code. * * Side effects: * None. * *---------------------------------------------------------------------- */ | | | | 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 |
* Returns a standard Tcl completion code.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int CheckmemCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static int
CheckmemCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter for evaluation. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Obj values of arguments. */
{
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "fileName");
return TCL_ERROR;
|
| ︙ | ︙ | |||
1236 1237 1238 1239 1240 1241 1242 |
TCL_UNUSED(const char *) /*file*/,
TCL_UNUSED(int) /*line*/)
{
}
int
TclDumpMemoryInfo(
| | | 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 |
TCL_UNUSED(const char *) /*file*/,
TCL_UNUSED(int) /*line*/)
{
}
int
TclDumpMemoryInfo(
TCL_UNUSED(void *),
TCL_UNUSED(int) /*flags*/)
{
return 1;
}
#endif /* TCL_MEM_DEBUG */
|
| ︙ | ︙ |
Changes to generic/tclClock.c.
| ︙ | ︙ | |||
448 449 450 451 452 453 454 |
}
/*
* fields.seconds could be an unsigned number that overflowed. Make sure
* that it isn't.
*/
| | | 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 |
}
/*
* 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.
| ︙ | ︙ | |||
609 610 611 612 613 614 615 |
{
Tcl_Obj *data; /* String to convert */
Tcl_DString ds; /* Buffer to hold the byte array */
Tcl_Encoding encoding; /* Encoding to use */
int length; /* Length of the string being converted */
const char *stringPtr; /* Pointer to the first byte of the string */
| < < | 609 610 611 612 613 614 615 616 617 618 619 620 621 622 |
{
Tcl_Obj *data; /* String to convert */
Tcl_DString ds; /* Buffer to hold the byte array */
Tcl_Encoding encoding; /* Encoding to use */
int length; /* Length of the string being converted */
const char *stringPtr; /* Pointer to the first byte of the string */
if (objc == 2) {
encoding = Tcl_GetEncoding(interp, NULL);
data = objv[1];
} else if (objc == 3) {
if (Tcl_GetEncodingFromObj(interp, objv[1], &encoding) != TCL_OK) {
return TCL_ERROR;
}
|
| ︙ | ︙ |
Changes to generic/tclCmdIL.c.
| ︙ | ︙ | |||
1237 1238 1239 1240 1241 1242 1243 |
Tcl_Obj *
TclInfoFrame(
Tcl_Interp *interp, /* Current interpreter. */
CmdFrame *framePtr) /* Frame to get info for. */
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *tmpObj;
| | | 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 |
Tcl_Obj *
TclInfoFrame(
Tcl_Interp *interp, /* Current interpreter. */
CmdFrame *framePtr) /* Frame to get info for. */
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *tmpObj;
Tcl_Obj *lv[20] = {NULL}; /* Keep uptodate when more keys are added to
* the dict. */
int lc = 0;
/*
* This array is indexed by the TCL_LOCATION_... values, except
* for _LAST.
*/
static const char *const typeString[TCL_LOCATION_LAST] = {
|
| ︙ | ︙ | |||
2727 2728 2729 2730 2731 2732 2733 |
int
Tcl_LremoveObjCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
| | | | 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 |
int
Tcl_LremoveObjCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int i, idxc, listLen, prevIdx, first, num;
int *idxv;
Tcl_Obj *listObj;
/*
* Parse the arguments.
*/
if (objc < 2) {
|
| ︙ | ︙ | |||
2956 2957 2958 2959 2960 2961 2962 |
Tcl_LreplaceObjCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *listPtr;
| > | | 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 |
Tcl_LreplaceObjCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *listPtr;
int first, last;
int listLen, numToDelete, result;
if (objc < 4) {
Tcl_WrongNumArgs(interp, 1, objv,
"list first last ?element ...?");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
2987 2988 2989 2990 2991 2992 2993 |
result = TclGetIntForIndexM(interp, objv[3], /*end*/ listLen-1, &last);
if (result != TCL_OK) {
return result;
}
if (first == TCL_INDEX_NONE) {
first = 0;
| < | | 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 |
result = TclGetIntForIndexM(interp, objv[3], /*end*/ listLen-1, &last);
if (result != TCL_OK) {
return result;
}
if (first == TCL_INDEX_NONE) {
first = 0;
} else if (first > listLen) {
first = listLen;
}
if (last >= listLen) {
last = listLen - 1;
}
if (first <= last) {
|
| ︙ | ︙ | |||
3136 3137 3138 3139 3140 3141 3142 |
Tcl_LsearchObjCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
{
const char *bytes, *patternBytes;
| | > | | 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 |
Tcl_LsearchObjCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
{
const char *bytes, *patternBytes;
int i, match, index, result=TCL_OK, listc, bisect;
int length, elemLen, start, groupSize, groupOffset, lower, upper;
int allocatedIndexVector = 0;
int dataType, isIncreasing;
Tcl_WideInt patWide, objWide;
int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
double patDouble, objDouble;
SortInfo sortInfo;
Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr;
SortStrCmpFn_t strCmpFn = TclUtfCmp;
Tcl_RegExp regexp = NULL;
|
| ︙ | ︙ | |||
3510 3511 3512 3513 3514 3515 3516 |
* "did not match anything at all" result straight away. [Bug 1374778]
*/
if (start > listc-1) {
if (allMatches || inlineReturn) {
Tcl_ResetResult(interp);
} else {
| | | 3511 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 3525 |
* "did not match anything at all" result straight away. [Bug 1374778]
*/
if (start > listc-1) {
if (allMatches || inlineReturn) {
Tcl_ResetResult(interp);
} else {
TclNewIndexObj(itemPtr, TCL_INDEX_NONE);
Tcl_SetObjResult(interp, itemPtr);
}
goto done;
}
/*
* If start points within a group, it points to the start of the group.
|
| ︙ | ︙ | |||
3641 3642 3643 3644 3645 3646 3647 |
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
*
| | | 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 |
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
*
* To maintain consistency with standard lsearch semantics, we
* must find the leftmost occurrence of the pattern in the
* list. Thus we don't just stop searching here. This
* variation means that a search always makes log n
* comparisons (normal binary search might "get lucky" with an
* early comparison).
*
* In bisect mode though, we want the last of equals.
|
| ︙ | ︙ | |||
3715 3716 3717 3718 3719 3720 3721 |
* This split allows for more optimal compilation of
* memcmp/strcasecmp.
*/
if (noCase) {
match = (TclUtfCasecmp(bytes, patternBytes) == 0);
} else {
| | < | 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 |
* This split allows for more optimal compilation of
* memcmp/strcasecmp.
*/
if (noCase) {
match = (TclUtfCasecmp(bytes, patternBytes) == 0);
} else {
match = (memcmp(bytes, patternBytes, length) == 0);
}
}
break;
case DICTIONARY:
bytes = TclGetString(itemPtr);
match = (DictionaryCompare(bytes, patternBytes) == 0);
|
| ︙ | ︙ | |||
3800 3801 3802 3803 3804 3805 3806 |
} else {
itemPtr = listv[i];
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
}
} else if (returnSubindices) {
int j;
| | | | | | | 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 |
} else {
itemPtr = listv[i];
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
}
} else if (returnSubindices) {
int j;
TclNewIndexObj(itemPtr, i+groupOffset);
for (j=0 ; j<sortInfo.indexc ; j++) {
Tcl_Obj *elObj;
TclNewIndexObj(elObj, TclIndexDecode(sortInfo.indexv[j], listc));
Tcl_ListObjAppendElement(interp, itemPtr, elObj);
}
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
} else {
Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewWideIntObj(i));
}
}
}
/*
* Return everything or a single value.
*/
if (allMatches) {
Tcl_SetObjResult(interp, listPtr);
} else if (!inlineReturn) {
if (returnSubindices) {
int j;
TclNewIndexObj(itemPtr, index+groupOffset);
for (j=0 ; j<sortInfo.indexc ; j++) {
Tcl_Obj *elObj;
TclNewIndexObj(elObj, TclIndexDecode(sortInfo.indexv[j], listc));
Tcl_ListObjAppendElement(interp, itemPtr, elObj);
}
Tcl_SetObjResult(interp, itemPtr);
} 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...
*/
|
| ︙ | ︙ | |||
4416 4417 4418 4419 4420 4421 4422 |
listRepPtr = ListRepPtr(resultPtr);
newArray = &listRepPtr->elements;
if (group) {
for (i=0; elementPtr!=NULL ; elementPtr=elementPtr->nextPtr) {
idx = elementPtr->payload.index;
for (j = 0; j < groupSize; j++) {
if (indices) {
| | | | 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 |
listRepPtr = ListRepPtr(resultPtr);
newArray = &listRepPtr->elements;
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 {
objPtr = listObjPtrs[idx + j - groupOffset];
newArray[i++] = objPtr;
Tcl_IncrRefCount(objPtr);
}
}
}
} else if (indices) {
for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
TclNewIndexObj(objPtr, elementPtr->payload.index);
newArray[i++] = objPtr;
Tcl_IncrRefCount(objPtr);
}
} else {
for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
objPtr = elementPtr->payload.objPtr;
newArray[i++] = objPtr;
|
| ︙ | ︙ |
Changes to generic/tclCmdMZ.c.
| ︙ | ︙ | |||
381 382 383 384 385 386 387 |
* match instead of the first character after the match.
*/
if (end >= offset) {
end--;
}
} else {
| | | | | | | 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 |
* match instead of the first character after the match.
*/
if (end >= offset) {
end--;
}
} else {
start = TCL_INDEX_NONE;
end = TCL_INDEX_NONE;
}
TclNewIndexObj(objs[0], start);
TclNewIndexObj(objs[1], end);
newPtr = Tcl_NewListObj(2, objs);
} else {
if ((i <= info.nsubs) && (info.matches[i].end > 0)) {
newPtr = Tcl_GetRange(objPtr,
offset + info.matches[i].start,
offset + info.matches[i].end - 1);
} else {
TclNewObj(newPtr);
}
}
|
| ︙ | ︙ | |||
670 671 672 673 674 675 676 | /* * In command-prefix mode, we require that the third non-option * argument be a list, so we enforce that here. Afterwards, we fetch * the RE compilation again in case objv[0] and objv[2] are the same * object. (If they aren't, that's cheap to do.) */ | | | 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 |
/*
* In command-prefix mode, we require that the third non-option
* argument be a list, so we enforce that here. Afterwards, we fetch
* the RE compilation again in case objv[0] and objv[2] are the same
* object. (If they aren't, that's cheap to do.)
*/
if (TclListObjLength(interp, objv[2], &numParts) != TCL_OK) {
return TCL_ERROR;
}
if (numParts < 1) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"command prefix must be a list of at least one element",
-1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "REGSUB",
|
| ︙ | ︙ | |||
772 773 774 775 776 777 778 |
* everything is passed through Tcl_EvalObjv, as that's much faster.
*/
if (command) {
Tcl_Obj **args = NULL, **parts;
int numArgs;
| | | 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 |
* everything is passed through Tcl_EvalObjv, as that's much faster.
*/
if (command) {
Tcl_Obj **args = NULL, **parts;
int numArgs;
TclListObjGetElements(interp, subPtr, &numParts, &parts);
numArgs = numParts + info.nsubs + 1;
args = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj*) * numArgs);
memcpy(args, parts, sizeof(Tcl_Obj*) * numParts);
for (idx = 0 ; idx <= info.nsubs ; idx++) {
subStart = info.matches[idx].start;
subEnd = info.matches[idx].end;
|
| ︙ | ︙ | |||
1529 1530 1531 1532 1533 1534 1535 |
Tcl_WideInt w;
static const char *const isClasses[] = {
"alnum", "alpha", "ascii", "control",
"boolean", "dict", "digit", "double",
"entier", "false", "graph", "integer",
"list", "lower", "print", "punct",
| | | | | | 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 |
Tcl_WideInt w;
static const char *const isClasses[] = {
"alnum", "alpha", "ascii", "control",
"boolean", "dict", "digit", "double",
"entier", "false", "graph", "integer",
"list", "lower", "print", "punct",
"space", "true", "upper", "unicode",
"wideinteger", "wordchar", "xdigit", NULL
};
enum isClassesEnum {
STR_IS_ALNUM, STR_IS_ALPHA, STR_IS_ASCII, STR_IS_CONTROL,
STR_IS_BOOL, STR_IS_DICT, STR_IS_DIGIT, STR_IS_DOUBLE,
STR_IS_ENTIER, STR_IS_FALSE, STR_IS_GRAPH, STR_IS_INT,
STR_IS_LIST, STR_IS_LOWER, STR_IS_PRINT, STR_IS_PUNCT,
STR_IS_SPACE, STR_IS_TRUE, STR_IS_UPPER, STR_IS_UNICODE,
STR_IS_WIDE, STR_IS_WORD, STR_IS_XDIGIT
};
static const char *const isOptions[] = {
"-strict", "-failindex", NULL
};
enum isOptionsEnum {
OPT_STRICT, OPT_FAILIDX
};
|
| ︙ | ︙ | |||
1607 1608 1609 1610 1611 1612 1613 |
break;
case STR_IS_ASCII:
chcomp = UniCharIsAscii;
break;
case STR_IS_BOOL:
case STR_IS_TRUE:
case STR_IS_FALSE:
| | | 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 |
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 = TclGetStringFromObj(objPtr, &length1);
result = length1 == 0;
}
|
| ︙ | ︙ | |||
1677 1678 1679 1680 1681 1682 1683 |
}
break;
}
case STR_IS_DIGIT:
chcomp = Tcl_UniCharIsDigit;
break;
case STR_IS_DOUBLE: {
| | | | | | | | 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 |
}
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 = TclGetStringFromObj(objPtr, &length1);
if (length1 == 0) {
if (strict) {
result = 0;
}
goto str_is_done;
}
end = string1 + length1;
if (TclParseNumber(NULL, objPtr, NULL, NULL, -1,
(const char **) &stop, 0) != TCL_OK) {
result = 0;
failat = 0;
} else {
failat = stop - string1;
if (stop < end) {
result = 0;
TclFreeInternalRep(objPtr);
}
}
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 = TclGetStringFromObj(objPtr, &length1);
if (length1 == 0) {
if (strict) {
result = 0;
}
|
| ︙ | ︙ | |||
1738 1739 1740 1741 1742 1743 1744 | * so return failure index as the point where parsing stopped. * Clear out the internal rep, since keeping it would leave * *objPtr in an inconsistent state. */ result = 0; failat = stop - string1; | | | 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 |
* so return failure index as the point where parsing stopped.
* Clear out the internal rep, since keeping it would leave
* *objPtr in an inconsistent state.
*/
result = 0;
failat = stop - string1;
TclFreeInternalRep(objPtr);
}
} else {
/*
* No prefix is a valid integer. Fail at beginning.
*/
result = 0;
|
| ︙ | ︙ | |||
1791 1792 1793 1794 1795 1796 1797 | * Some prefix parsed as an integer, but not the whole string, * so return failure index as the point where parsing stopped. * Clear out the internal rep, since keeping it would leave * *objPtr in an inconsistent state. */ failat = stop - string1; | | | 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 |
* Some prefix parsed as an integer, but not the whole string,
* so return failure index as the point where parsing stopped.
* Clear out the internal rep, since keeping it would leave
* *objPtr in an inconsistent state.
*/
failat = stop - string1;
TclFreeInternalRep(objPtr);
}
} else {
/*
* No prefix is a valid integer. Fail at beginning.
*/
failat = 0;
|
| ︙ | ︙ | |||
1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 |
break;
case STR_IS_SPACE:
chcomp = Tcl_UniCharIsSpace;
break;
case STR_IS_UPPER:
chcomp = Tcl_UniCharIsUpper;
break;
case STR_IS_WORD:
chcomp = Tcl_UniCharIsWordChar;
break;
case STR_IS_XDIGIT:
chcomp = UniCharIsHexDigit;
break;
}
| > > > | 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 |
break;
case STR_IS_SPACE:
chcomp = Tcl_UniCharIsSpace;
break;
case STR_IS_UPPER:
chcomp = Tcl_UniCharIsUpper;
break;
case STR_IS_UNICODE:
chcomp = Tcl_UniCharIsUnicode;
break;
case STR_IS_WORD:
chcomp = Tcl_UniCharIsWordChar;
break;
case STR_IS_XDIGIT:
chcomp = UniCharIsHexDigit;
break;
}
|
| ︙ | ︙ | |||
1903 1904 1905 1906 1907 1908 1909 |
/*
* Only set the failVarObj when we will return 0 and we have indicated a
* valid fail index (>= 0).
*/
str_is_done:
if ((result == 0) && (failVarObj != NULL)) {
| | | 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 |
/*
* Only set the failVarObj when we will return 0 and we have indicated a
* valid fail index (>= 0).
*/
str_is_done:
if ((result == 0) && (failVarObj != NULL)) {
TclNewIndexObj(objPtr, failat);
if (Tcl_ObjSetVar2(interp, failVarObj, NULL, objPtr, TCL_LEAVE_ERR_MSG) == NULL) {
return TCL_ERROR;
}
}
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
return TCL_OK;
}
|
| ︙ | ︙ | |||
1983 1984 1985 1986 1987 1988 1989 |
/*
* 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])
| | | 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 |
/*
* This test is tricky, but has to be that way or you get other strange
* inconsistencies (see test string-10.20.1 for illustration why!)
*/
if (!TclHasStringRep(objv[objc-2])
&& TclHasInternalRep(objv[objc-2], &tclDictType)) {
int i, done;
Tcl_DictSearch search;
/*
* We know the type exactly, so all dict operations will succeed for
* sure. This shortens this code quite a bit.
*/
|
| ︙ | ︙ | |||
2293 2294 2295 2296 2297 2298 2299 |
length = Tcl_GetCharLength(objv[1]) - 1;
if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK ||
TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK) {
return TCL_ERROR;
}
| < < < | < < < | 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 |
length = Tcl_GetCharLength(objv[1]) - 1;
if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK ||
TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK) {
return TCL_ERROR;
}
if (last >= 0) {
Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last));
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
2536 2537 2538 2539 2540 2541 2542 |
} while (next + delta < p);
p = next;
}
if (cur != index) {
cur += 1;
}
}
| | | 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 |
} while (next + delta < p);
p = next;
}
if (cur != index) {
cur += 1;
}
}
TclNewIndexObj(obj, cur);
Tcl_SetObjResult(interp, obj);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
2597 2598 2599 2600 2601 2602 2603 |
}
if (cur == index) {
cur++;
}
} else {
cur = length;
}
| | | 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 |
}
if (cur == index) {
cur++;
}
} else {
cur = length;
}
TclNewIndexObj(obj, cur);
Tcl_SetObjResult(interp, obj);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
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 |
* A standard Tcl result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
StringBytesCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int length;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "string");
return TCL_ERROR;
}
(void) TclGetStringFromObj(objv[1], &length);
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(length));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* StringLenCmd --
*
* This procedure is invoked to process the "string length" Tcl command.
| > > | 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 |
* A standard Tcl result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
#if TCL_MAJOR_VERSION < 9 && !defined(TCL_NO_DEPRECATED)
static int
StringBytesCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int length;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "string");
return TCL_ERROR;
}
(void) TclGetStringFromObj(objv[1], &length);
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(length));
return TCL_OK;
}
#endif
/*
*----------------------------------------------------------------------
*
* StringLenCmd --
*
* This procedure is invoked to process the "string length" Tcl command.
|
| ︙ | ︙ | |||
3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 |
*/
Tcl_Command
TclInitStringCmd(
Tcl_Interp *interp) /* Current interpreter. */
{
static const EnsembleImplMap stringImplMap[] = {
{"bytelength", StringBytesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"cat", StringCatCmd, TclCompileStringCatCmd, NULL, NULL, 0},
{"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL, 0},
{"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0},
{"first", StringFirstCmd, TclCompileStringFirstCmd, NULL, NULL, 0},
{"index", StringIndexCmd, TclCompileStringIndexCmd, NULL, NULL, 0},
{"insert", StringInsertCmd, TclCompileStringInsertCmd, NULL, NULL, 0},
{"is", StringIsCmd, TclCompileStringIsCmd, NULL, NULL, 0},
| > > | 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 |
*/
Tcl_Command
TclInitStringCmd(
Tcl_Interp *interp) /* Current interpreter. */
{
static const EnsembleImplMap stringImplMap[] = {
#if TCL_MAJOR_VERSION < 9 && !defined(TCL_NO_DEPRECATED)
{"bytelength", StringBytesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
#endif
{"cat", StringCatCmd, TclCompileStringCatCmd, NULL, NULL, 0},
{"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL, 0},
{"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0},
{"first", StringFirstCmd, TclCompileStringFirstCmd, NULL, NULL, 0},
{"index", StringIndexCmd, TclCompileStringIndexCmd, NULL, NULL, 0},
{"insert", StringInsertCmd, TclCompileStringInsertCmd, NULL, NULL, 0},
{"is", StringIsCmd, TclCompileStringIsCmd, NULL, NULL, 0},
|
| ︙ | ︙ | |||
3767 3768 3769 3770 3771 3772 3773 |
}
for (j=0 ; j<=info.nsubs ; j++) {
if (indexVarObj != NULL) {
Tcl_Obj *rangeObjAry[2];
if (info.matches[j].end > 0) {
| | | | | 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 |
}
for (j=0 ; j<=info.nsubs ; j++) {
if (indexVarObj != NULL) {
Tcl_Obj *rangeObjAry[2];
if (info.matches[j].end > 0) {
TclNewIndexObj(rangeObjAry[0], info.matches[j].start);
TclNewIndexObj(rangeObjAry[1], info.matches[j].end-1);
} else {
TclNewIndexObj(rangeObjAry[1], TCL_INDEX_NONE);
rangeObjAry[0] = rangeObjAry[1];
}
/*
* Never fails; the object is always clean at this point.
*/
|
| ︙ | ︙ | |||
3990 3991 3992 3993 3994 3995 3996 |
return TCL_ERROR;
}
/*
* The type must be a list of at least length 1.
*/
| | | 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 |
return TCL_ERROR;
}
/*
* The type must be a list of at least length 1.
*/
if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
return TCL_ERROR;
} else if (len < 1) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"type must be non-empty list", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "THROW", "BADEXCEPTION",
NULL);
return TCL_ERROR;
|
| ︙ | ︙ | |||
4778 4779 4780 4781 4782 4783 4784 | -1)); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP", "ARGUMENT", NULL); return TCL_ERROR; } code = 1; | | | | 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 |
-1));
Tcl_DecrRefCount(handlersObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP",
"ARGUMENT", NULL);
return TCL_ERROR;
}
code = 1;
if (TclListObjLength(NULL, objv[i+1], &dummy) != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad prefix '%s': must be a list",
Tcl_GetString(objv[i+1])));
Tcl_DecrRefCount(handlersObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP",
"EXNFORMAT", NULL);
return TCL_ERROR;
}
info[2] = objv[i+1];
commonHandler:
if (TclListObjLength(interp, objv[i+2], &dummy) != TCL_OK) {
Tcl_DecrRefCount(handlersObj);
return TCL_ERROR;
}
info[0] = objv[i]; /* type */
TclNewIntObj(info[1], code); /* returnCode */
if (info[2] == NULL) { /* errorCodePrefix */
|
| ︙ | ︙ | |||
4940 4941 4942 4943 4944 4945 4946 |
* Handle the results.
*/
if (handlersObj != NULL) {
int found = 0;
Tcl_Obj **handlers, **info;
| | | | | | 4941 4942 4943 4944 4945 4946 4947 4948 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 |
* Handle the results.
*/
if (handlersObj != NULL) {
int found = 0;
Tcl_Obj **handlers, **info;
TclListObjGetElements(NULL, handlersObj, &numHandlers, &handlers);
for (i=0 ; i<numHandlers ; i++) {
Tcl_Obj *handlerBodyObj;
int numElems = 0;
TclListObjGetElements(NULL, handlers[i], &numElems, &info);
if (!found) {
Tcl_GetIntFromObj(NULL, info[1], &code);
if (code != result) {
continue;
}
/*
* When processing an error, we must also perform list-prefix
* matching of the errorcode list. However, if this was an
* 'on' handler, the list that we are matching against will be
* empty.
*/
if (code == TCL_ERROR) {
Tcl_Obj *errorCodeName, *errcode, **bits1, **bits2;
int len1, len2, j;
TclNewLiteralStringObj(errorCodeName, "-errorcode");
Tcl_DictObjGet(NULL, options, errorCodeName, &errcode);
Tcl_DecrRefCount(errorCodeName);
TclListObjGetElements(NULL, info[2], &len1, &bits1);
if (TclListObjGetElements(NULL, errcode, &len2,
&bits2) != TCL_OK) {
continue;
}
if (len2 < len1) {
continue;
}
for (j=0 ; j<len1 ; j++) {
|
| ︙ | ︙ | |||
5007 5008 5009 5010 5011 5012 5013 | /* * Bind the variables. We already know this is a list of variable * names, but it might be empty. */ Tcl_ResetResult(interp); result = TCL_ERROR; | | | 5008 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 |
/*
* Bind the variables. We already know this is a list of variable
* names, but it might be empty.
*/
Tcl_ResetResult(interp);
result = TCL_ERROR;
TclListObjLength(NULL, info[3], &numElems);
if (numElems> 0) {
Tcl_Obj *varName;
Tcl_ListObjIndex(NULL, info[3], 0, &varName);
if (Tcl_ObjSetVar2(interp, varName, NULL, resultObj,
TCL_LEAVE_ERR_MSG) == NULL) {
Tcl_DecrRefCount(resultObj);
|
| ︙ | ︙ | |||
5109 5110 5111 5112 5113 5114 5115 |
TryPostHandler(
ClientData data[],
Tcl_Interp *interp,
int result)
{
Tcl_Obj *resultObj, *cmdObj, *options, *handlerKindObj, **objv;
Tcl_Obj *finallyObj;
| | | | | 5110 5111 5112 5113 5114 5115 5116 5117 5118 5119 5120 5121 5122 5123 5124 5125 5126 5127 5128 5129 5130 5131 5132 |
TryPostHandler(
ClientData data[],
Tcl_Interp *interp,
int result)
{
Tcl_Obj *resultObj, *cmdObj, *options, *handlerKindObj, **objv;
Tcl_Obj *finallyObj;
int finallyIndex;
objv = (Tcl_Obj **)data[0];
options = (Tcl_Obj *)data[1];
handlerKindObj = (Tcl_Obj *)data[2];
finallyIndex = PTR2INT(data[3]);
cmdObj = objv[0];
finallyObj = finallyIndex ? objv[finallyIndex] : 0;
/*
* Check for limits/rewinding, which override normal trapping behaviour.
*/
if (((Interp*) interp)->execEnvPtr->rewind || Tcl_LimitExceeded(interp)) {
options = During(interp, result, options, Tcl_ObjPrintf(
|
| ︙ | ︙ | |||
5161 5162 5163 5164 5165 5166 5167 | Interp *iPtr = (Interp *) interp; Tcl_NRAddCallback(interp, TryPostFinal, resultObj, options, cmdObj, NULL); /* The 'finally' script is always the last argument word. */ return TclNREvalObjEx(interp, finallyObj, 0, iPtr->cmdFramePtr, | | | 5162 5163 5164 5165 5166 5167 5168 5169 5170 5171 5172 5173 5174 5175 5176 |
Interp *iPtr = (Interp *) interp;
Tcl_NRAddCallback(interp, TryPostFinal, resultObj, options, cmdObj,
NULL);
/* The 'finally' script is always the last argument word. */
return TclNREvalObjEx(interp, finallyObj, 0, iPtr->cmdFramePtr,
finallyIndex);
}
/*
* Install the correct result/options into the interpreter and clean up
* any temporary storage.
*/
|
| ︙ | ︙ |
Changes to generic/tclCompCmds.c.
| ︙ | ︙ | |||
297 298 299 300 301 302 303 |
}
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
dataTokenPtr = TokenAfter(varTokenPtr);
TclNewObj(literalObj);
isDataLiteral = TclWordKnownAtCompileTime(dataTokenPtr, literalObj);
isDataValid = (isDataLiteral
| | | 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 |
}
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
dataTokenPtr = TokenAfter(varTokenPtr);
TclNewObj(literalObj);
isDataLiteral = TclWordKnownAtCompileTime(dataTokenPtr, literalObj);
isDataValid = (isDataLiteral
&& TclListObjLength(NULL, literalObj, &len) == TCL_OK);
isDataEven = (isDataValid && (len & 1) == 0);
/*
* Special case: literal odd-length argument is always an error.
*/
if (isDataValid && !isDataEven) {
|
| ︙ | ︙ | |||
888 889 890 891 892 893 894 |
(void) Tcl_ListObjAppendElement(NULL, listObj, objPtr);
}
if (listObj != NULL) {
Tcl_Obj **objs;
const char *bytes;
int len;
| | | 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 |
(void) Tcl_ListObjAppendElement(NULL, listObj, objPtr);
}
if (listObj != NULL) {
Tcl_Obj **objs;
const char *bytes;
int len;
TclListObjGetElements(NULL, listObj, &len, &objs);
objPtr = Tcl_ConcatObj(len, objs);
Tcl_DecrRefCount(listObj);
bytes = TclGetStringFromObj(objPtr, &len);
PushLiteral(envPtr, bytes, len);
Tcl_DecrRefCount(objPtr);
return TCL_OK;
}
|
| ︙ | ︙ | |||
2637 2638 2639 2640 2641 2642 2643 |
*/
int
TclCompileLmapCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
| | | | 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 |
*/
int
TclCompileLmapCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to the definition of the command
* being compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
return CompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr,
TCL_EACH_COLLECT);
}
/*
|
| ︙ | ︙ | |||
2699 2700 2701 2702 2703 2704 2705 |
numWords = parsePtr->numWords;
if ((numWords < 4) || (numWords%2 != 0)) {
return TCL_ERROR;
}
/*
| | | 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 |
numWords = parsePtr->numWords;
if ((numWords < 4) || (numWords%2 != 0)) {
return TCL_ERROR;
}
/*
* Bail out if the body requires substitutions in order to ensure correct
* behaviour. [Bug 219166]
*/
for (i = 0, tokenPtr = parsePtr->tokenPtr; i < numWords-1; i++) {
tokenPtr = TokenAfter(tokenPtr);
}
bodyTokenPtr = tokenPtr;
|
| ︙ | ︙ | |||
2746 2747 2748 2749 2750 2751 2752 | /* * If the variable list is empty, we can enter an infinite loop when * the interpreted version would not. Take care to ensure this does * not happen. [Bug 1671138] */ if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) || | | | 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 |
/*
* If the variable list is empty, we can enter an infinite loop when
* the interpreted version would not. Take care to ensure this does
* not happen. [Bug 1671138]
*/
if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) ||
TCL_OK != TclListObjLength(NULL, varListObj, &numVars) ||
numVars == 0) {
code = TCL_ERROR;
goto done;
}
varListPtr = (ForeachVarList *)ckalloc(offsetof(ForeachVarList, varIndexes)
+ numVars * sizeof(int));
|
| ︙ | ︙ |
Changes to generic/tclCompCmdsSZ.c.
| ︙ | ︙ | |||
501 502 503 504 505 506 507 |
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
static const char *const isClasses[] = {
"alnum", "alpha", "ascii", "control",
| | | | | | | | | | | | 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 |
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
static const char *const isClasses[] = {
"alnum", "alpha", "ascii", "control",
"boolean", "dict", "digit", "double",
"entier", "false", "graph", "integer",
"list", "lower", "print", "punct",
"space", "true", "upper", "unicode",
"wideinteger", "wordchar", "xdigit", NULL
};
enum isClassesEnum {
STR_IS_ALNUM, STR_IS_ALPHA, STR_IS_ASCII, STR_IS_CONTROL,
STR_IS_BOOL, STR_IS_DICT, STR_IS_DIGIT, STR_IS_DOUBLE,
STR_IS_ENTIER, STR_IS_FALSE, STR_IS_GRAPH, STR_IS_INT,
STR_IS_LIST, STR_IS_LOWER, STR_IS_PRINT, STR_IS_PUNCT,
STR_IS_SPACE, STR_IS_TRUE, STR_IS_UPPER, STR_IS_UNICODE,
STR_IS_WIDE, STR_IS_WORD, STR_IS_XDIGIT
};
int t, range, allowEmpty = 0, end;
InstStringClassType strClassType;
Tcl_Obj *isClass;
if (parsePtr->numWords < 3 || parsePtr->numWords > 6) {
return TCL_ERROR;
|
| ︙ | ︙ | |||
605 606 607 608 609 610 611 612 613 614 615 616 617 618 |
goto compileStrClass;
case STR_IS_SPACE:
strClassType = STR_CLASS_SPACE;
goto compileStrClass;
case STR_IS_UPPER:
strClassType = STR_CLASS_UPPER;
goto compileStrClass;
case STR_IS_WORD:
strClassType = STR_CLASS_WORD;
goto compileStrClass;
case STR_IS_XDIGIT:
strClassType = STR_CLASS_XDIGIT;
compileStrClass:
if (allowEmpty) {
| > > > | 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 |
goto compileStrClass;
case STR_IS_SPACE:
strClassType = STR_CLASS_SPACE;
goto compileStrClass;
case STR_IS_UPPER:
strClassType = STR_CLASS_UPPER;
goto compileStrClass;
case STR_IS_UNICODE:
strClassType = STR_CLASS_UNICODE;
goto compileStrClass;
case STR_IS_WORD:
strClassType = STR_CLASS_WORD;
goto compileStrClass;
case STR_IS_XDIGIT:
strClassType = STR_CLASS_XDIGIT;
compileStrClass:
if (allowEmpty) {
|
| ︙ | ︙ | |||
931 932 933 934 935 936 937 |
mapTokenPtr = TokenAfter(parsePtr->tokenPtr);
stringTokenPtr = TokenAfter(mapTokenPtr);
TclNewObj(mapObj);
Tcl_IncrRefCount(mapObj);
if (!TclWordKnownAtCompileTime(mapTokenPtr, mapObj)) {
Tcl_DecrRefCount(mapObj);
return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
| | | 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 |
mapTokenPtr = TokenAfter(parsePtr->tokenPtr);
stringTokenPtr = TokenAfter(mapTokenPtr);
TclNewObj(mapObj);
Tcl_IncrRefCount(mapObj);
if (!TclWordKnownAtCompileTime(mapTokenPtr, mapObj)) {
Tcl_DecrRefCount(mapObj);
return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
} else if (TclListObjGetElements(NULL, mapObj, &len, &objv) != TCL_OK) {
Tcl_DecrRefCount(mapObj);
return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
} else if (len != 2) {
Tcl_DecrRefCount(mapObj);
return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
|
| ︙ | ︙ | |||
1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 |
{"lower", Tcl_UniCharIsLower},
{"print", Tcl_UniCharIsPrint},
{"punct", Tcl_UniCharIsPunct},
{"space", Tcl_UniCharIsSpace},
{"upper", Tcl_UniCharIsUpper},
{"word", Tcl_UniCharIsWordChar},
{"xdigit", UniCharIsHexDigit},
{"", NULL}
};
/*
*----------------------------------------------------------------------
*
* TclCompileSubstCmd --
| > | 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 |
{"lower", Tcl_UniCharIsLower},
{"print", Tcl_UniCharIsPrint},
{"punct", Tcl_UniCharIsPunct},
{"space", Tcl_UniCharIsSpace},
{"upper", Tcl_UniCharIsUpper},
{"word", Tcl_UniCharIsWordChar},
{"xdigit", UniCharIsHexDigit},
{"unicode", Tcl_UniCharIsUnicode},
{"", NULL}
};
/*
*----------------------------------------------------------------------
*
* TclCompileSubstCmd --
|
| ︙ | ︙ | |||
2723 2724 2725 2726 2727 2728 2729 |
if (!codeKnown) {
CompileWord(envPtr, codeToken, interp, 1);
PUSH( "-errorcode");
}
CompileWord(envPtr, msgToken, interp, 2);
codeIsList = codeKnown && (TCL_OK ==
| | | 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 |
if (!codeKnown) {
CompileWord(envPtr, codeToken, interp, 1);
PUSH( "-errorcode");
}
CompileWord(envPtr, msgToken, interp, 2);
codeIsList = codeKnown && (TCL_OK ==
TclListObjLength(interp, objPtr, &len));
codeIsValid = codeIsList && (len != 0);
if (codeIsValid) {
Tcl_Obj *errPtr, *dictPtr;
TclNewLiteralStringObj(errPtr, "-errorcode");
TclNewObj(dictPtr);
|
| ︙ | ︙ | |||
2856 2857 2858 2859 2860 2861 2862 | */ matchCodes[i] = TCL_ERROR; tokenPtr = TokenAfter(tokenPtr); TclNewObj(tmpObj); Tcl_IncrRefCount(tmpObj); if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj) | | | 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 |
*/
matchCodes[i] = TCL_ERROR;
tokenPtr = TokenAfter(tokenPtr);
TclNewObj(tmpObj);
Tcl_IncrRefCount(tmpObj);
if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)
|| TclListObjLength(NULL, tmpObj, &objc) != TCL_OK
|| (objc == 0)) {
TclDecrRefCount(tmpObj);
goto failedToCompile;
}
Tcl_ListObjReplace(NULL, tmpObj, 0, 0, 0, NULL);
matchClauses[i] = tmpObj;
} else if (tokenPtr[1].size == 2
|
| ︙ | ︙ | |||
2899 2900 2901 2902 2903 2904 2905 |
tokenPtr = TokenAfter(tokenPtr);
TclNewObj(tmpObj);
Tcl_IncrRefCount(tmpObj);
if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
TclDecrRefCount(tmpObj);
goto failedToCompile;
}
| | | 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 |
tokenPtr = TokenAfter(tokenPtr);
TclNewObj(tmpObj);
Tcl_IncrRefCount(tmpObj);
if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
TclDecrRefCount(tmpObj);
goto failedToCompile;
}
if (TclListObjGetElements(NULL, tmpObj, &objc, &objv) != TCL_OK
|| (objc > 2)) {
TclDecrRefCount(tmpObj);
goto failedToCompile;
}
if (objc > 0) {
int len;
const char *varname = TclGetStringFromObj(objv[0], &len);
|
| ︙ | ︙ | |||
3110 3111 3112 3113 3114 3115 3116 |
sprintf(buf, "%d", matchCodes[i]);
OP( DUP);
PushLiteral(envPtr, buf, strlen(buf));
OP( EQ);
JUMP4( JUMP_FALSE, notCodeJumpSource);
if (matchClauses[i]) {
const char *p;
| | | 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 |
sprintf(buf, "%d", matchCodes[i]);
OP( DUP);
PushLiteral(envPtr, buf, strlen(buf));
OP( EQ);
JUMP4( JUMP_FALSE, notCodeJumpSource);
if (matchClauses[i]) {
const char *p;
TclListObjLength(NULL, matchClauses[i], &len);
/*
* Match the errorcode according to try/trap rules.
*/
LOAD( optionsVar);
PUSH( "-errorcode");
|
| ︙ | ︙ | |||
3321 3322 3323 3324 3325 3326 3327 |
sprintf(buf, "%d", matchCodes[i]);
OP( DUP);
PushLiteral(envPtr, buf, strlen(buf));
OP( EQ);
JUMP4( JUMP_FALSE, notCodeJumpSource);
if (matchClauses[i]) {
| | | 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 |
sprintf(buf, "%d", matchCodes[i]);
OP( DUP);
PushLiteral(envPtr, buf, strlen(buf));
OP( EQ);
JUMP4( JUMP_FALSE, notCodeJumpSource);
if (matchClauses[i]) {
TclListObjLength(NULL, matchClauses[i], &len);
/*
* Match the errorcode according to try/trap rules.
*/
LOAD( optionsVar);
PUSH( "-errorcode");
|
| ︙ | ︙ |
Changes to generic/tclCompExpr.c.
| ︙ | ︙ | |||
2105 2106 2107 2108 2109 2110 2111 | /* * 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] */ | | | 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 |
/*
* 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.
|
| ︙ | ︙ | |||
2516 2517 2518 2519 2520 2521 2522 | * lePtr->objPtr = literal; * Tcl_IncrRefCount(literal); * Tcl_DecrRefCount(objPtr); * * However, the design of the "global" and "local" * LiteralTable does not permit the value of lePtr->objPtr * to change. So rather than replace lePtr->objPtr, we do | | | | | 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 |
* lePtr->objPtr = literal;
* Tcl_IncrRefCount(literal);
* Tcl_DecrRefCount(objPtr);
*
* However, the design of the "global" and "local"
* LiteralTable does not permit the value of lePtr->objPtr
* to change. So rather than replace lePtr->objPtr, we do
* surgery to transfer our desired internalrep into it.
*/
objPtr->typePtr = literal->typePtr;
objPtr->internalRep = literal->internalRep;
literal->typePtr = NULL;
}
TclEmitPush(idx, envPtr);
} else {
/*
* When optimize==0, we know the expression is a one-off and
* there's nothing to be gained from sharing literals when
* they won't live long, and the copies we have already have
* an appropriate internalrep. In this case, skip literal
* registration that would enable sharing, and use the routine
* that preserves internalreps.
*/
TclEmitPush(TclAddLiteralObj(envPtr, literal, NULL), envPtr);
}
(*litObjvPtr)++;
break;
}
|
| ︙ | ︙ | |||
2568 2569 2570 2571 2572 2573 2574 |
= Tcl_GetStringFromObj(objPtr, &numBytes);
idx = TclRegisterLiteral(envPtr, bytes, numBytes, 0);
tableValue = TclFetchLiteral(envPtr, idx);
if ((tableValue->typePtr == NULL) &&
(objPtr->typePtr != NULL)) {
/*
| | | 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 |
= Tcl_GetStringFromObj(objPtr, &numBytes);
idx = TclRegisterLiteral(envPtr, bytes, numBytes, 0);
tableValue = TclFetchLiteral(envPtr, idx);
if ((tableValue->typePtr == NULL) &&
(objPtr->typePtr != NULL)) {
/*
* Same internalrep surgery as for OT_LITERAL.
*/
tableValue->typePtr = objPtr->typePtr;
tableValue->internalRep = objPtr->internalRep;
objPtr->typePtr = NULL;
}
} else {
|
| ︙ | ︙ |
Changes to generic/tclCompile.c.
| ︙ | ︙ | |||
713 714 715 716 717 718 719 | static void EnterCmdWordData(ExtCmdLoc *eclPtr, int srcOffset, Tcl_Token *tokenPtr, const char *cmd, int numWords, int line, int *clNext, int **lines, CompileEnv *envPtr); static void ReleaseCmdWordData(ExtCmdLoc *eclPtr); /* | > | < | | | 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 |
static void EnterCmdWordData(ExtCmdLoc *eclPtr, int srcOffset,
Tcl_Token *tokenPtr, const char *cmd,
int numWords, int line, int *clNext, int **lines,
CompileEnv *envPtr);
static void ReleaseCmdWordData(ExtCmdLoc *eclPtr);
/*
* tclByteCodeType provides the standard type management procedures for the
* bytecode type.
*/
const Tcl_ObjType tclByteCodeType = {
"bytecode", /* name */
FreeByteCodeInternalRep, /* freeIntRepProc */
DupByteCodeInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
SetByteCodeFromAny /* setFromAnyProc */
};
/*
* subtCodeType provides the standard type managemnt procedures for the
* substcode type, which represents substiution within a Tcl value.
*/
static const Tcl_ObjType substCodeType = {
"substcode", /* name */
FreeSubstCodeInternalRep, /* freeIntRepProc */
DupByteCodeInternalRep, /* dupIntRepProc - shared with bytecode */
NULL, /* updateStringProc */
|
| ︙ | ︙ | |||
752 753 754 755 756 757 758 | /* *---------------------------------------------------------------------- * * TclSetByteCodeFromAny -- * * Part of the bytecode Tcl object type implementation. Attempts to | < | | | | | < | 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 | /* *---------------------------------------------------------------------- * * TclSetByteCodeFromAny -- * * Part of the bytecode Tcl object type implementation. Attempts to * compile the string representation of the objPtr into bytecode. Accepts * a hook routine that is invoked to perform any needed post-processing on * the compilation results before generating byte codes. interp is the * compilation context and may not be NULL. * * Results: * A standard Tcl object result. If an error occurs during compilation, an * error message is left in the interpreter's result. * * Side effects: * Frees the old internal representation. If no error occurs, then the * compiled code is stored as "objPtr"s bytecode representation. Also, if * debugging, initializes the "tcl_traceCompile" Tcl variable used to * trace compilations. * |
| ︙ | ︙ | |||
803 804 805 806 807 808 809 |
}
#endif
stringPtr = TclGetString(objPtr);
length = objPtr->length;
/*
| | > | < | | < | | | | | | 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 |
}
#endif
stringPtr = TclGetString(objPtr);
length = objPtr->length;
/*
* TIP #280: Pick up the CmdFrame in which the BC compiler was invoked, and
* use to initialize the tracking in the compiler. This information was
* stored by TclCompEvalObj and ProcCompileProc.
*/
TclInitCompileEnv(interp, &compEnv, stringPtr, length,
iPtr->invokeCmdFramePtr, iPtr->invokeWord);
/*
* Make available to the compilation environment any data about invisible
* continuation lines for the script.
*
* It is not clear if the script Tcl_Obj* can be free'd while the compiler
* is using it, leading to the release of the associated ContLineLoc
* structure as well. To ensure that the latter doesn't happen set a lock
* on it, which is released in TclFreeCompileEnv(). The "lineCLPtr"
* hashtable tclObj.c.
*/
clLocPtr = TclContinuationsGet(objPtr);
if (clLocPtr) {
compEnv.clNext = &clLocPtr->loc[0];
}
TclCompileScript(interp, stringPtr, length, &compEnv);
/*
* Compilation succeeded. Add a "done" instruction at the end.
*/
TclEmitOpcode(INST_DONE, &compEnv);
/*
* Check for optimizations!
*
* If the generated code is free of most hazards, recompile with generation
* of INST_START_CMD disabled to produce code that more compact in many
* cases, and also sometimes more performant.
*/
if (Tcl_GetParent(interp) == NULL &&
!Tcl_LimitTypeEnabled(interp, TCL_LIMIT_COMMANDS|TCL_LIMIT_TIME)
&& IsCompactibleCompileEnv(&compEnv)) {
TclFreeCompileEnv(&compEnv);
iPtr->compiledProcPtr = procPtr;
|
| ︙ | ︙ | |||
871 872 873 874 875 876 877 |
*/
if (iPtr->extra.optimizer) {
(iPtr->extra.optimizer)(&compEnv);
}
/*
| | | | 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 |
*/
if (iPtr->extra.optimizer) {
(iPtr->extra.optimizer)(&compEnv);
}
/*
* Invoke the compilation hook procedure if there is one.
*/
if (hookProc) {
result = hookProc(interp, &compEnv, clientData);
}
/*
* Change the object into a ByteCode object. Ownership of the literal
* objects and aux data items passes to the ByteCode object.
*/
#ifdef TCL_COMPILE_DEBUG
TclVerifyLocalLiteralTable(&compEnv);
#endif /*TCL_COMPILE_DEBUG*/
if (result == TCL_OK) {
|
| ︙ | ︙ | |||
911 912 913 914 915 916 917 | * SetByteCodeFromAny -- * * Part of the bytecode Tcl object type implementation. Attempts to * generate an byte code internal form for the Tcl object "objPtr" by * compiling its string representation. * * Results: | | | | | | | | | | 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 |
* SetByteCodeFromAny --
*
* Part of the bytecode Tcl object type implementation. Attempts to
* generate an byte code internal form for the Tcl object "objPtr" by
* compiling its string representation.
*
* Results:
* A standard Tcl object result. If an error occurs during compilation and
* "interp" is not null, an error message is left in the interpreter's
* result.
*
* Side effects:
* Frees the old internal representation. If no error occurs then the
* compiled code is stored as "objPtr"s bytecode representation. Also, if
* debugging, initializes the "tcl_traceCompile" Tcl variable used to
* trace compilations.
*
*----------------------------------------------------------------------
*/
static int
SetByteCodeFromAny(
Tcl_Interp *interp, /* The interpreter for which the code is being
* compiled. Must not be NULL. */
Tcl_Obj *objPtr) /* The object to compile to bytecode */
{
if (interp == NULL) {
return TCL_ERROR;
}
return TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
}
/*
*----------------------------------------------------------------------
*
* DupByteCodeInternalRep --
*
* Part of the bytecode Tcl object type implementation. However, it does
* not copy the internal representation of a bytecode Tcl_Obj, instead
* assigning NULL to the type pointer of the new object. Code is compiled
* for the new object only if necessary.
*
* Results:
* None.
*
* Side effects:
* None.
*
|
| ︙ | ︙ | |||
976 977 978 979 980 981 982 | * associated with a bytecode object's internal representation unless its * code is actively being executed. * * Results: * None. * * Side effects: | | | | | | | | | | | 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 |
* associated with a bytecode object's internal representation unless its
* code is actively being executed.
*
* Results:
* None.
*
* Side effects:
* The bytecode object's internal rep is invalidated and its code is freed
* unless the code is actively being executed, in which case cleanup is
* delayed until the last execution of the code completes.
*
*----------------------------------------------------------------------
*/
static void
FreeByteCodeInternalRep(
Tcl_Obj *objPtr) /* Object whose internal rep to free. */
{
ByteCode *codePtr;
ByteCodeGetInternalRep(objPtr, &tclByteCodeType, codePtr);
assert(codePtr != NULL);
TclReleaseByteCode(codePtr);
}
/*
*----------------------------------------------------------------------
*
* TclReleaseByteCode --
*
* Does all the real work of freeing up a bytecode object's ByteCode
* structure. Called only when the structure's reference count
* is zero.
*
* Results:
* None.
*
* Side effects:
* Frees objPtr's bytecode internal representation and sets its type to
* NULL. Also releases its literals and frees its auxiliary data items.
*
*----------------------------------------------------------------------
*/
void
TclPreserveByteCode(
ByteCode *codePtr)
|
| ︙ | ︙ | |||
1085 1086 1087 1088 1089 1090 1091 |
statsPtr->lifetimeCount[log2]++;
}
#endif /* TCL_COMPILE_STATS */
/*
* A single heap object holds the ByteCode structure and its code, object,
* command location, and auxiliary data arrays. This means we only need to
| | | | | | | | 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 |
statsPtr->lifetimeCount[log2]++;
}
#endif /* TCL_COMPILE_STATS */
/*
* A single heap object holds the ByteCode structure and its code, object,
* command location, and auxiliary data arrays. This means we only need to
* 1) decrement the ref counts of each LiteralEntry in the literal array,
* 2) call the free procedures for the auxiliary data items, 3) free the
* localCache if it is unused, and finally 4) free the ByteCode
* structure's heap object.
*
* The case for TCL_BYTECODE_PRECOMPILED (precompiled ByteCodes, like
* those generated from tbcload) is special, as they doesn't make use of
* the global literal table. They instead maintain private references to
* their literals which must be decremented.
*
* In order to ensure proper and efficient cleanup of the literal array
* when it contains non-shared literals [Bug 983660], distinguish the case
* of an interpreter being deleted, which is signaled by interp == NULL.
* Also, as the interp deletion will remove the global literal table
* anyway, avoid the extra cost of updating it for each literal being
* released.
*/
if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
objArrayPtr = codePtr->objArrayPtr;
for (i = 0; i < numLitObjects; i++) {
|
| ︙ | ︙ | |||
1131 1132 1133 1134 1135 1136 1137 |
if (auxDataPtr->type->freeProc != NULL) {
auxDataPtr->type->freeProc(auxDataPtr->clientData);
}
auxDataPtr++;
}
/*
| | | | | 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 |
if (auxDataPtr->type->freeProc != NULL) {
auxDataPtr->type->freeProc(auxDataPtr->clientData);
}
auxDataPtr++;
}
/*
* TIP #280. Release the location data associated with this bytecode
* structure, if any. The associated interp may be gone already, and the
* data with it.
*
* See also tclBasic.c, DeleteInterpProc
*/
if (iPtr) {
Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr,
(char *) codePtr);
|
| ︙ | ︙ | |||
1161 1162 1163 1164 1165 1166 1167 | } /* * --------------------------------------------------------------------- * * IsCompactibleCompileEnv -- * | | | | | | | | | 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 |
}
/*
* ---------------------------------------------------------------------
*
* IsCompactibleCompileEnv --
*
* Determines whether some basic compaction optimizations may be applied
* to a piece of bytecode. Idempotent.
*
* ---------------------------------------------------------------------
*/
static int
IsCompactibleCompileEnv(
CompileEnv *envPtr)
{
unsigned char *pc;
int size;
/*
* Special: procedures in the '::tcl' namespace (or its children) are
* considered to be well-behaved, so compaction can be applied to them even
* if it would otherwise be invalid.
*/
if (envPtr->procPtr != NULL && envPtr->procPtr->cmdPtr != NULL
&& envPtr->procPtr->cmdPtr->nsPtr != NULL) {
Namespace *nsPtr = envPtr->procPtr->cmdPtr->nsPtr;
if (strcmp(nsPtr->fullName, "::tcl") == 0
|| strncmp(nsPtr->fullName, "::tcl::", 7) == 0) {
return 1;
}
}
/*
* Go through and ensure that no operation involved can cause a desired
* change of bytecode sequence during its execution. This comes down to
* ensuring that there are no mapped variables (due to traces) or calls to
* external commands (traces, [uplevel] trickery). This is actually a very
* conservative check. It turns down a lot of code that is OK in practice.
*/
for (pc = envPtr->codeStart ; pc < envPtr->codeNext ; pc += size) {
switch (*pc) {
/* Invokes */
case INST_INVOKE_STK1:
case INST_INVOKE_STK4:
|
| ︙ | ︙ | |||
1231 1232 1233 1234 1235 1236 1237 | } /* *---------------------------------------------------------------------- * * Tcl_SubstObj -- * | | | | 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 | } /* *---------------------------------------------------------------------- * * Tcl_SubstObj -- * * Performs substitutions on the given string as described in the user * documentation for "subst". * * Results: * A Tcl_Obj* containing the substituted string, or NULL to indicate that * an error occurred. * * Side effects: * See the user documentation. |
| ︙ | ︙ | |||
1264 1265 1266 1267 1268 1269 1270 | } /* *---------------------------------------------------------------------- * * Tcl_NRSubstObj -- * | | | | | 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 | } /* *---------------------------------------------------------------------- * * Tcl_NRSubstObj -- * * Adds substitution within the value of objPtr to the NR execution stack. * * Results: * TCL_OK. * * Side effects: * Compiles objPtr into bytecode that performs the substitutions as * governed by flags, adds a callback to the NR execution stack to execute * the bytecode and store the result in the interp. * *---------------------------------------------------------------------- */ int Tcl_NRSubstObj( |
| ︙ | ︙ | |||
1295 1296 1297 1298 1299 1300 1301 | } /* *---------------------------------------------------------------------- * * CompileSubstObj -- * | | | | | | | 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 |
}
/*
*----------------------------------------------------------------------
*
* CompileSubstObj --
*
* Compiles a value into bytecode that performs substitution within the
* value, as governed by flags.
*
* Results:
* A (ByteCode *) is pointing to the resulting ByteCode.
*
* Side effects:
* The Tcl_ObjType of objPtr is changed to the "substcode" type, and the
* ByteCode and governing flags value are kept in the internal rep for
* faster operations the next time CompileSubstObj is called on the same
* value.
*
*----------------------------------------------------------------------
*/
static ByteCode *
CompileSubstObj(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
int flags)
{
Interp *iPtr = (Interp *) interp;
ByteCode *codePtr = NULL;
ByteCodeGetInternalRep(objPtr, &substCodeType, codePtr);
if (codePtr != NULL) {
Namespace *nsPtr = iPtr->varFramePtr->nsPtr;
if (flags != PTR2INT(SubstFlags(objPtr))
|| ((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != nsPtr)
|| (codePtr->nsEpoch != nsPtr->resolverEpoch)
|| (codePtr->localCachePtr !=
iPtr->varFramePtr->localCachePtr)) {
Tcl_StoreInternalRep(objPtr, &substCodeType, NULL);
codePtr = NULL;
}
}
if (codePtr == NULL) {
CompileEnv compEnv;
int numBytes;
const char *bytes = TclGetStringFromObj(objPtr, &numBytes);
|
| ︙ | ︙ | |||
1369 1370 1371 1372 1373 1374 1375 | } /* *---------------------------------------------------------------------- * * FreeSubstCodeInternalRep -- * | | | | | | 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 |
}
/*
*----------------------------------------------------------------------
*
* FreeSubstCodeInternalRep --
*
* Part of the "substcode" Tcl object type implementation. Frees the
* storage associated with the substcode internal representation of a
* Tcl_Obj unless its code is actively being executed.
*
* Results:
* None.
*
* Side effects:
* The substcode object's internal rep is marked invalid and its code
* gets freed unless the code is actively being executed. In that case
* the cleanup is delayed until the last execution of the code completes.
*
*----------------------------------------------------------------------
*/
static void
FreeSubstCodeInternalRep(
Tcl_Obj *objPtr) /* Object whose internal rep to free. */
{
ByteCode *codePtr;
ByteCodeGetInternalRep(objPtr, &substCodeType, codePtr);
assert(codePtr != NULL);
TclReleaseByteCode(codePtr);
}
static void
ReleaseCmdWordData(
|
| ︙ | ︙ | |||
1625 1626 1627 1628 1629 1630 1631 | } /* *---------------------------------------------------------------------- * * TclFreeCompileEnv -- * | | | | 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 | } /* *---------------------------------------------------------------------- * * TclFreeCompileEnv -- * * Frees the storage allocated in a CompileEnv compilation environment * structure. * * Results: * None. * * Side effects: * Allocated storage in the CompileEnv structure is freed, although its * local literal table is not deleted and its literal objects are not * released. In addition, storage referenced by its auxiliary data items * is not freed. This is done so that, when compilation is successful, * "ownership" of these objects and aux data items is handed over to the * corresponding ByteCode structure. * *---------------------------------------------------------------------- |
| ︙ | ︙ | |||
1703 1704 1705 1706 1707 1708 1709 | } /* *---------------------------------------------------------------------- * * TclWordKnownAtCompileTime -- * | | > | | 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 | } /* *---------------------------------------------------------------------- * * TclWordKnownAtCompileTime -- * * Determines whether the value of a token is completely known at compile * time. * * Results: * True if the tokenPtr argument points to a word value that is * completely known at compile time. Generally, values that are known at * compile time can be compiled to their values, while values that cannot * be known until substitution at runtime must be compiled to bytecode * instructions that perform that substitution. For several commands, * whether or not arguments are known at compile time determine whether * it is worthwhile to compile at all. * |
| ︙ | ︙ | |||
1783 1784 1785 1786 1787 1788 1789 | } /* *---------------------------------------------------------------------- * * TclCompileScript -- * | | < > > | < | 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 | } /* *---------------------------------------------------------------------- * * TclCompileScript -- * * Compiles a Tcl script in a string. * * Results: * * A standard Tcl result. If an error occurs, an * error message is left in the interpreter's result. * * Side effects: * Adds instructions to envPtr to evaluate the script at runtime. * *---------------------------------------------------------------------- */ |
| ︙ | ︙ | |||
1925 1926 1927 1928 1929 1930 1931 |
}
TclEmitPush(objIdx, envPtr);
}
/*
* The stack depth during argument expansion can only be managed at
* runtime, as the number of elements in the expanded lists is not known
| | | | | | | | | | | | | 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 |
}
TclEmitPush(objIdx, envPtr);
}
/*
* The stack depth during argument expansion can only be managed at
* runtime, as the number of elements in the expanded lists is not known
* at compile time. Adjust the stack depth estimate here so that it is
* correct after the command with expanded arguments returns.
*
* The end effect of this command's invocation is that all the words of
* the command are popped from the stack and the result is pushed: The
* stack top changes by (1-wordIdx).
*
* The estimates are not correct while the command is being
* prepared and run, INST_EXPAND_STKTOP is not stack-neutral in general.
*/
TclEmitInvoke(envPtr, INST_INVOKE_EXPANDED, wordIdx);
TclCheckStackDepth(depth+1, envPtr);
}
static int
CompileCmdCompileProc(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
Command *cmdPtr,
CompileEnv *envPtr)
{
DefineLineInformation;
int unwind = 0, incrOffset = -1;
int depth = TclGetStackDepth(envPtr);
/*
* Emission of the INST_START_CMD instruction is controlled by the value of
* envPtr->atCmdStart:
*
* atCmdStart == 2 : Don't use the INST_START_CMD instruction.
* atCmdStart == 1 : INST_START_CMD was the last instruction emitted,
* : so no need to emit another. Instead
* : increment the number of cmds started at it, except
* : for the special case at the start of a script.
* atCmdStart == 0 : The last instruction was something else.
* : Emit INST_START_CMD here.
*/
switch (envPtr->atCmdStart) {
case 0:
unwind = tclInstructionTable[INST_START_CMD].numBytes;
TclEmitInstInt4(INST_START_CMD, 0, envPtr);
incrOffset = envPtr->codeNext - envPtr->codeStart;
|
| ︙ | ︙ | |||
1984 1985 1986 1987 1988 1989 1990 |
/* Nothing to do */
;
}
if (TCL_OK == TclAttemptCompileProc(interp, parsePtr, 1, cmdPtr, envPtr)) {
if (incrOffset >= 0) {
/*
| | | 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 |
/* Nothing to do */
;
}
if (TCL_OK == TclAttemptCompileProc(interp, parsePtr, 1, cmdPtr, envPtr)) {
if (incrOffset >= 0) {
/*
* Command compiled succesfully. Increment the number of
* commands that start at the currently active INST_START_CMD.
*/
unsigned char *incrPtr = envPtr->codeStart + incrOffset;
unsigned char *startPtr = incrPtr - 5;
TclIncrUInt4AtPtr(incrPtr, 1);
|
| ︙ | ︙ | |||
2053 2054 2055 2056 2057 2058 2059 |
TclNewObj(cmdObj);
envPtr->numCommands++;
EnterCmdStartData(envPtr, cmdIdx,
parsePtr->commandStart - envPtr->source, startCodeOffset);
/*
* TIP #280. Scan the words and compute the extended location information.
| | | 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 |
TclNewObj(cmdObj);
envPtr->numCommands++;
EnterCmdStartData(envPtr, cmdIdx,
parsePtr->commandStart - envPtr->source, startCodeOffset);
/*
* TIP #280. Scan the words and compute the extended location information.
* At first the map first contains full per-word line information for use by the
* compiler. This is later replaced by a reduced form which signals
* non-literal words, stored in 'wlines'.
*/
EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source,
parsePtr->tokenPtr, parsePtr->commandStart,
parsePtr->numWords, cmdLine,
|
| ︙ | ︙ | |||
2095 2096 2097 2098 2099 2100 2101 |
if (expand) {
/* We need to expand, but compileProc cannot. */
cmdPtr = NULL;
}
}
}
| | | 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 |
if (expand) {
/* We need to expand, but compileProc cannot. */
cmdPtr = NULL;
}
}
}
/* If cmdPtr != NULL, try to call cmdPtr->compileProc */
if (cmdPtr) {
code = CompileCmdCompileProc(interp, parsePtr, cmdPtr, envPtr);
}
if (code == TCL_ERROR) {
if (expand < 0) {
expand = ExpandRequested(parsePtr->tokenPtr, parsePtr->numWords);
|
| ︙ | ︙ | |||
2122 2123 2124 2125 2126 2127 2128 |
TclEmitOpcode(INST_POP, envPtr);
EnterCmdExtentData(envPtr, cmdIdx,
parsePtr->term - parsePtr->commandStart,
(envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
/*
| | | | 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 |
TclEmitOpcode(INST_POP, envPtr);
EnterCmdExtentData(envPtr, cmdIdx,
parsePtr->term - parsePtr->commandStart,
(envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
/*
* TIP #280: Free the full form of per-word line data and insert the
* reduced form now.
*/
envPtr->line = cmdLine;
envPtr->clNext = clNext;
ckfree(eclPtr->loc[wlineat].line);
ckfree(eclPtr->loc[wlineat].next);
eclPtr->loc[wlineat].line = wlines;
|
| ︙ | ︙ | |||
2161 2162 2163 2164 2165 2166 2167 |
Interp *iPtr = (Interp *) interp;
if (envPtr->iPtr == NULL) {
Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
}
/*
* Check depth to avoid overflow of the C execution stack by too many
| | | | | | 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 |
Interp *iPtr = (Interp *) interp;
if (envPtr->iPtr == NULL) {
Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
}
/*
* Check depth to avoid overflow of the C execution stack by too many
* nested calls of TclCompileScript, considering interp recursionlimit.
* Use factor 5/4 (1.25) to avoid being too mistaken when recognizing the
* limit during "mixed" evaluation and compilation process (nested
* eval+compile) and is good enough for default recursionlimit (1000).
*/
if (iPtr->numLevels / 5 > iPtr->maxNestingDepth / 4) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"too many nested compilations (infinite loop?)", -1));
Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL);
TclCompileSyntaxError(interp, envPtr);
return;
|
| ︙ | ︙ | |||
2307 2308 2309 2310 2311 2312 2313 | } /* *---------------------------------------------------------------------- * * TclCompileTokens -- * | | | | 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 | } /* *---------------------------------------------------------------------- * * TclCompileTokens -- * * Given an array of tokens parsed from a Tcl command, e.g. the tokens * that make up a word, emits instructions to evaluate the * tokens and concatenate their values to form a single result value on * the interpreter's runtime evaluation stack. * * Results: * The return value is a standard Tcl result. If an error occurs, an * error message is left in the interpreter's result. * |
| ︙ | ︙ | |||
2413 2414 2415 2416 2417 2418 2419 |
unsigned char *entryCodeNext = envPtr->codeNext;
#define NUM_STATIC_POS 20
int isLiteral, maxNumCL, numCL;
int *clPosition = NULL;
int depth = TclGetStackDepth(envPtr);
/*
| < | | < | | | < | > | | | 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 |
unsigned char *entryCodeNext = envPtr->codeNext;
#define NUM_STATIC_POS 20
int isLiteral, maxNumCL, numCL;
int *clPosition = NULL;
int depth = TclGetStackDepth(envPtr);
/*
* if this is actually a literal, handle continuation lines by
* preallocating a small table to store the locations of any continuation
* lines we find in this literal. The table is extended if needed.
*
* Note: In contrast with the analagous code in 'TclSubstTokens()' the
* 'adjust' variable seems unneeded here. The code which merges
* continuation line information of multiple words which concat'd at
* runtime also seems unneeded. Either that or I have not managed to find a
* test case for these two possibilities yet. It might be a difference
* between compile- versus run-time processing.
*/
numCL = 0;
maxNumCL = 0;
isLiteral = 1;
for (i=0 ; i < count; i++) {
if ((tokenPtr[i].type != TCL_TOKEN_TEXT)
|
| ︙ | ︙ | |||
2460 2461 2462 2463 2464 2465 2466 | case TCL_TOKEN_BS: length = TclParseBackslash(tokenPtr->start, tokenPtr->size, NULL, buffer); Tcl_DStringAppend(&textBuffer, buffer, length); /* | | | | | | | < | | | 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 |
case TCL_TOKEN_BS:
length = TclParseBackslash(tokenPtr->start, tokenPtr->size,
NULL, buffer);
Tcl_DStringAppend(&textBuffer, buffer, length);
/*
* If the identified backslash sequence is in a literal and
* represented a continuation line, compute and store its
* location (as char offset to the beginning of the _result_
* script). We may have to extend the table of locations.
*
* The continuation line information is relevant even if the word
* being processed is not a literal, as it can affect nested
* commands. See the branch below for TCL_TOKEN_COMMAND, where the
* adjustment being tracked here is taken into account. The good
* thing is a table of everything is not needed, just the number of
* lines to to add as correction.
*/
if ((length == 1) && (buffer[0] == ' ') &&
(tokenPtr->start[1] == '\n')) {
if (isLiteral) {
int clPos = Tcl_DStringLength(&textBuffer);
|
| ︙ | ︙ | |||
2597 2598 2599 2600 2601 2602 2603 | /* *---------------------------------------------------------------------- * * TclCompileCmdWord -- * * Given an array of parse tokens for a word containing one or more Tcl | | | | | | | | | | | | | < | | 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 |
/*
*----------------------------------------------------------------------
*
* TclCompileCmdWord --
*
* Given an array of parse tokens for a word containing one or more Tcl
* commands, emits inline instructions to execute them. In contrast with
* TclCompileTokens, a simple word such as a loop body enclosed in braces
* is not just pushed as a string, but is itself parsed into tokens and
* compiled.
*
* Results:
* A standard Tcl result. If an error occurs, an
* error message is left in the interpreter's result.
*
* Side effects:
* Instructions are added to envPtr to execute the tokens at runtime.
*
*----------------------------------------------------------------------
*/
void
TclCompileCmdWord(
Tcl_Interp *interp, /* Used for error and status reporting. */
Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens for
* a command word to compile inline. */
int count, /* Number of tokens to consider at tokenPtr.
* Must be at least 1. */
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
if ((count == 1) && (tokenPtr->type == TCL_TOKEN_TEXT)) {
/*
* The common case that there is a single text token. Compile it
* into an inline sequence of instructions.
*/
TclCompileScript(interp, tokenPtr->start, tokenPtr->size, envPtr);
} else {
/*
* Either there are multiple tokens, or the single token involves
* substitutions. Emit instructions to invoke the eval command
* procedure at runtime on the result of evaluating the tokens.
*/
TclCompileTokens(interp, tokenPtr, count, envPtr);
TclEmitInvoke(envPtr, INST_EVAL_STK);
}
}
/*
*----------------------------------------------------------------------
*
* TclCompileExprWords --
*
* Given an array of parse tokens representing one or more words that
* contain a Tcl expression, emits inline instructions to execute the
* expression. In contrast with TclCompileExpr, supports Tcl's two-level
* substitution semantics for an expression that appears as command words.
*
* Results:
* A standard Tcl result. If an error occurs, an
* error message is left in the interpreter's result.
*
* Side effects:
* Instructions are added to envPtr to execute the expression.
*
*----------------------------------------------------------------------
*/
|
| ︙ | ︙ | |||
2714 2715 2716 2717 2718 2719 2720 | } /* *---------------------------------------------------------------------- * * TclCompileNoOp -- * | | | | 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 | } /* *---------------------------------------------------------------------- * * TclCompileNoOp -- * * Compiles no-op's * * Results: * TCL_OK if completion was successful. * * Side effects: * Instructions are added to envPtr to execute a no-op at runtime. No * result is pushed onto the stack: the compiler has to take care of this * itself if the last compiled command is a NoOp. * *---------------------------------------------------------------------- |
| ︙ | ︙ | |||
2756 2757 2758 2759 2760 2761 2762 | } /* *---------------------------------------------------------------------- * * TclInitByteCodeObj -- * | | | | 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 | } /* *---------------------------------------------------------------------- * * TclInitByteCodeObj -- * * Creates a ByteCode structure and initializes it from a CompileEnv * compilation environment structure. The ByteCode structure is smaller * and contains just that information needed to execute the bytecode * instructions resulting from compiling a Tcl script. The resulting * structure is placed in the specified object. * * Results: * A newly-constructed ByteCode object is stored in the internal * representation of the objPtr. * * Side effects: * A single heap object is allocated to hold the new ByteCode structure * and its code, object, command location, and aux data arrays. Note that * "ownership" (i.e., the pointers to) the Tcl objects and aux data items * will be handed over to the new ByteCode structure from the CompileEnv |
| ︙ | ︙ | |||
2786 2787 2788 2789 2790 2791 2792 |
CompileEnv *envPtr)
{
int i;
for (i = 0; i < envPtr->literalArrayNext; i++) {
if (objPtr == TclFetchLiteral(envPtr, i)) {
/*
| | | | 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 |
CompileEnv *envPtr)
{
int i;
for (i = 0; i < envPtr->literalArrayNext; i++) {
if (objPtr == TclFetchLiteral(envPtr, i)) {
/*
* Prevent circular reference where the bytecode internalrep of
* a value contains a literal which is that same value.
* If this is allowed to happen, refcount decrements may not
* reach zero, and memory may leak. Bugs 467523, 3357771
*
* NOTE: [Bugs 3392070, 3389764] We make a copy based completely
* on the string value, and do not call Tcl_DuplicateObj() so we
* can be sure we do not have any lingering cycles hiding in
* the internalrep.
*/
int numBytes;
const char *bytes = TclGetStringFromObj(objPtr, &numBytes);
Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes);
Tcl_IncrRefCount(copyPtr);
TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, objPtr);
|
| ︙ | ︙ | |||
2965 2966 2967 2968 2969 2970 2971 |
codePtr = TclInitByteCode(envPtr);
/*
* Free the old internal rep then convert the object to a bytecode object
* by making its internal rep point to the just compiled ByteCode.
*/
| | | 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 |
codePtr = TclInitByteCode(envPtr);
/*
* Free the old internal rep then convert the object to a bytecode object
* by making its internal rep point to the just compiled ByteCode.
*/
ByteCodeSetInternalRep(objPtr, typePtr, codePtr);
return codePtr;
}
/*
*----------------------------------------------------------------------
*
* TclFindCompiledLocal --
|
| ︙ | ︙ | |||
3067 3068 3069 3070 3071 3072 3073 |
/*
* Create a new variable if appropriate.
*/
if (create || (name == NULL)) {
localVar = procPtr->numCompiledLocals;
| | | 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 |
/*
* Create a new variable if appropriate.
*/
if (create || (name == NULL)) {
localVar = procPtr->numCompiledLocals;
localPtr = (CompiledLocal *)ckalloc(offsetof(CompiledLocal, name) + 1U + nameBytes);
if (procPtr->firstLocalPtr == NULL) {
procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
} else {
procPtr->lastLocalPtr->nextPtr = localPtr;
procPtr->lastLocalPtr = localPtr;
}
localPtr->nextPtr = NULL;
|
| ︙ | ︙ | |||
3098 3099 3100 3101 3102 3103 3104 | } /* *---------------------------------------------------------------------- * * TclExpandCodeArray -- * | | < | | | | 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 |
}
/*
*----------------------------------------------------------------------
*
* TclExpandCodeArray --
*
* Uses malloc to allocate more storage for a CompileEnv's code array.
*
* Results:
* None.
*
* Side effects:
* The size of the bytecode array is doubled. If envPtr->mallocedCodeArray
* is non-zero the old array is freed. Byte codes are copied from the old
* array to the new one.
*
*----------------------------------------------------------------------
*/
void
TclExpandCodeArray(
void *envArgPtr) /* Points to the CompileEnv whose code array
|
| ︙ | ︙ | |||
3134 3135 3136 3137 3138 3139 3140 |
size_t currBytes = envPtr->codeNext - envPtr->codeStart;
size_t newBytes = 2 * (envPtr->codeEnd - envPtr->codeStart);
if (envPtr->mallocedCodeArray) {
envPtr->codeStart = (unsigned char *)ckrealloc(envPtr->codeStart, newBytes);
} else {
/*
| | | | 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 |
size_t currBytes = envPtr->codeNext - envPtr->codeStart;
size_t newBytes = 2 * (envPtr->codeEnd - envPtr->codeStart);
if (envPtr->mallocedCodeArray) {
envPtr->codeStart = (unsigned char *)ckrealloc(envPtr->codeStart, newBytes);
} else {
/*
* envPtr->exceptArrayPtr isn't a Tcl_Alloc'd pointer, so
* perform the equivalent of Tcl_Realloc directly.
*/
unsigned char *newPtr = (unsigned char *)ckalloc(newBytes);
memcpy(newPtr, envPtr->codeStart, currBytes);
envPtr->codeStart = newPtr;
envPtr->mallocedCodeArray = 1;
|
| ︙ | ︙ | |||
3451 3452 3453 3454 3455 3456 3457 | /* * --------------------------------------------------------------------- * * TclGetInnermostExceptionRange -- * * Returns the innermost exception range that covers the current code | | | 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 | /* * --------------------------------------------------------------------- * * TclGetInnermostExceptionRange -- * * Returns the innermost exception range that covers the current code * creation point, and optionally the stack depth that is expected at * that point. Relies on the fact that the range has a numCodeBytes = -1 * when it is being populated and that inner ranges come after outer * ranges. * * --------------------------------------------------------------------- */ |
| ︙ | ︙ | |||
3493 3494 3495 3496 3497 3498 3499 | /* * --------------------------------------------------------------------- * * TclAddLoopBreakFixup, TclAddLoopContinueFixup -- * * Adds a place that wants to break/continue to the loop exception range * tracking that will be fixed up once the loop can be finalized. These | | | 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 | /* * --------------------------------------------------------------------- * * TclAddLoopBreakFixup, TclAddLoopContinueFixup -- * * Adds a place that wants to break/continue to the loop exception range * tracking that will be fixed up once the loop can be finalized. These * functions generate an INST_JUMP4 that is fixed up during the * loop finalization. * * --------------------------------------------------------------------- */ void TclAddLoopBreakFixup( |
| ︙ | ︙ | |||
3557 3558 3559 3560 3561 3562 3563 | } /* * --------------------------------------------------------------------- * * TclCleanupStackForBreakContinue -- * | | | | 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 | } /* * --------------------------------------------------------------------- * * TclCleanupStackForBreakContinue -- * * Removes the extra elements from the auxiliary stack and the main stack. * How this is done depends on whether there are any elements on * the auxiliary stack to pop. * * --------------------------------------------------------------------- */ void TclCleanupStackForBreakContinue( |
| ︙ | ︙ | |||
3628 3629 3630 3631 3632 3633 3634 |
continue;
}
if (rangePtr->numCodeBytes != -1) {
continue;
}
/*
| | | | | 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 |
continue;
}
if (rangePtr->numCodeBytes != -1) {
continue;
}
/*
* Adequate condition: loops further out and exceptions further in
* don't actually need this information.
*/
if (auxPtr->expandTarget == envPtr->expandCount) {
auxPtr->expandTargetDepth = envPtr->currStackDepth;
}
}
/*
* One more expansion is now being processed on the auxiliary stack.
*/
envPtr->expandCount++;
}
/*
* ---------------------------------------------------------------------
*
* TclFinalizeLoopExceptionRange --
*
* Finalizes a loop exception range, binding the registered [break] and
* [continue] implementations so that they jump to the correct place.
* This must be called only after *all* the exception range
* target offsets have been set.
*
* ---------------------------------------------------------------------
*/
void
TclFinalizeLoopExceptionRange(
|
| ︙ | ︙ | |||
3722 3723 3724 3725 3726 3727 3728 | } /* *---------------------------------------------------------------------- * * TclCreateAuxData -- * | | | | < < < | < | 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 |
}
/*
*----------------------------------------------------------------------
*
* TclCreateAuxData --
*
* Allocates and initializes a new AuxData structure in a
* CompileEnv's array of compilation auxiliary data records. These
* AuxData records hold information created during compilation by
* CompileProcs and used by instructions during execution.
*
* Results:
* The index of the newly-created AuxData structure in the array.
*
* Side effects:
* If there is not enough room in the CompileEnv's AuxData array, its size
* is doubled.
*----------------------------------------------------------------------
*/
int
TclCreateAuxData(
ClientData clientData, /* The compilation auxiliary data to store in
* the new aux data record. */
|
| ︙ | ︙ | |||
3824 3825 3826 3827 3828 3829 3830 | } /* *---------------------------------------------------------------------- * * TclExpandJumpFixupArray -- * | | < | 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 | } /* *---------------------------------------------------------------------- * * TclExpandJumpFixupArray -- * * Uses malloc to allocate more storage for a jump fixup array. * * Results: * None. * * Side effects: * The jump fixup array in *fixupArrayPtr is reallocated to a new array * of double the size, and if fixupArrayPtr->mallocedArray is non-zero |
| ︙ | ︙ | |||
3904 3905 3906 3907 3908 3909 3910 | } /* *---------------------------------------------------------------------- * * TclEmitForwardJump -- * | | < < | > > > | 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 | } /* *---------------------------------------------------------------------- * * TclEmitForwardJump -- * * Emits a two-byte forward jump of kind "jumpType". Also initializes a * JumpFixup record with information about the jump. Since may later be * necessary to increase the size of the jump instruction to five bytes if * the jump target is more than, say, 127 bytes away. * * * Results: * None. * * Side effects: * The JumpFixup record pointed to by "jumpFixupPtr" is initialized with * information needed later if the jump is to be grown. Also, a two byte |
| ︙ | ︙ | |||
3962 3963 3964 3965 3966 3967 3968 | } /* *---------------------------------------------------------------------- * * TclFixupForwardJump -- * | | | | | | > | | | | 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 | } /* *---------------------------------------------------------------------- * * TclFixupForwardJump -- * * Modifies a previously-emitted forward jump to jump a specified number * of bytes, "jumpDist". If necessary, the size of the jump instruction is * increased from two to five bytes. This is done if the jump distance is * greater than "distThreshold" (normally 127 bytes). The jump is * described by a JumpFixup record previously initialized by * TclEmitForwardJump. * * Results: * 1 if the jump was grown and subsequent instructions had to be moved, or * 0 otherwsie. This allows callers to update any additional code offsets * they may hold. * * Side effects: * The jump may be grown and subsequent instructions moved. If this * happens, the code offsets for any commands and any ExceptionRange * records between the jump and the current code address will be updated * to reflect the moved code. Also, the bytecode instruction array in the * CompileEnv structure may be grown and reallocated. |
| ︙ | ︙ | |||
4014 4015 4016 4017 4018 4019 4020 |
TclUpdateInstInt1AtPc(INST_JUMP_FALSE1, jumpDist, jumpPc);
break;
}
return 0;
}
/*
| | | | | | 4004 4005 4006 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 |
TclUpdateInstInt1AtPc(INST_JUMP_FALSE1, jumpDist, jumpPc);
break;
}
return 0;
}
/*
* Increase the size of the jump instruction, and then move subsequent
* instructions down. Expanding the space for generated instructions means
* that code addresses might change. Be careful about updating any of
* these addresses held in variables.
*/
if ((envPtr->codeNext + 3) > envPtr->codeEnd) {
TclExpandCodeArray(envPtr);
}
jumpPc = envPtr->codeStart + jumpFixupPtr->codeOffset;
numBytes = envPtr->codeNext-jumpPc-2;
|
| ︙ | ︙ | |||
4101 4102 4103 4104 4105 4106 4107 | } /* *---------------------------------------------------------------------- * * TclEmitInvoke -- * | | | | 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 | } /* *---------------------------------------------------------------------- * * TclEmitInvoke -- * * Emits one of the invoke-related instructions, wrapping it if necessary * in code that ensures that any break or continue operation passing * through it gets the stack unwinding correct, converting it into an * internal jump if in an appropriate context. * * Results: * None * * Side effects: * Issues the jump with all correct stack management. May create another * loop exception range. Pointers to ExceptionRange and ExceptionAux * structures should not be held across this call. * *---------------------------------------------------------------------- */ void TclEmitInvoke( |
| ︙ | ︙ | |||
4169 4170 4171 4172 4173 4174 4175 |
arg2 = 0;
expandCount = 1;
break;
}
va_end(argList);
/*
| | | < | | | 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 |
arg2 = 0;
expandCount = 1;
break;
}
va_end(argList);
/*
* If the exceptions is for break or continue handle it with special
* handling exception range so the stack may be correctly unwound.
*
* These must be done separately since they can be different, especially
* for calls from inside a [for] increment clause.
*/
rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE,
&auxContinuePtr);
if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) {
auxContinuePtr = NULL;
} else if (auxContinuePtr->stackDepth == envPtr->currStackDepth-wordCount
|
| ︙ | ︙ | |||
4394 4395 4396 4397 4398 4399 4400 | } /* *---------------------------------------------------------------------- * * EncodeCmdLocMap -- * | | | | | | 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 4394 4395 4396 4397 4398 4399 4400 4401 4402 4403 4404 4405 4406 | } /* *---------------------------------------------------------------------- * * EncodeCmdLocMap -- * * Encodes the command location information for some compiled code into a * ByteCode structure. The encoded command location map is stored as * three-adjacent-byte sequences. * * Results: * A pointer to the first byte after the encoded command location * information. * * Side effects: * Stores encoded information into the block of memory headed by * codePtr. Also records pointers to the start of the four byte sequences * in fields in codePtr's ByteCode header structure. * *---------------------------------------------------------------------- */ static unsigned char * |
| ︙ | ︙ | |||
4518 4519 4520 4521 4522 4523 4524 | #ifdef TCL_COMPILE_STATS /* *---------------------------------------------------------------------- * * RecordByteCodeStats -- * | | | | | 4507 4508 4509 4510 4511 4512 4513 4514 4515 4516 4517 4518 4519 4520 4521 4522 4523 | #ifdef TCL_COMPILE_STATS /* *---------------------------------------------------------------------- * * RecordByteCodeStats -- * * Accumulates compilation-related statistics for each newly-compiled * ByteCode. Called by the TclInitByteCodeObj when Tcl is compiled with * the -DTCL_COMPILE_STATS flag * * Results: * None. * * Side effects: * Accumulates aggregate code-related statistics in the interpreter's * ByteCodeStats structure. Records statistics specific to a ByteCode in |
| ︙ | ︙ |
Changes to generic/tclCompile.h.
| ︙ | ︙ | |||
213 214 215 216 217 218 219 | * * The following definitions declare the types of procedures that are called * to duplicate or free this auxiliary data when the containing ByteCode * objects are duplicated and freed. Pointers to these procedures are kept in * the AuxData structure. */ | | | | | 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 | * * The following definitions declare the types of procedures that are called * to duplicate or free this auxiliary data when the containing ByteCode * objects are duplicated and freed. Pointers to these procedures are kept in * the AuxData structure. */ typedef void *(AuxDataDupProc) (void *clientData); typedef void (AuxDataFreeProc) (void *clientData); typedef void (AuxDataPrintProc)(void *clientData, Tcl_Obj *appendObj, struct ByteCode *codePtr, unsigned int pcOffset); /* * We define a separate AuxDataType struct to hold type-related information * for the AuxData structure. This separation makes it possible for clients * outside of the TCL core to manipulate (in a limited fashion!) AuxData; for |
| ︙ | ︙ | |||
511 512 513 514 515 516 517 |
* variables. */
#ifdef TCL_COMPILE_STATS
Tcl_Time createTime; /* Absolute time when the ByteCode was
* created. */
#endif /* TCL_COMPILE_STATS */
} ByteCode;
| | | | | | | | 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 |
* variables. */
#ifdef TCL_COMPILE_STATS
Tcl_Time createTime; /* Absolute time when the ByteCode was
* created. */
#endif /* TCL_COMPILE_STATS */
} ByteCode;
#define ByteCodeSetInternalRep(objPtr, typePtr, codePtr) \
do { \
Tcl_ObjInternalRep ir; \
ir.twoPtrValue.ptr1 = (codePtr); \
ir.twoPtrValue.ptr2 = NULL; \
Tcl_StoreInternalRep((objPtr), (typePtr), &ir); \
} while (0)
#define ByteCodeGetInternalRep(objPtr, typePtr, codePtr) \
do { \
const Tcl_ObjInternalRep *irPtr; \
irPtr = TclFetchInternalRep((objPtr), (typePtr)); \
(codePtr) = irPtr ? (ByteCode*)irPtr->twoPtrValue.ptr1 : NULL; \
} while (0)
/*
* Opcodes for the Tcl bytecode instructions. These must correspond to the
* entries in the table of instruction descriptions, tclInstructionTable, in
* tclCompile.c. Also, the order and number of the expression opcodes (e.g.,
|
| ︙ | ︙ | |||
918 919 920 921 922 923 924 |
STR_CLASS_PRINT, /* Unicode printing characters, including
* spaces. */
STR_CLASS_PUNCT, /* Unicode punctuation characters. */
STR_CLASS_SPACE, /* Unicode space characters. */
STR_CLASS_UPPER, /* Unicode upper-case alphabet characters. */
STR_CLASS_WORD, /* Unicode word (alphabetic, digit, connector
* punctuation) characters. */
| | > | 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 |
STR_CLASS_PRINT, /* Unicode printing characters, including
* spaces. */
STR_CLASS_PUNCT, /* Unicode punctuation characters. */
STR_CLASS_SPACE, /* Unicode space characters. */
STR_CLASS_UPPER, /* Unicode upper-case alphabet characters. */
STR_CLASS_WORD, /* Unicode word (alphabetic, digit, connector
* punctuation) characters. */
STR_CLASS_XDIGIT, /* Characters that can be used as digits in
* hexadecimal numbers ([0-9A-Fa-f]). */
STR_CLASS_UNICODE /* Unicode characters. */
} InstStringClassType;
typedef struct StringClassDesc {
char name[8]; /* Name of the class. */
int (*comparator)(int); /* Function to test if a single unicode
* character is a member of the class. */
} StringClassDesc;
|
| ︙ | ︙ | |||
1113 1114 1115 1116 1117 1118 1119 | MODULE_SCOPE void TclCompileSyntaxError(Tcl_Interp *interp, CompileEnv *envPtr); MODULE_SCOPE void TclCompileTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, CompileEnv *envPtr); MODULE_SCOPE void TclCompileVarSubst(Tcl_Interp *interp, Tcl_Token *tokenPtr, CompileEnv *envPtr); | | | 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 | MODULE_SCOPE void TclCompileSyntaxError(Tcl_Interp *interp, CompileEnv *envPtr); MODULE_SCOPE void TclCompileTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, CompileEnv *envPtr); MODULE_SCOPE void TclCompileVarSubst(Tcl_Interp *interp, Tcl_Token *tokenPtr, CompileEnv *envPtr); MODULE_SCOPE int TclCreateAuxData(void *clientData, const AuxDataType *typePtr, CompileEnv *envPtr); MODULE_SCOPE int TclCreateExceptRange(ExceptionRangeType type, CompileEnv *envPtr); MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, int size); MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, const char *bytes, int length, unsigned int hash, int *newPtr, Namespace *nsPtr, int flags, |
| ︙ | ︙ | |||
1187 1188 1189 1190 1191 1192 1193 | int flags, int *localIndexPtr, int *isScalarPtr); MODULE_SCOPE void TclPreserveByteCode(ByteCode *codePtr); MODULE_SCOPE void TclReleaseByteCode(ByteCode *codePtr); MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr); MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp, const char *name, Namespace *nsPtr); | | | | | | | | 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 |
int flags, int *localIndexPtr,
int *isScalarPtr);
MODULE_SCOPE void TclPreserveByteCode(ByteCode *codePtr);
MODULE_SCOPE void TclReleaseByteCode(ByteCode *codePtr);
MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp,
const char *name, Namespace *nsPtr);
MODULE_SCOPE int TclSingleOpCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE int TclSortingOpCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE int TclVariadicOpCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE int TclNoIdentOpCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
#ifdef TCL_COMPILE_DEBUG
MODULE_SCOPE void TclVerifyGlobalLiteralTable(Interp *iPtr);
MODULE_SCOPE void TclVerifyLocalLiteralTable(CompileEnv *envPtr);
#endif
MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
Tcl_Obj *valuePtr);
MODULE_SCOPE void TclLogCommandInfo(Tcl_Interp *interp,
const char *script, const char *command,
int length, const unsigned char *pc,
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, int 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.
*----------------------------------------------------------------
*/
/*
* Simplified form to access AuxData.
*
* void *TclFetchAuxData(CompileEng *envPtr, int index);
*/
#define TclFetchAuxData(envPtr, index) \
(envPtr)->auxDataArrayPtr[(index)].clientData
#define LITERAL_ON_HEAP 0x01
#define LITERAL_CMD_NAME 0x02
|
| ︙ | ︙ | |||
1490 1491 1492 1493 1494 1495 1496 | #ifndef __CHAR_UNSIGNED__ # define TclGetInt1AtPtr(p) ((int) *((char *) p)) #elif defined(HAVE_SIGNED_CHAR) # define TclGetInt1AtPtr(p) ((int) *((signed char *) p)) #else # define TclGetInt1AtPtr(p) \ | | | | | | | | | | | 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 |
#ifndef __CHAR_UNSIGNED__
# define TclGetInt1AtPtr(p) ((int) *((char *) p))
#elif defined(HAVE_SIGNED_CHAR)
# define TclGetInt1AtPtr(p) ((int) *((signed char *) p))
#else
# define TclGetInt1AtPtr(p) \
((int) ((*((char *) p)) | ((*(p) & 0200) ? (-256) : 0)))
#endif
#define TclGetInt4AtPtr(p) \
((int) ((TclGetUInt1AtPtr(p) << 24) | \
(*((p)+1) << 16) | \
(*((p)+2) << 8) | \
(*((p)+3))))
#define TclGetUInt1AtPtr(p) \
((unsigned int) *(p))
#define TclGetUInt4AtPtr(p) \
((unsigned int) ((*(p) << 24) | \
(*((p)+1) << 16) | \
(*((p)+2) << 8) | \
(*((p)+3))))
/*
* Macros used to compute the minimum and maximum of two integers. The ANSI C
* "prototypes" for these macros are:
*
* int TclMin(int i, int j);
* int TclMax(int i, int j);
|
| ︙ | ︙ | |||
1552 1553 1554 1555 1556 1557 1558 | * static void PushLiteral(CompileEnv *envPtr, * const char *string, int length); * static void PushStringLiteral(CompileEnv *envPtr, * const char *string); */ #define PushLiteral(envPtr, string, length) \ | | | | 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 |
* static void PushLiteral(CompileEnv *envPtr,
* const char *string, int length);
* static void PushStringLiteral(CompileEnv *envPtr,
* const char *string);
*/
#define PushLiteral(envPtr, string, length) \
TclEmitPush(TclRegisterLiteral((envPtr), (string), (length), 0), (envPtr))
#define PushStringLiteral(envPtr, string) \
PushLiteral((envPtr), (string), (int) (sizeof(string "") - 1))
/*
* Macro to advance to the next token; it is more mnemonic than the address
* arithmetic that it replaces. The ANSI C "prototype" for this macro is:
*
* static Tcl_Token * TokenAfter(Tcl_Token *tokenPtr);
*/
|
| ︙ | ︙ |
Changes to generic/tclDate.c.
| ︙ | ︙ | |||
181 182 183 184 185 186 187 | /* * The offset of tm_year of struct tm returned by localtime, gmtime, etc. * Posix requires 1900. */ #define TM_YEAR_BASE 1900 | | | | 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 |
/*
* The offset of tm_year of struct tm returned by localtime, gmtime, etc.
* Posix requires 1900.
*/
#define TM_YEAR_BASE 1900
#define HOUR(x) ((int) (60 * (x)))
#define SECSPERDAY (24L * 60L * 60L)
#define IsLeapYear(x) (((x) % 4 == 0) && ((x) % 100 != 0 || (x) % 400 == 0))
/*
* An entry in the lexical lookup table.
*/
typedef struct _TABLE {
const char *name;
|
| ︙ | ︙ |
Changes to generic/tclDecls.h.
| ︙ | ︙ | |||
120 121 122 123 124 125 126 |
int line);
/* 22 */
TCL_DEPRECATED("No longer in use, changed to macro")
Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, const char *file,
int line);
/* 23 */
EXTERN Tcl_Obj * Tcl_DbNewByteArrayObj(const unsigned char *bytes,
| | | 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 |
int line);
/* 22 */
TCL_DEPRECATED("No longer in use, changed to macro")
Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, const char *file,
int line);
/* 23 */
EXTERN Tcl_Obj * Tcl_DbNewByteArrayObj(const unsigned char *bytes,
int numBytes, const char *file, int line);
/* 24 */
EXTERN Tcl_Obj * Tcl_DbNewDoubleObj(double doubleValue,
const char *file, int line);
/* 25 */
EXTERN Tcl_Obj * Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
const char *file, int line);
/* 26 */
|
| ︙ | ︙ | |||
148 149 150 151 152 153 154 | EXTERN int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *boolPtr); /* 32 */ EXTERN int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr); /* 33 */ EXTERN unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, | | | 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 | EXTERN int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *boolPtr); /* 32 */ EXTERN int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr); /* 33 */ EXTERN unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, int *numBytesPtr); /* 34 */ EXTERN int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr); /* 35 */ EXTERN int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 36 */ |
| ︙ | ︙ | |||
201 202 203 204 205 206 207 |
Tcl_Obj *listPtr, int first, int count,
int objc, Tcl_Obj *const objv[]);
/* 49 */
TCL_DEPRECATED("No longer in use, changed to macro")
Tcl_Obj * Tcl_NewBooleanObj(int boolValue);
/* 50 */
EXTERN Tcl_Obj * Tcl_NewByteArrayObj(const unsigned char *bytes,
| | | | | 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 |
Tcl_Obj *listPtr, int first, int count,
int objc, Tcl_Obj *const objv[]);
/* 49 */
TCL_DEPRECATED("No longer in use, changed to macro")
Tcl_Obj * Tcl_NewBooleanObj(int boolValue);
/* 50 */
EXTERN Tcl_Obj * Tcl_NewByteArrayObj(const unsigned char *bytes,
int numBytes);
/* 51 */
EXTERN Tcl_Obj * Tcl_NewDoubleObj(double doubleValue);
/* 52 */
TCL_DEPRECATED("No longer in use, changed to macro")
Tcl_Obj * Tcl_NewIntObj(int intValue);
/* 53 */
EXTERN Tcl_Obj * Tcl_NewListObj(int objc, Tcl_Obj *const objv[]);
/* 54 */
TCL_DEPRECATED("No longer in use, changed to macro")
Tcl_Obj * Tcl_NewLongObj(long longValue);
/* 55 */
EXTERN Tcl_Obj * Tcl_NewObj(void);
/* 56 */
EXTERN Tcl_Obj * Tcl_NewStringObj(const char *bytes, int length);
/* 57 */
TCL_DEPRECATED("No longer in use, changed to macro")
void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue);
/* 58 */
EXTERN unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int numBytes);
/* 59 */
EXTERN void Tcl_SetByteArrayObj(Tcl_Obj *objPtr,
const unsigned char *bytes, int numBytes);
/* 60 */
EXTERN void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue);
/* 61 */
TCL_DEPRECATED("No longer in use, changed to macro")
void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue);
/* 62 */
EXTERN void Tcl_SetListObj(Tcl_Obj *objPtr, int objc,
|
| ︙ | ︙ | |||
467 468 469 470 471 472 473 | EXTERN int Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 142 */ EXTERN int Tcl_ExprString(Tcl_Interp *interp, const char *expr); /* 143 */ EXTERN void Tcl_Finalize(void); /* 144 */ | | | 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 |
EXTERN int Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
Tcl_Obj **resultPtrPtr);
/* 142 */
EXTERN int Tcl_ExprString(Tcl_Interp *interp, const char *expr);
/* 143 */
EXTERN void Tcl_Finalize(void);
/* 144 */
EXTERN const char * Tcl_FindExecutable(const char *argv0);
/* 145 */
EXTERN Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
Tcl_HashSearch *searchPtr);
/* 146 */
EXTERN int Tcl_Flush(Tcl_Channel chan);
/* 147 */
TCL_DEPRECATED("see TIP #559. Use Tcl_ResetResult")
|
| ︙ | ︙ | |||
706 707 708 709 710 711 712 | /* 227 */ EXTERN void Tcl_SetErrno(int err); /* 228 */ EXTERN void Tcl_SetErrorCode(Tcl_Interp *interp, ...); /* 229 */ EXTERN void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr); /* 230 */ | | | 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 | /* 227 */ EXTERN void Tcl_SetErrno(int err); /* 228 */ EXTERN void Tcl_SetErrorCode(Tcl_Interp *interp, ...); /* 229 */ EXTERN void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr); /* 230 */ EXTERN const char * Tcl_SetPanicProc( TCL_NORETURN1 Tcl_PanicProc *panicProc); /* 231 */ EXTERN int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth); /* 232 */ EXTERN void Tcl_SetResult(Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc); /* 233 */ |
| ︙ | ︙ | |||
745 746 747 748 749 750 751 | EXTERN int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 243 */ EXTERN void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr); /* 244 */ | | | | | 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 |
EXTERN int Tcl_SplitList(Tcl_Interp *interp,
const char *listStr, int *argcPtr,
const char ***argvPtr);
/* 243 */
EXTERN void Tcl_SplitPath(const char *path, int *argcPtr,
const char ***argvPtr);
/* 244 */
EXTERN void Tcl_StaticLibrary(Tcl_Interp *interp,
const char *prefix,
Tcl_LibraryInitProc *initProc,
Tcl_LibraryInitProc *safeInitProc);
/* 245 */
TCL_DEPRECATED("No longer in use, changed to macro")
int Tcl_StringMatch(const char *str, const char *pattern);
/* 246 */
TCL_DEPRECATED("")
int Tcl_TellOld(Tcl_Channel chan);
/* 247 */
|
| ︙ | ︙ | |||
941 942 943 944 945 946 947 | EXTERN const char * Tcl_GetEncodingName(Tcl_Encoding encoding); /* 303 */ EXTERN void Tcl_GetEncodingNames(Tcl_Interp *interp); /* 304 */ EXTERN int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, | | | 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 | EXTERN const char * Tcl_GetEncodingName(Tcl_Encoding encoding); /* 303 */ EXTERN void Tcl_GetEncodingNames(Tcl_Interp *interp); /* 304 */ EXTERN int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, void *indexPtr); /* 305 */ EXTERN void * Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, int size); /* 306 */ EXTERN Tcl_Obj * Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 307 */ |
| ︙ | ︙ | |||
1059 1060 1061 1062 1063 1064 1065 | /* 349 */ EXTERN int Tcl_UniCharIsSpace(int ch); /* 350 */ EXTERN int Tcl_UniCharIsUpper(int ch); /* 351 */ EXTERN int Tcl_UniCharIsWordChar(int ch); /* 352 */ | < | | 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 |
/* 349 */
EXTERN int Tcl_UniCharIsSpace(int ch);
/* 350 */
EXTERN int Tcl_UniCharIsUpper(int ch);
/* 351 */
EXTERN int Tcl_UniCharIsWordChar(int ch);
/* 352 */
EXTERN int Tcl_Char16Len(const unsigned short *uniStr);
/* 353 */
TCL_DEPRECATED("Use Tcl_UtfNcmp")
int Tcl_UniCharNcmp(const Tcl_UniChar *ucs,
const Tcl_UniChar *uct,
unsigned long numChars);
/* 354 */
EXTERN char * Tcl_Char16ToUtfDString(const unsigned short *uniStr,
|
| ︙ | ︙ | |||
1161 1162 1163 1164 1165 1166 1167 |
TCL_DEPRECATED("Use Tcl_AppendStringsToObj")
void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr,
const Tcl_UniChar *unicode, int length);
/* 385 */
EXTERN int Tcl_RegExpMatchObj(Tcl_Interp *interp,
Tcl_Obj *textObj, Tcl_Obj *patternObj);
/* 386 */
| | > | 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 |
TCL_DEPRECATED("Use Tcl_AppendStringsToObj")
void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr,
const Tcl_UniChar *unicode, int length);
/* 385 */
EXTERN int Tcl_RegExpMatchObj(Tcl_Interp *interp,
Tcl_Obj *textObj, Tcl_Obj *patternObj);
/* 386 */
EXTERN void Tcl_SetNotifier(
const Tcl_NotifierProcs *notifierProcPtr);
/* 387 */
EXTERN Tcl_Mutex * Tcl_GetAllocMutex(void);
/* 388 */
EXTERN int Tcl_GetChannelNames(Tcl_Interp *interp);
/* 389 */
EXTERN int Tcl_GetChannelNamesEx(Tcl_Interp *interp,
const char *pattern);
|
| ︙ | ︙ | |||
1334 1335 1336 1337 1338 1339 1340 | /* 442 */ EXTERN int Tcl_FSCreateDirectory(Tcl_Obj *pathPtr); /* 443 */ EXTERN int Tcl_FSDeleteFile(Tcl_Obj *pathPtr); /* 444 */ EXTERN int Tcl_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *sym1, const char *sym2, | | | | 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 | /* 442 */ EXTERN int Tcl_FSCreateDirectory(Tcl_Obj *pathPtr); /* 443 */ EXTERN int Tcl_FSDeleteFile(Tcl_Obj *pathPtr); /* 444 */ EXTERN int Tcl_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *sym1, const char *sym2, Tcl_LibraryInitProc **proc1Ptr, Tcl_LibraryInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); /* 445 */ EXTERN int Tcl_FSMatchInDirectory(Tcl_Interp *interp, Tcl_Obj *result, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types); /* 446 */ |
| ︙ | ︙ | |||
1882 1883 1884 1885 1886 1887 1888 | /* 634 */ EXTERN Tcl_Obj * TclZipfs_TclLibrary(void); /* 635 */ EXTERN int TclZipfs_MountBuffer(Tcl_Interp *interp, const char *mountPoint, unsigned char *data, size_t datalen, int copy); /* 636 */ | | | | | | 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 | /* 634 */ EXTERN Tcl_Obj * TclZipfs_TclLibrary(void); /* 635 */ EXTERN int TclZipfs_MountBuffer(Tcl_Interp *interp, const char *mountPoint, unsigned char *data, size_t datalen, int copy); /* 636 */ EXTERN void Tcl_FreeInternalRep(Tcl_Obj *objPtr); /* 637 */ EXTERN char * Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes, unsigned int numBytes); /* 638 */ EXTERN Tcl_ObjInternalRep * Tcl_FetchInternalRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 639 */ EXTERN void Tcl_StoreInternalRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjInternalRep *irPtr); /* 640 */ EXTERN int Tcl_HasStringRep(Tcl_Obj *objPtr); /* 641 */ EXTERN void Tcl_IncrRefCount(Tcl_Obj *objPtr); /* 642 */ EXTERN void Tcl_DecrRefCount(Tcl_Obj *objPtr); /* 643 */ |
| ︙ | ︙ | |||
1916 1917 1918 1919 1920 1921 1922 | EXTERN int Tcl_UtfToUniChar(const char *src, int *chPtr); /* 647 */ EXTERN char * Tcl_UniCharToUtfDString(const int *uniStr, int uniLength, Tcl_DString *dsPtr); /* 648 */ EXTERN int * Tcl_UtfToUniCharDString(const char *src, int length, Tcl_DString *dsPtr); | | > > | > > | > > > > > > > > > > > > > > > > | 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 |
EXTERN int Tcl_UtfToUniChar(const char *src, int *chPtr);
/* 647 */
EXTERN char * Tcl_UniCharToUtfDString(const int *uniStr,
int uniLength, Tcl_DString *dsPtr);
/* 648 */
EXTERN int * Tcl_UtfToUniCharDString(const char *src, int length,
Tcl_DString *dsPtr);
/* 649 */
EXTERN unsigned char * TclGetBytesFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, int *numBytesPtr);
/* 650 */
EXTERN unsigned char * Tcl_GetBytesFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, size_t *numBytesPtr);
/* 651 */
EXTERN char * TclGetStringFromObj(Tcl_Obj *objPtr,
size_t *lengthPtr);
/* 652 */
EXTERN Tcl_UniChar * TclGetUnicodeFromObj(Tcl_Obj *objPtr,
size_t *lengthPtr);
/* 653 */
EXTERN unsigned char * TclGetByteArrayFromObj(Tcl_Obj *objPtr,
size_t *numBytesPtr);
/* 654 */
EXTERN int Tcl_UtfCharComplete(const char *src, int length);
/* 655 */
EXTERN const char * Tcl_UtfNext(const char *src);
/* 656 */
EXTERN const char * Tcl_UtfPrev(const char *src, const char *start);
/* 657 */
EXTERN int Tcl_UniCharIsUnicode(int ch);
/* Slot 658 is reserved */
/* Slot 659 is reserved */
/* 660 */
EXTERN int Tcl_AsyncMarkFromSignal(Tcl_AsyncHandler async,
int sigNumber);
/* Slot 661 is reserved */
/* Slot 662 is reserved */
/* Slot 663 is reserved */
/* Slot 664 is reserved */
/* Slot 665 is reserved */
/* Slot 666 is reserved */
/* Slot 667 is reserved */
/* 668 */
EXTERN int Tcl_UniCharLen(const int *uniStr);
typedef struct {
const struct TclPlatStubs *tclPlatStubs;
const struct TclIntStubs *tclIntStubs;
const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;
|
| ︙ | ︙ | |||
1983 1984 1985 1986 1987 1988 1989 |
void (*tcl_AppendToObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 16 */
Tcl_Obj * (*tcl_ConcatObj) (int objc, Tcl_Obj *const objv[]); /* 17 */
int (*tcl_ConvertToType) (Tcl_Interp *interp, Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 18 */
void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 19 */
void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 20 */
int (*tcl_DbIsShared) (Tcl_Obj *objPtr, const char *file, int line); /* 21 */
TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_DbNewBooleanObj) (int boolValue, const char *file, int line); /* 22 */
| | | | | | | 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 |
void (*tcl_AppendToObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 16 */
Tcl_Obj * (*tcl_ConcatObj) (int objc, Tcl_Obj *const objv[]); /* 17 */
int (*tcl_ConvertToType) (Tcl_Interp *interp, Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 18 */
void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 19 */
void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 20 */
int (*tcl_DbIsShared) (Tcl_Obj *objPtr, const char *file, int line); /* 21 */
TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_DbNewBooleanObj) (int boolValue, const char *file, int line); /* 22 */
Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, int numBytes, const char *file, int line); /* 23 */
Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, const char *file, int line); /* 24 */
Tcl_Obj * (*tcl_DbNewListObj) (int objc, Tcl_Obj *const *objv, const char *file, int line); /* 25 */
TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_DbNewLongObj) (long longValue, const char *file, int line); /* 26 */
Tcl_Obj * (*tcl_DbNewObj) (const char *file, int line); /* 27 */
Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, int length, const char *file, int line); /* 28 */
Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */
void (*tclFreeObj) (Tcl_Obj *objPtr); /* 30 */
int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, int *boolPtr); /* 31 */
int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr); /* 32 */
unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *numBytesPtr); /* 33 */
int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */
int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */
TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */
int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */
int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */
int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */
CONST86 Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */
char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 41 */
void (*tcl_InvalidateStringRep) (Tcl_Obj *objPtr); /* 42 */
int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 43 */
int (*tcl_ListObjAppendElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 44 */
int (*tcl_ListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 45 */
int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 46 */
int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */
int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 48 */
TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewBooleanObj) (int boolValue); /* 49 */
Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, int numBytes); /* 50 */
Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */
TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */
Tcl_Obj * (*tcl_NewListObj) (int objc, Tcl_Obj *const objv[]); /* 53 */
TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewLongObj) (long longValue); /* 54 */
Tcl_Obj * (*tcl_NewObj) (void); /* 55 */
Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, int length); /* 56 */
TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int boolValue); /* 57 */
unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, int numBytes); /* 58 */
void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, int numBytes); /* 59 */
void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */
TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */
void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 62 */
TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue); /* 63 */
void (*tcl_SetObjLength) (Tcl_Obj *objPtr, int length); /* 64 */
void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 65 */
TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message); /* 66 */
|
| ︙ | ︙ | |||
2104 2105 2106 2107 2108 2109 2110 |
int (*tcl_ExprDouble) (Tcl_Interp *interp, const char *expr, double *ptr); /* 137 */
int (*tcl_ExprDoubleObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr); /* 138 */
int (*tcl_ExprLong) (Tcl_Interp *interp, const char *expr, long *ptr); /* 139 */
int (*tcl_ExprLongObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr); /* 140 */
int (*tcl_ExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 141 */
int (*tcl_ExprString) (Tcl_Interp *interp, const char *expr); /* 142 */
void (*tcl_Finalize) (void); /* 143 */
| | | 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 |
int (*tcl_ExprDouble) (Tcl_Interp *interp, const char *expr, double *ptr); /* 137 */
int (*tcl_ExprDoubleObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr); /* 138 */
int (*tcl_ExprLong) (Tcl_Interp *interp, const char *expr, long *ptr); /* 139 */
int (*tcl_ExprLongObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr); /* 140 */
int (*tcl_ExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 141 */
int (*tcl_ExprString) (Tcl_Interp *interp, const char *expr); /* 142 */
void (*tcl_Finalize) (void); /* 143 */
TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") const char * (*tcl_FindExecutable) (const char *argv0); /* 144 */
Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */
int (*tcl_Flush) (Tcl_Channel chan); /* 146 */
TCL_DEPRECATED_API("see TIP #559. Use Tcl_ResetResult") void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */
int (*tcl_GetAlias) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 148 */
int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */
Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */
|
| ︙ | ︙ | |||
2198 2199 2200 2201 2202 2203 2204 |
void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 223 */
void (*tcl_SetChannelBufferSize) (Tcl_Channel chan, int sz); /* 224 */
int (*tcl_SetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, const char *newValue); /* 225 */
int (*tcl_SetCommandInfo) (Tcl_Interp *interp, const char *cmdName, const Tcl_CmdInfo *infoPtr); /* 226 */
void (*tcl_SetErrno) (int err); /* 227 */
void (*tcl_SetErrorCode) (Tcl_Interp *interp, ...); /* 228 */
void (*tcl_SetMaxBlockTime) (const Tcl_Time *timePtr); /* 229 */
| | | | 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 |
void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 223 */
void (*tcl_SetChannelBufferSize) (Tcl_Channel chan, int sz); /* 224 */
int (*tcl_SetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, const char *newValue); /* 225 */
int (*tcl_SetCommandInfo) (Tcl_Interp *interp, const char *cmdName, const Tcl_CmdInfo *infoPtr); /* 226 */
void (*tcl_SetErrno) (int err); /* 227 */
void (*tcl_SetErrorCode) (Tcl_Interp *interp, ...); /* 228 */
void (*tcl_SetMaxBlockTime) (const Tcl_Time *timePtr); /* 229 */
TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") const char * (*tcl_SetPanicProc) (TCL_NORETURN1 Tcl_PanicProc *panicProc); /* 230 */
int (*tcl_SetRecursionLimit) (Tcl_Interp *interp, int depth); /* 231 */
void (*tcl_SetResult) (Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc); /* 232 */
int (*tcl_SetServiceMode) (int mode); /* 233 */
void (*tcl_SetObjErrorCode) (Tcl_Interp *interp, Tcl_Obj *errorObjPtr); /* 234 */
void (*tcl_SetObjResult) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 235 */
void (*tcl_SetStdChannel) (Tcl_Channel channel, int type); /* 236 */
TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */
const char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */
const char * (*tcl_SignalId) (int sig); /* 239 */
const char * (*tcl_SignalMsg) (int sig); /* 240 */
void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */
int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */
void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */
TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_StaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); /* 244 */
TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */
TCL_DEPRECATED_API("") int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */
TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */
int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */
char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */
int (*tcl_Ungets) (Tcl_Channel chan, const char *str, int len, int atHead); /* 250 */
void (*tcl_UnlinkVar) (Tcl_Interp *interp, const char *varName); /* 251 */
|
| ︙ | ︙ | |||
2272 2273 2274 2275 2276 2277 2278 |
void (*tcl_FinalizeThread) (void); /* 297 */
void (*tcl_FinalizeNotifier) (ClientData clientData); /* 298 */
void (*tcl_FreeEncoding) (Tcl_Encoding encoding); /* 299 */
Tcl_ThreadId (*tcl_GetCurrentThread) (void); /* 300 */
Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, const char *name); /* 301 */
const char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */
void (*tcl_GetEncodingNames) (Tcl_Interp *interp); /* 303 */
| | | 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 |
void (*tcl_FinalizeThread) (void); /* 297 */
void (*tcl_FinalizeNotifier) (ClientData clientData); /* 298 */
void (*tcl_FreeEncoding) (Tcl_Encoding encoding); /* 299 */
Tcl_ThreadId (*tcl_GetCurrentThread) (void); /* 300 */
Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, const char *name); /* 301 */
const char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */
void (*tcl_GetEncodingNames) (Tcl_Interp *interp); /* 303 */
int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, void *indexPtr); /* 304 */
void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, int size); /* 305 */
Tcl_Obj * (*tcl_GetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 306 */
ClientData (*tcl_InitNotifier) (void); /* 307 */
void (*tcl_MutexLock) (Tcl_Mutex *mutexPtr); /* 308 */
void (*tcl_MutexUnlock) (Tcl_Mutex *mutexPtr); /* 309 */
void (*tcl_ConditionNotify) (Tcl_Condition *condPtr); /* 310 */
void (*tcl_ConditionWait) (Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr); /* 311 */
|
| ︙ | ︙ | |||
2320 2321 2322 2323 2324 2325 2326 |
int (*tcl_UniCharIsAlnum) (int ch); /* 345 */
int (*tcl_UniCharIsAlpha) (int ch); /* 346 */
int (*tcl_UniCharIsDigit) (int ch); /* 347 */
int (*tcl_UniCharIsLower) (int ch); /* 348 */
int (*tcl_UniCharIsSpace) (int ch); /* 349 */
int (*tcl_UniCharIsUpper) (int ch); /* 350 */
int (*tcl_UniCharIsWordChar) (int ch); /* 351 */
| | | 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 |
int (*tcl_UniCharIsAlnum) (int ch); /* 345 */
int (*tcl_UniCharIsAlpha) (int ch); /* 346 */
int (*tcl_UniCharIsDigit) (int ch); /* 347 */
int (*tcl_UniCharIsLower) (int ch); /* 348 */
int (*tcl_UniCharIsSpace) (int ch); /* 349 */
int (*tcl_UniCharIsUpper) (int ch); /* 350 */
int (*tcl_UniCharIsWordChar) (int ch); /* 351 */
int (*tcl_Char16Len) (const unsigned short *uniStr); /* 352 */
TCL_DEPRECATED_API("Use Tcl_UtfNcmp") int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 353 */
char * (*tcl_Char16ToUtfDString) (const unsigned short *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */
unsigned short * (*tcl_UtfToChar16DString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */
Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */
TCL_DEPRECATED_API("Use Tcl_EvalTokensStandard") Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */
void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */
void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, int length); /* 359 */
|
| ︙ | ︙ | |||
2354 2355 2356 2357 2358 2359 2360 |
void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); /* 379 */
int (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */
int (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */
TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */
Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, int first, int last); /* 383 */
TCL_DEPRECATED_API("Use Tcl_AppendStringsToObj") void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length); /* 384 */
int (*tcl_RegExpMatchObj) (Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 385 */
| | | 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 |
void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); /* 379 */
int (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */
int (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */
TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */
Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, int first, int last); /* 383 */
TCL_DEPRECATED_API("Use Tcl_AppendStringsToObj") void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length); /* 384 */
int (*tcl_RegExpMatchObj) (Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 385 */
void (*tcl_SetNotifier) (const Tcl_NotifierProcs *notifierProcPtr); /* 386 */
Tcl_Mutex * (*tcl_GetAllocMutex) (void); /* 387 */
int (*tcl_GetChannelNames) (Tcl_Interp *interp); /* 388 */
int (*tcl_GetChannelNamesEx) (Tcl_Interp *interp, const char *pattern); /* 389 */
int (*tcl_ProcObjCmd) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 390 */
void (*tcl_ConditionFinalize) (Tcl_Condition *condPtr); /* 391 */
void (*tcl_MutexFinalize) (Tcl_Mutex *mutex); /* 392 */
int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, ClientData clientData, int stackSize, int flags); /* 393 */
|
| ︙ | ︙ | |||
2412 2413 2414 2415 2416 2417 2418 |
Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */
int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */
int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */
int (*tcl_FSCopyFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 440 */
int (*tcl_FSCopyDirectory) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 441 */
int (*tcl_FSCreateDirectory) (Tcl_Obj *pathPtr); /* 442 */
int (*tcl_FSDeleteFile) (Tcl_Obj *pathPtr); /* 443 */
| | | 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 |
Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */
int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */
int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */
int (*tcl_FSCopyFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 440 */
int (*tcl_FSCopyDirectory) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 441 */
int (*tcl_FSCreateDirectory) (Tcl_Obj *pathPtr); /* 442 */
int (*tcl_FSDeleteFile) (Tcl_Obj *pathPtr); /* 443 */
int (*tcl_FSLoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *sym1, const char *sym2, Tcl_LibraryInitProc **proc1Ptr, Tcl_LibraryInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); /* 444 */
int (*tcl_FSMatchInDirectory) (Tcl_Interp *interp, Tcl_Obj *result, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types); /* 445 */
Tcl_Obj * (*tcl_FSLink) (Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction); /* 446 */
int (*tcl_FSRemoveDirectory) (Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr); /* 447 */
int (*tcl_FSRenameFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 448 */
int (*tcl_FSLstat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 449 */
int (*tcl_FSUtime) (Tcl_Obj *pathPtr, struct utimbuf *tval); /* 450 */
int (*tcl_FSFileAttrsGet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 451 */
|
| ︙ | ︙ | |||
2604 2605 2606 2607 2608 2609 2610 |
int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */
int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *mountPoint, const char *zipname, const char *passwd); /* 632 */
int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *mountPoint); /* 633 */
Tcl_Obj * (*tclZipfs_TclLibrary) (void); /* 634 */
int (*tclZipfs_MountBuffer) (Tcl_Interp *interp, const char *mountPoint, unsigned char *data, size_t datalen, int copy); /* 635 */
| | | | | | | > > > > > > > > > > > > | 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 |
int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */
int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *mountPoint, const char *zipname, const char *passwd); /* 632 */
int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *mountPoint); /* 633 */
Tcl_Obj * (*tclZipfs_TclLibrary) (void); /* 634 */
int (*tclZipfs_MountBuffer) (Tcl_Interp *interp, const char *mountPoint, unsigned char *data, size_t datalen, int copy); /* 635 */
void (*tcl_FreeInternalRep) (Tcl_Obj *objPtr); /* 636 */
char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, unsigned int numBytes); /* 637 */
Tcl_ObjInternalRep * (*tcl_FetchInternalRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 638 */
void (*tcl_StoreInternalRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjInternalRep *irPtr); /* 639 */
int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */
void (*tcl_IncrRefCount) (Tcl_Obj *objPtr); /* 641 */
void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */
int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */
int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, int size); /* 644 */
int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); /* 645 */
int (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 646 */
char * (*tcl_UniCharToUtfDString) (const int *uniStr, int uniLength, Tcl_DString *dsPtr); /* 647 */
int * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 648 */
unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *numBytesPtr); /* 649 */
unsigned char * (*tcl_GetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, size_t *numBytesPtr); /* 650 */
char * (*tclGetStringFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 651 */
Tcl_UniChar * (*tclGetUnicodeFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 652 */
unsigned char * (*tclGetByteArrayFromObj) (Tcl_Obj *objPtr, size_t *numBytesPtr); /* 653 */
int (*tcl_UtfCharComplete) (const char *src, int length); /* 654 */
const char * (*tcl_UtfNext) (const char *src); /* 655 */
const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 656 */
int (*tcl_UniCharIsUnicode) (int ch); /* 657 */
void (*reserved658)(void);
void (*reserved659)(void);
int (*tcl_AsyncMarkFromSignal) (Tcl_AsyncHandler async, int sigNumber); /* 660 */
void (*reserved661)(void);
void (*reserved662)(void);
void (*reserved663)(void);
void (*reserved664)(void);
void (*reserved665)(void);
void (*reserved666)(void);
void (*reserved667)(void);
int (*tcl_UniCharLen) (const int *uniStr); /* 668 */
} TclStubs;
extern const TclStubs *tclStubsPtr;
#ifdef __cplusplus
}
#endif
|
| ︙ | ︙ | |||
3144 3145 3146 3147 3148 3149 3150 | (tclStubsPtr->tcl_SignalMsg) /* 240 */ #define Tcl_SourceRCFile \ (tclStubsPtr->tcl_SourceRCFile) /* 241 */ #define Tcl_SplitList \ (tclStubsPtr->tcl_SplitList) /* 242 */ #define Tcl_SplitPath \ (tclStubsPtr->tcl_SplitPath) /* 243 */ | | | | 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 | (tclStubsPtr->tcl_SignalMsg) /* 240 */ #define Tcl_SourceRCFile \ (tclStubsPtr->tcl_SourceRCFile) /* 241 */ #define Tcl_SplitList \ (tclStubsPtr->tcl_SplitList) /* 242 */ #define Tcl_SplitPath \ (tclStubsPtr->tcl_SplitPath) /* 243 */ #define Tcl_StaticLibrary \ (tclStubsPtr->tcl_StaticLibrary) /* 244 */ #define Tcl_StringMatch \ (tclStubsPtr->tcl_StringMatch) /* 245 */ #define Tcl_TellOld \ (tclStubsPtr->tcl_TellOld) /* 246 */ #define Tcl_TraceVar \ (tclStubsPtr->tcl_TraceVar) /* 247 */ #define Tcl_TraceVar2 \ |
| ︙ | ︙ | |||
3359 3360 3361 3362 3363 3364 3365 | (tclStubsPtr->tcl_UniCharIsLower) /* 348 */ #define Tcl_UniCharIsSpace \ (tclStubsPtr->tcl_UniCharIsSpace) /* 349 */ #define Tcl_UniCharIsUpper \ (tclStubsPtr->tcl_UniCharIsUpper) /* 350 */ #define Tcl_UniCharIsWordChar \ (tclStubsPtr->tcl_UniCharIsWordChar) /* 351 */ | | | | 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 | (tclStubsPtr->tcl_UniCharIsLower) /* 348 */ #define Tcl_UniCharIsSpace \ (tclStubsPtr->tcl_UniCharIsSpace) /* 349 */ #define Tcl_UniCharIsUpper \ (tclStubsPtr->tcl_UniCharIsUpper) /* 350 */ #define Tcl_UniCharIsWordChar \ (tclStubsPtr->tcl_UniCharIsWordChar) /* 351 */ #define Tcl_Char16Len \ (tclStubsPtr->tcl_Char16Len) /* 352 */ #define Tcl_UniCharNcmp \ (tclStubsPtr->tcl_UniCharNcmp) /* 353 */ #define Tcl_Char16ToUtfDString \ (tclStubsPtr->tcl_Char16ToUtfDString) /* 354 */ #define Tcl_UtfToChar16DString \ (tclStubsPtr->tcl_UtfToChar16DString) /* 355 */ #define Tcl_GetRegExpFromObj \ |
| ︙ | ︙ | |||
3927 3928 3929 3930 3931 3932 3933 | (tclStubsPtr->tclZipfs_Mount) /* 632 */ #define TclZipfs_Unmount \ (tclStubsPtr->tclZipfs_Unmount) /* 633 */ #define TclZipfs_TclLibrary \ (tclStubsPtr->tclZipfs_TclLibrary) /* 634 */ #define TclZipfs_MountBuffer \ (tclStubsPtr->tclZipfs_MountBuffer) /* 635 */ | | | | | | | > | > | > > > > > > > > > > > > > > > | > | > > > > > > > | 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037 4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 |
(tclStubsPtr->tclZipfs_Mount) /* 632 */
#define TclZipfs_Unmount \
(tclStubsPtr->tclZipfs_Unmount) /* 633 */
#define TclZipfs_TclLibrary \
(tclStubsPtr->tclZipfs_TclLibrary) /* 634 */
#define TclZipfs_MountBuffer \
(tclStubsPtr->tclZipfs_MountBuffer) /* 635 */
#define Tcl_FreeInternalRep \
(tclStubsPtr->tcl_FreeInternalRep) /* 636 */
#define Tcl_InitStringRep \
(tclStubsPtr->tcl_InitStringRep) /* 637 */
#define Tcl_FetchInternalRep \
(tclStubsPtr->tcl_FetchInternalRep) /* 638 */
#define Tcl_StoreInternalRep \
(tclStubsPtr->tcl_StoreInternalRep) /* 639 */
#define Tcl_HasStringRep \
(tclStubsPtr->tcl_HasStringRep) /* 640 */
#define Tcl_IncrRefCount \
(tclStubsPtr->tcl_IncrRefCount) /* 641 */
#define Tcl_DecrRefCount \
(tclStubsPtr->tcl_DecrRefCount) /* 642 */
#define Tcl_IsShared \
(tclStubsPtr->tcl_IsShared) /* 643 */
#define Tcl_LinkArray \
(tclStubsPtr->tcl_LinkArray) /* 644 */
#define Tcl_GetIntForIndex \
(tclStubsPtr->tcl_GetIntForIndex) /* 645 */
#define Tcl_UtfToUniChar \
(tclStubsPtr->tcl_UtfToUniChar) /* 646 */
#define Tcl_UniCharToUtfDString \
(tclStubsPtr->tcl_UniCharToUtfDString) /* 647 */
#define Tcl_UtfToUniCharDString \
(tclStubsPtr->tcl_UtfToUniCharDString) /* 648 */
#define TclGetBytesFromObj \
(tclStubsPtr->tclGetBytesFromObj) /* 649 */
#define Tcl_GetBytesFromObj \
(tclStubsPtr->tcl_GetBytesFromObj) /* 650 */
#define TclGetStringFromObj \
(tclStubsPtr->tclGetStringFromObj) /* 651 */
#define TclGetUnicodeFromObj \
(tclStubsPtr->tclGetUnicodeFromObj) /* 652 */
#define TclGetByteArrayFromObj \
(tclStubsPtr->tclGetByteArrayFromObj) /* 653 */
#define Tcl_UtfCharComplete \
(tclStubsPtr->tcl_UtfCharComplete) /* 654 */
#define Tcl_UtfNext \
(tclStubsPtr->tcl_UtfNext) /* 655 */
#define Tcl_UtfPrev \
(tclStubsPtr->tcl_UtfPrev) /* 656 */
#define Tcl_UniCharIsUnicode \
(tclStubsPtr->tcl_UniCharIsUnicode) /* 657 */
/* Slot 658 is reserved */
/* Slot 659 is reserved */
#define Tcl_AsyncMarkFromSignal \
(tclStubsPtr->tcl_AsyncMarkFromSignal) /* 660 */
/* Slot 661 is reserved */
/* Slot 662 is reserved */
/* Slot 663 is reserved */
/* Slot 664 is reserved */
/* Slot 665 is reserved */
/* Slot 666 is reserved */
/* Slot 667 is reserved */
#define Tcl_UniCharLen \
(tclStubsPtr->tcl_UniCharLen) /* 668 */
#endif /* defined(USE_TCL_STUBS) */
/* !END!: Do not edit above this line. */
#undef TclUnusedStubEntry
#if defined(USE_TCL_STUBS)
# undef Tcl_CreateInterp
# undef Tcl_FindExecutable
# undef Tcl_GetStringResult
# undef Tcl_Init
# undef Tcl_SetPanicProc
# undef Tcl_SetExitProc
# undef Tcl_ObjSetVar2
# undef Tcl_StaticLibrary
# define Tcl_CreateInterp() (tclStubsPtr->tcl_CreateInterp())
# define Tcl_GetStringResult(interp) (tclStubsPtr->tcl_GetStringResult(interp))
# define Tcl_Init(interp) (tclStubsPtr->tcl_Init(interp))
# define Tcl_ObjSetVar2(interp, part1, part2, newValue, flags) \
(tclStubsPtr->tcl_ObjSetVar2(interp, part1, part2, newValue, flags))
#endif
#if defined(_WIN32) && defined(UNICODE)
# if defined(TCL_NO_DEPRECATED)
# define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg)))
# else
# define Tcl_FindExecutable(arg) ((void)((Tcl_FindExecutable)((const char *)(arg))))
# define Tcl_SetPanicProc(arg) ((void)((Tcl_SetPanicProc)(arg)))
# endif
# define Tcl_MainEx Tcl_MainExW
EXTERN void Tcl_MainExW(int argc, wchar_t **argv,
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
#elif !defined(TCL_NO_DEPRECATED)
# define Tcl_FindExecutable(arg) ((void)((Tcl_FindExecutable)(arg)))
# define Tcl_SetPanicProc(arg) ((void)((Tcl_SetPanicProc)(arg)))
#endif
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
#undef Tcl_SeekOld
#undef Tcl_TellOld
|
| ︙ | ︙ | |||
4108 4109 4110 4111 4112 4113 4114 |
} else { \
(*__freeProc)((char *)__result); \
} \
} \
} while(0)
#endif /* TCL_NO_DEPRECATED */
| | > > > > > > > > > > > > > > > > > | 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 |
} else { \
(*__freeProc)((char *)__result); \
} \
} \
} while(0)
#endif /* TCL_NO_DEPRECATED */
#if defined(USE_TCL_STUBS)
# if defined(_WIN32) && defined(_WIN64)
# undef Tcl_GetTime
/* Handle Win64 tk.dll being loaded in Cygwin64. */
# define Tcl_GetTime(t) \
do { \
union { \
Tcl_Time now; \
long long reserved; \
} _t; \
_t.reserved = -1; \
tclStubsPtr->tcl_GetTime((&_t.now)); \
if (_t.reserved != -1) { \
_t.now.usec = _t.reserved; \
} \
*(t) = _t.now; \
} while (0)
# endif
# if defined(__CYGWIN__) && defined(TCL_WIDE_INT_IS_LONG)
/* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore
* we have to make sure that all stub entries on Cygwin64 follow the
* Win64 signature. Cygwin64 stubbed extensions cannot use those stub
* entries any more, they should use the 64-bit alternatives where
* possible. Tcl 9 must find a better solution, but that cannot be done
* without introducing a binary incompatibility.
|
| ︙ | ︙ | |||
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 | #undef Tcl_GetString #undef Tcl_GetUnicode #define Tcl_GetString(objPtr) \ Tcl_GetStringFromObj(objPtr, (int *)NULL) #define Tcl_GetUnicode(objPtr) \ Tcl_GetUnicodeFromObj(objPtr, (int *)NULL) #ifdef TCL_NO_DEPRECATED #undef Tcl_GetStringFromObj #undef Tcl_GetUnicodeFromObj #undef Tcl_GetByteArrayFromObj #endif #if defined(USE_TCL_STUBS) #ifdef TCL_NO_DEPRECATED #define Tcl_GetStringFromObj(objPtr, sizePtr) \ (sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tcl_GetStringFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tclGetStringFromObj(objPtr, (size_t *)sizePtr)) #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ (sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tclGetByteArrayFromObj(objPtr, (size_t *)sizePtr)) #define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ (sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tclGetUnicodeFromObj(objPtr, (size_t *)sizePtr)) #endif #else #ifdef TCL_NO_DEPRECATED #define Tcl_GetStringFromObj(objPtr, sizePtr) \ (sizeof(*sizePtr) <= sizeof(int) ? (Tcl_GetStringFromObj)(objPtr, (int *)sizePtr) : (TclGetStringFromObj)(objPtr, (size_t *)sizePtr)) #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ (sizeof(*sizePtr) <= sizeof(int) ? (Tcl_GetByteArrayFromObj)(objPtr, (int *)sizePtr) : TclGetByteArrayFromObj(objPtr, (size_t *)sizePtr)) #define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ (sizeof(*sizePtr) <= sizeof(int) ? (Tcl_GetUnicodeFromObj)(objPtr, (int *)sizePtr) : TclGetUnicodeFromObj(objPtr, (size_t *)sizePtr)) | > > > > > > > > > > | 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 | #undef Tcl_GetString #undef Tcl_GetUnicode #define Tcl_GetString(objPtr) \ Tcl_GetStringFromObj(objPtr, (int *)NULL) #define Tcl_GetUnicode(objPtr) \ Tcl_GetUnicodeFromObj(objPtr, (int *)NULL) #undef Tcl_GetBytesFromObj #undef Tcl_GetIndexFromObjStruct #ifdef TCL_NO_DEPRECATED #undef Tcl_GetStringFromObj #undef Tcl_GetUnicodeFromObj #undef Tcl_GetByteArrayFromObj #endif #if defined(USE_TCL_STUBS) #define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ (sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (int *)sizePtr) : tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (size_t *)sizePtr)) #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ (tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), (flags)|(int)(sizeof(*indexPtr)<<8), (indexPtr))) #ifdef TCL_NO_DEPRECATED #define Tcl_GetStringFromObj(objPtr, sizePtr) \ (sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tcl_GetStringFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tclGetStringFromObj(objPtr, (size_t *)sizePtr)) #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ (sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tclGetByteArrayFromObj(objPtr, (size_t *)sizePtr)) #define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ (sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tclGetUnicodeFromObj(objPtr, (size_t *)sizePtr)) #endif #else #define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ (sizeof(*sizePtr) <= sizeof(int) ? (TclGetBytesFromObj)(interp, objPtr, (int *)sizePtr) : (Tcl_GetBytesFromObj)(interp, objPtr, (size_t *)sizePtr)) #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ ((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), (flags)|(int)(sizeof(*indexPtr)<<8), (indexPtr))) #ifdef TCL_NO_DEPRECATED #define Tcl_GetStringFromObj(objPtr, sizePtr) \ (sizeof(*sizePtr) <= sizeof(int) ? (Tcl_GetStringFromObj)(objPtr, (int *)sizePtr) : (TclGetStringFromObj)(objPtr, (size_t *)sizePtr)) #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ (sizeof(*sizePtr) <= sizeof(int) ? (Tcl_GetByteArrayFromObj)(objPtr, (int *)sizePtr) : TclGetByteArrayFromObj(objPtr, (size_t *)sizePtr)) #define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ (sizeof(*sizePtr) <= sizeof(int) ? (Tcl_GetUnicodeFromObj)(objPtr, (int *)sizePtr) : TclGetUnicodeFromObj(objPtr, (size_t *)sizePtr)) |
| ︙ | ︙ | |||
4196 4197 4198 4199 4200 4201 4202 | #undef Tcl_SetLongObj #define Tcl_SetLongObj(objPtr, value) Tcl_SetWideIntObj((objPtr), (long)(value)) #undef Tcl_BackgroundError #define Tcl_BackgroundError(interp) Tcl_BackgroundException((interp), TCL_ERROR) #undef Tcl_StringMatch #define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0) | | > > | | > > > | | > > > | 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 | #undef Tcl_SetLongObj #define Tcl_SetLongObj(objPtr, value) Tcl_SetWideIntObj((objPtr), (long)(value)) #undef Tcl_BackgroundError #define Tcl_BackgroundError(interp) Tcl_BackgroundException((interp), TCL_ERROR) #undef Tcl_StringMatch #define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0) #if TCL_UTF_MAX < 4 # undef Tcl_UniCharToUtfDString # define Tcl_UniCharToUtfDString Tcl_Char16ToUtfDString # undef Tcl_UtfToUniCharDString # define Tcl_UtfToUniCharDString Tcl_UtfToChar16DString # undef Tcl_UtfToUniChar # define Tcl_UtfToUniChar Tcl_UtfToChar16 # undef Tcl_UniCharLen # define Tcl_UniCharLen Tcl_Char16Len #endif #if defined(USE_TCL_STUBS) # define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \ ? (char *(*)(const wchar_t *, int, Tcl_DString *))tclStubsPtr->tcl_UniCharToUtfDString \ : (char *(*)(const wchar_t *, int, Tcl_DString *))Tcl_Char16ToUtfDString) # define Tcl_UtfToWCharDString (sizeof(wchar_t) != sizeof(short) \ ? (wchar_t *(*)(const char *, int, Tcl_DString *))tclStubsPtr->tcl_UtfToUniCharDString \ : (wchar_t *(*)(const char *, int, Tcl_DString *))Tcl_UtfToChar16DString) # define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \ ? (int (*)(const char *, wchar_t *))tclStubsPtr->tcl_UtfToUniChar \ : (int (*)(const char *, wchar_t *))Tcl_UtfToChar16) # define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \ ? (int (*)(wchar_t *))tclStubsPtr->tcl_UniCharLen \ : (int (*)(wchar_t *))Tcl_Char16Len) #else # define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \ ? (char *(*)(const wchar_t *, int, Tcl_DString *))Tcl_UniCharToUtfDString \ : (char *(*)(const wchar_t *, int, Tcl_DString *))Tcl_Char16ToUtfDString) # define Tcl_UtfToWCharDString (sizeof(wchar_t) != sizeof(short) \ ? (wchar_t *(*)(const char *, int, Tcl_DString *))Tcl_UtfToUniCharDString \ : (wchar_t *(*)(const char *, int, Tcl_DString *))Tcl_UtfToChar16DString) # define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \ ? (int (*)(const char *, wchar_t *))Tcl_UtfToUniChar \ : (int (*)(const char *, wchar_t *))Tcl_UtfToChar16) # define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \ ? (int (*)(wchar_t *))Tcl_UniCharLen \ : (int (*)(wchar_t *))Tcl_Char16Len) #endif /* * Deprecated Tcl procedures: */ #undef Tcl_EvalObj |
| ︙ | ︙ |
Changes to generic/tclDictObj.c.
| ︙ | ︙ | |||
145 146 147 148 149 150 151 |
"dict",
FreeDictInternalRep, /* freeIntRepProc */
DupDictInternalRep, /* dupIntRepProc */
UpdateStringOfDict, /* updateStringProc */
SetDictFromAny /* setFromAnyProc */
};
| | | | | | | | 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 |
"dict",
FreeDictInternalRep, /* freeIntRepProc */
DupDictInternalRep, /* dupIntRepProc */
UpdateStringOfDict, /* updateStringProc */
SetDictFromAny /* setFromAnyProc */
};
#define DictSetInternalRep(objPtr, dictRepPtr) \
do { \
Tcl_ObjInternalRep ir; \
ir.twoPtrValue.ptr1 = (dictRepPtr); \
ir.twoPtrValue.ptr2 = NULL; \
Tcl_StoreInternalRep((objPtr), &tclDictType, &ir); \
} while (0)
#define DictGetInternalRep(objPtr, dictRepPtr) \
do { \
const Tcl_ObjInternalRep *irPtr; \
irPtr = TclFetchInternalRep((objPtr), &tclDictType); \
(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
|
| ︙ | ︙ | |||
358 359 360 361 362 363 364 |
DupDictInternalRep(
Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr)
{
Dict *oldDict, *newDict = (Dict *)ckalloc(sizeof(Dict));
ChainEntry *cPtr;
| | | 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 |
DupDictInternalRep(
Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr)
{
Dict *oldDict, *newDict = (Dict *)ckalloc(sizeof(Dict));
ChainEntry *cPtr;
DictGetInternalRep(srcPtr, oldDict);
/*
* Copy values across from the old hash table.
*/
InitChainTable(newDict);
for (cPtr=oldDict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) {
|
| ︙ | ︙ | |||
391 392 393 394 395 396 397 |
newDict->chain = NULL;
newDict->refCount = 1;
/*
* Store in the object.
*/
| | | 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 |
newDict->chain = NULL;
newDict->refCount = 1;
/*
* Store in the object.
*/
DictSetInternalRep(copyPtr, newDict);
}
/*
*----------------------------------------------------------------------
*
* FreeDictInternalRep --
*
|
| ︙ | ︙ | |||
418 419 420 421 422 423 424 |
static void
FreeDictInternalRep(
Tcl_Obj *dictPtr)
{
Dict *dict;
| | | 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 |
static void
FreeDictInternalRep(
Tcl_Obj *dictPtr)
{
Dict *dict;
DictGetInternalRep(dictPtr, dict);
if (dict->refCount-- <= 1) {
DeleteDict(dict);
}
}
/*
|
| ︙ | ︙ | |||
495 496 497 498 499 500 501 |
/*
* This field is the most useful one in the whole hash structure, and it
* is not exposed by any API function...
*/
int numElems;
| | | 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 |
/*
* This field is the most useful one in the whole hash structure, and it
* is not exposed by any API function...
*/
int numElems;
DictGetInternalRep(dictPtr, dict);
assert (dict != NULL);
numElems = dict->table.numEntries * 2;
/* Handle empty list case first, simplifies what follows */
if (numElems == 0) {
|
| ︙ | ︙ | |||
562 563 564 565 566 567 568 569 570 571 572 573 574 575 |
flagPtr[i+1] |= TCL_DONT_QUOTE_HASH;
valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
elem = TclGetStringFromObj(valuePtr, &length);
dst += TclConvertElement(elem, length, dst, flagPtr[i+1]);
*dst++ = ' ';
}
(void)Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);
if (flagPtr != localFlags) {
ckfree(flagPtr);
}
}
| > | 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 |
flagPtr[i+1] |= TCL_DONT_QUOTE_HASH;
valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
elem = TclGetStringFromObj(valuePtr, &length);
dst += TclConvertElement(elem, length, dst, flagPtr[i+1]);
*dst++ = ' ';
}
/* Last space overwrote the terminating NUL; cal T_ISR again to restore */
(void)Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);
if (flagPtr != localFlags) {
ckfree(flagPtr);
}
}
|
| ︙ | ︙ | |||
606 607 608 609 610 611 612 |
/*
* 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.
*/
| | | 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 |
/*
* Since lists and dictionaries have very closely-related string
* representations (i.e. the same parsing code) we can safely special-case
* the conversion from lists to dictionaries.
*/
if (TclHasInternalRep(objPtr, &tclListType)) {
int objc, i;
Tcl_Obj **objv;
/* Cannot fail, we already know the Tcl_ObjType is "list". */
TclListObjGetElements(NULL, objPtr, &objc, &objv);
if (objc & 1) {
goto missingValue;
|
| ︙ | ︙ | |||
713 714 715 716 717 718 719 |
* 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;
| | | 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 |
* 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;
DictSetInternalRep(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", NULL);
|
| ︙ | ︙ | |||
735 736 737 738 739 740 741 |
static Dict *
GetDictFromObj(
Tcl_Interp *interp,
Tcl_Obj *dictPtr)
{
Dict *dict;
| | | | 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 |
static Dict *
GetDictFromObj(
Tcl_Interp *interp,
Tcl_Obj *dictPtr)
{
Dict *dict;
DictGetInternalRep(dictPtr, dict);
if (dict == NULL) {
if (SetDictFromAny(interp, dictPtr) != TCL_OK) {
return NULL;
}
DictGetInternalRep(dictPtr, dict);
}
return dict;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
788 789 790 791 792 793 794 |
int keyc,
Tcl_Obj *const keyv[],
int flags)
{
Dict *dict, *newDict;
int i;
| | | | 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 |
int keyc,
Tcl_Obj *const keyv[],
int flags)
{
Dict *dict, *newDict;
int i;
DictGetInternalRep(dictPtr, dict);
if (dict == NULL) {
if (SetDictFromAny(interp, dictPtr) != TCL_OK) {
return NULL;
}
DictGetInternalRep(dictPtr, dict);
}
if (flags & DICT_PATH_UPDATE) {
dict->chain = NULL;
}
for (i=0 ; i<keyc ; i++) {
Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&dict->table, keyv[i]);
|
| ︙ | ︙ | |||
831 832 833 834 835 836 837 |
hPtr = CreateChainEntry(dict, keyv[i], &isNew);
tmpObj = Tcl_NewDictObj();
Tcl_IncrRefCount(tmpObj);
Tcl_SetHashValue(hPtr, tmpObj);
} else {
tmpObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
| | | | | 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 |
hPtr = CreateChainEntry(dict, keyv[i], &isNew);
tmpObj = Tcl_NewDictObj();
Tcl_IncrRefCount(tmpObj);
Tcl_SetHashValue(hPtr, tmpObj);
} else {
tmpObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
DictGetInternalRep(tmpObj, newDict);
if (newDict == NULL) {
if (SetDictFromAny(interp, tmpObj) != TCL_OK) {
return NULL;
}
}
}
DictGetInternalRep(tmpObj, newDict);
if (flags & DICT_PATH_UPDATE) {
if (Tcl_IsShared(tmpObj)) {
TclDecrRefCount(tmpObj);
tmpObj = Tcl_DuplicateObj(tmpObj);
Tcl_IncrRefCount(tmpObj);
Tcl_SetHashValue(hPtr, tmpObj);
dict->epoch++;
DictGetInternalRep(tmpObj, newDict);
}
newDict->chain = dictPtr;
}
dict = newDict;
dictPtr = tmpObj;
}
|
| ︙ | ︙ | |||
885 886 887 888 889 890 891 |
static void
InvalidateDictChain(
Tcl_Obj *dictObj)
{
Dict *dict;
| | | | | | 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 |
static void
InvalidateDictChain(
Tcl_Obj *dictObj)
{
Dict *dict;
DictGetInternalRep(dictObj, dict);
assert( dict != NULL);
do {
dict->refCount++;
TclInvalidateStringRep(dictObj);
TclFreeInternalRep(dictObj);
DictSetInternalRep(dictObj, dict);
dict->epoch++;
dictObj = dict->chain;
if (dictObj == NULL) {
break;
}
dict->chain = NULL;
DictGetInternalRep(dictObj, dict);
} while (dict != NULL);
}
/*
*----------------------------------------------------------------------
*
* Tcl_DictObjPut --
|
| ︙ | ︙ | |||
946 947 948 949 950 951 952 |
if (dict == NULL) {
return TCL_ERROR;
}
TclInvalidateStringRep(dictPtr);
hPtr = CreateChainEntry(dict, keyPtr, &isNew);
dict->refCount++;
| | | | 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 |
if (dict == NULL) {
return TCL_ERROR;
}
TclInvalidateStringRep(dictPtr);
hPtr = CreateChainEntry(dict, keyPtr, &isNew);
dict->refCount++;
TclFreeInternalRep(dictPtr)
DictSetInternalRep(dictPtr, dict);
Tcl_IncrRefCount(valuePtr);
if (!isNew) {
Tcl_Obj *oldValuePtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
TclDecrRefCount(oldValuePtr);
}
Tcl_SetHashValue(hPtr, valuePtr);
|
| ︙ | ︙ | |||
1302 1303 1304 1305 1306 1307 1308 |
}
dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_CREATE);
if (dictPtr == NULL) {
return TCL_ERROR;
}
| | | 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 |
}
dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_CREATE);
if (dictPtr == NULL) {
return TCL_ERROR;
}
DictGetInternalRep(dictPtr, dict);
assert(dict != NULL);
hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew);
Tcl_IncrRefCount(valuePtr);
if (!isNew) {
Tcl_Obj *oldValuePtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
TclDecrRefCount(oldValuePtr);
|
| ︙ | ︙ | |||
1360 1361 1362 1363 1364 1365 1366 |
}
dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_UPDATE);
if (dictPtr == NULL) {
return TCL_ERROR;
}
| | | 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 |
}
dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_UPDATE);
if (dictPtr == NULL) {
return TCL_ERROR;
}
DictGetInternalRep(dictPtr, dict);
assert(dict != NULL);
DeleteChainEntry(dict, keyv[keyc-1]);
InvalidateDictChain(dictPtr);
return TCL_OK;
}
/*
|
| ︙ | ︙ | |||
1407 1408 1409 1410 1411 1412 1413 |
TclNewObj(dictPtr);
TclInvalidateStringRep(dictPtr);
dict = (Dict *)ckalloc(sizeof(Dict));
InitChainTable(dict);
dict->epoch = 1;
dict->chain = NULL;
dict->refCount = 1;
| | | 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 |
TclNewObj(dictPtr);
TclInvalidateStringRep(dictPtr);
dict = (Dict *)ckalloc(sizeof(Dict));
InitChainTable(dict);
dict->epoch = 1;
dict->chain = NULL;
dict->refCount = 1;
DictSetInternalRep(dictPtr, dict);
return dictPtr;
#endif
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
1455 1456 1457 1458 1459 1460 1461 |
TclDbNewObj(dictPtr, file, line);
TclInvalidateStringRep(dictPtr);
dict = (Dict *)ckalloc(sizeof(Dict));
InitChainTable(dict);
dict->epoch = 1;
dict->chain = NULL;
dict->refCount = 1;
| | | 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 |
TclDbNewObj(dictPtr, file, line);
TclInvalidateStringRep(dictPtr);
dict = (Dict *)ckalloc(sizeof(Dict));
InitChainTable(dict);
dict->epoch = 1;
dict->chain = NULL;
dict->refCount = 1;
DictSetInternalRep(dictPtr, dict);
return dictPtr;
}
#else /* !TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_DbNewDictObj(
TCL_UNUSED(const char *) /*file*/,
TCL_UNUSED(int) /*line*/)
|
| ︙ | ︙ | |||
3369 3370 3371 3372 3373 3374 3375 |
}
/*
* Write back the values from the variables, treating failure to read as
* an instruction to remove the key.
*/
| | | 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 |
}
/*
* Write back the values from the variables, treating failure to read as
* an instruction to remove the key.
*/
TclListObjGetElements(NULL, argsObj, &objc, &objv);
for (i=0 ; i<objc ; i+=2) {
objPtr = Tcl_ObjGetVar2(interp, objv[i+1], NULL, 0);
if (objPtr == NULL) {
Tcl_DictObjRemove(NULL, dictPtr, objv[i]);
} else if (objPtr == dictPtr) {
/*
* Someone is messing us around, trying to build a recursive
|
| ︙ | ︙ | |||
3493 3494 3495 3496 3497 3498 3499 |
/*
* Save the result state; TDWF doesn't guarantee to not modify that on
* TCL_OK result.
*/
state = Tcl_SaveInterpState(interp, result);
if (pathPtr != NULL) {
| | | 3494 3495 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 |
/*
* Save the result state; TDWF doesn't guarantee to not modify that on
* TCL_OK result.
*/
state = Tcl_SaveInterpState(interp, result);
if (pathPtr != NULL) {
TclListObjGetElements(NULL, pathPtr, &pathc, &pathv);
} else {
pathc = 0;
pathv = NULL;
}
/*
* Pack from local variables back into the dictionary.
|
| ︙ | ︙ |
Changes to generic/tclDisassemble.c.
| ︙ | ︙ | |||
40 41 42 43 44 45 46 |
"instname", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfInstName, /* updateStringProc */
NULL, /* setFromAnyProc */
};
| | | | | | | | 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 |
"instname", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfInstName, /* updateStringProc */
NULL, /* setFromAnyProc */
};
#define InstNameSetInternalRep(objPtr, inst) \
do { \
Tcl_ObjInternalRep ir; \
ir.wideValue = (inst); \
Tcl_StoreInternalRep((objPtr), &instNameType, &ir); \
} while (0)
#define InstNameGetInternalRep(objPtr, inst) \
do { \
const Tcl_ObjInternalRep *irPtr; \
irPtr = TclFetchInternalRep((objPtr), &instNameType); \
assert(irPtr != NULL); \
(inst) = (size_t)irPtr->wideValue; \
} while (0)
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
255 256 257 258 259 260 261 |
unsigned char *codeStart, *codeLimit, *pc;
unsigned char *codeDeltaNext, *codeLengthNext;
unsigned char *srcDeltaNext, *srcLengthNext;
int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line;
Interp *iPtr;
Tcl_Obj *bufferObj, *fileObj;
| | | 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 |
unsigned char *codeStart, *codeLimit, *pc;
unsigned char *codeDeltaNext, *codeLengthNext;
unsigned char *srcDeltaNext, *srcLengthNext;
int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line;
Interp *iPtr;
Tcl_Obj *bufferObj, *fileObj;
ByteCodeGetInternalRep(objPtr, &tclByteCodeType, codePtr);
iPtr = (Interp *) *codePtr->interpHandle;
TclNewObj(bufferObj);
if (!codePtr->refCount) {
return bufferObj; /* Already freed. */
}
|
| ︙ | ︙ | |||
757 758 759 760 761 762 763 |
Tcl_DecrRefCount(result);
iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL);
Tcl_IncrRefCount(result);
} else {
int len;
/*
| | | | 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 |
Tcl_DecrRefCount(result);
iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL);
Tcl_IncrRefCount(result);
} else {
int len;
/*
* Reset while keeping the list internalrep as much as possible.
*/
TclListObjLength(interp, result, &len);
Tcl_ListObjReplace(interp, result, 0, len, 0, NULL);
}
Tcl_ListObjAppendElement(NULL, result, TclNewInstNameObj(*pc));
for (; objc>0 ; objc--) {
Tcl_Obj *objPtr;
|
| ︙ | ︙ | |||
804 805 806 807 808 809 810 |
TclNewInstNameObj(
unsigned char inst)
{
Tcl_Obj *objPtr;
TclNewObj(objPtr);
TclInvalidateStringRep(objPtr);
| | | 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 |
TclNewInstNameObj(
unsigned char inst)
{
Tcl_Obj *objPtr;
TclNewObj(objPtr);
TclInvalidateStringRep(objPtr);
InstNameSetInternalRep(objPtr, (long) inst);
return objPtr;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
826 827 828 829 830 831 832 |
static void
UpdateStringOfInstName(
Tcl_Obj *objPtr)
{
size_t inst; /* NOTE: We know this is really an unsigned char */
char *dst;
| | | 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 |
static void
UpdateStringOfInstName(
Tcl_Obj *objPtr)
{
size_t inst; /* NOTE: We know this is really an unsigned char */
char *dst;
InstNameGetInternalRep(objPtr, inst);
if (inst > LAST_INST_OPCODE) {
dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 5);
TclOOM(dst, TCL_INTEGER_SPACE + 5);
sprintf(dst, "inst_%" TCL_Z_MODIFIER "u", inst);
(void) Tcl_InitStringRep(objPtr, NULL, strlen(dst));
} else {
|
| ︙ | ︙ | |||
941 942 943 944 945 946 947 |
ByteCode *codePtr;
Tcl_Obj *description, *literals, *variables, *instructions, *inst;
Tcl_Obj *aux, *exn, *commands, *file;
unsigned char *pc, *opnd, *codeOffPtr, *codeLenPtr, *srcOffPtr, *srcLenPtr;
int codeOffset, codeLength, sourceOffset, sourceLength;
int i, val, line;
| | | 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 |
ByteCode *codePtr;
Tcl_Obj *description, *literals, *variables, *instructions, *inst;
Tcl_Obj *aux, *exn, *commands, *file;
unsigned char *pc, *opnd, *codeOffPtr, *codeLenPtr, *srcOffPtr, *srcLenPtr;
int codeOffset, codeLength, sourceOffset, sourceLength;
int i, val, line;
ByteCodeGetInternalRep(objPtr, &tclByteCodeType, codePtr);
/*
* Get the literals from the bytecode.
*/
TclNewObj(literals);
for (i=0 ; i<codePtr->numLitObjects ; i++) {
|
| ︙ | ︙ | |||
1364 1365 1366 1367 1368 1369 1370 |
*/
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "script");
return TCL_ERROR;
}
| | | 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 |
*/
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "script");
return TCL_ERROR;
}
if (!TclHasInternalRep(objv[2], &tclByteCodeType) && (TCL_OK
!= TclSetByteCodeFromAny(interp, objv[2], NULL, NULL))) {
return TCL_ERROR;
}
codeObjPtr = objv[2];
break;
case DISAS_CLASS_CONSTRUCTOR:
|
| ︙ | ︙ | |||
1415 1416 1417 1418 1419 1420 1421 | return TCL_ERROR; } /* * Compile if necessary. */ | | | 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 |
return TCL_ERROR;
}
/*
* Compile if necessary.
*/
if (!TclHasInternalRep(procPtr->bodyPtr, &tclByteCodeType)) {
Command cmd;
/*
* Yes, this is ugly, but we need to pass the namespace in to the
* compiler in two places.
*/
|
| ︙ | ︙ | |||
1480 1481 1482 1483 1484 1485 1486 | return TCL_ERROR; } /* * Compile if necessary. */ | | | 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 |
return TCL_ERROR;
}
/*
* Compile if necessary.
*/
if (!TclHasInternalRep(procPtr->bodyPtr, &tclByteCodeType)) {
Command cmd;
/*
* Yes, this is ugly, but we need to pass the namespace in to the
* compiler in two places.
*/
|
| ︙ | ︙ | |||
1565 1566 1567 1568 1569 1570 1571 |
if (procPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"body not available for this kind of method", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
"METHODTYPE", NULL);
return TCL_ERROR;
}
| | | 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 |
if (procPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"body not available for this kind of method", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
"METHODTYPE", NULL);
return TCL_ERROR;
}
if (!TclHasInternalRep(procPtr->bodyPtr, &tclByteCodeType)) {
Command cmd;
/*
* Yes, this is ugly, but we need to pass the namespace in to the
* compiler in two places.
*/
|
| ︙ | ︙ | |||
1593 1594 1595 1596 1597 1598 1599 |
CLANG_ASSERT(0);
}
/*
* Do the actual disassembly.
*/
| | | 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 |
CLANG_ASSERT(0);
}
/*
* Do the actual disassembly.
*/
ByteCodeGetInternalRep(codeObjPtr, &tclByteCodeType, codePtr);
if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"may not disassemble prebuilt bytecode", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
"BYTECODE", NULL);
return TCL_ERROR;
|
| ︙ | ︙ |
Changes to generic/tclEncoding.c.
| ︙ | ︙ | |||
33 34 35 36 37 38 39 |
Tcl_EncodingFreeProc *freeProc;
/* If non-NULL, function to call when this
* encoding is deleted. */
int nullSize; /* Number of 0x00 bytes that signify
* end-of-string in this encoding. This number
* is used to determine the source string
* length when the srcLen argument is
| | | > > | 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 |
Tcl_EncodingFreeProc *freeProc;
/* If non-NULL, function to call when this
* encoding is deleted. */
int nullSize; /* Number of 0x00 bytes that signify
* end-of-string in this encoding. This number
* is used to determine the source string
* length when the srcLen argument is
* negative. This number can be 1, 2, or 4. */
ClientData clientData; /* Arbitrary value associated with encoding
* type. Passed to conversion functions. */
LengthProc *lengthProc; /* Function to compute length of
* null-terminated strings in this encoding.
* If nullSize is 1, this is strlen; if
* nullSize is 2, this is a function that
* returns the number of bytes in a 0x0000
* terminated string; if nullSize is 4, this
* is a function that returns the number of
* bytes in a 0x00000000 terminated string. */
size_t refCount; /* Number of uses of this structure. */
Tcl_HashEntry *hPtr; /* Hash table entry that owns this encoding. */
} Encoding;
/*
* The following structure is the clientData for a dynamically-loaded,
* table-driven encoding created by LoadTableEncoding(). It maps between
|
| ︙ | ︙ | |||
192 193 194 195 196 197 198 | static unsigned short emptyPage[256]; /* * Functions used only in this module. */ static Tcl_EncodingConvertProc BinaryProc; | | | | > > > | | | | | | | | | 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 |
static unsigned short emptyPage[256];
/*
* Functions used only in this module.
*/
static Tcl_EncodingConvertProc BinaryProc;
static Tcl_DupInternalRepProc DupEncodingInternalRep;
static Tcl_EncodingFreeProc EscapeFreeProc;
static Tcl_EncodingConvertProc EscapeFromUtfProc;
static Tcl_EncodingConvertProc EscapeToUtfProc;
static void FillEncodingFileMap(void);
static void FreeEncoding(Tcl_Encoding encoding);
static Tcl_FreeInternalRepProc FreeEncodingInternalRep;
static Encoding * GetTableEncoding(EscapeEncodingData *dataPtr,
int state);
static Tcl_Encoding LoadEncodingFile(Tcl_Interp *interp,
const char *name);
static Tcl_Encoding LoadTableEncoding(const char *name, int type,
Tcl_Channel chan);
static Tcl_Encoding LoadEscapeEncoding(const char *name,
Tcl_Channel chan);
static Tcl_Channel OpenEncodingFileChannel(Tcl_Interp *interp,
const char *name);
static Tcl_EncodingFreeProc TableFreeProc;
static Tcl_EncodingConvertProc TableFromUtfProc;
static Tcl_EncodingConvertProc TableToUtfProc;
static size_t unilen(const char *src);
static size_t unilen4(const char *src);
static Tcl_EncodingConvertProc Utf32ToUtfProc;
static Tcl_EncodingConvertProc UtfToUtf32Proc;
static Tcl_EncodingConvertProc Utf16ToUtfProc;
static Tcl_EncodingConvertProc UtfToUtf16Proc;
static Tcl_EncodingConvertProc UtfToUcs2Proc;
static Tcl_EncodingConvertProc UtfToUtfProc;
static Tcl_EncodingConvertProc Iso88591FromUtfProc;
static Tcl_EncodingConvertProc Iso88591ToUtfProc;
/*
* A Tcl_ObjType for holding a cached Tcl_Encoding in the twoPtrValue.ptr1 field
* of the internalrep. This should help the lifetime of encodings be more useful.
* See concerns raised in [Bug 1077262].
*/
static const Tcl_ObjType encodingType = {
"encoding", FreeEncodingInternalRep, DupEncodingInternalRep, NULL, NULL
};
#define EncodingSetInternalRep(objPtr, encoding) \
do { \
Tcl_ObjInternalRep ir; \
ir.twoPtrValue.ptr1 = (encoding); \
ir.twoPtrValue.ptr2 = NULL; \
Tcl_StoreInternalRep((objPtr), &encodingType, &ir); \
} while (0)
#define EncodingGetInternalRep(objPtr, encoding) \
do { \
const Tcl_ObjInternalRep *irPtr; \
irPtr = TclFetchInternalRep ((objPtr), &encodingType); \
(encoding) = irPtr ? (Tcl_Encoding)irPtr->twoPtrValue.ptr1 : NULL; \
} while (0)
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
273 274 275 276 277 278 279 |
Tcl_Interp *interp,
Tcl_Obj *objPtr,
Tcl_Encoding *encodingPtr)
{
Tcl_Encoding encoding;
const char *name = TclGetString(objPtr);
| | | | | | | | | | 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 |
Tcl_Interp *interp,
Tcl_Obj *objPtr,
Tcl_Encoding *encodingPtr)
{
Tcl_Encoding encoding;
const char *name = TclGetString(objPtr);
EncodingGetInternalRep(objPtr, encoding);
if (encoding == NULL) {
encoding = Tcl_GetEncoding(interp, name);
if (encoding == NULL) {
return TCL_ERROR;
}
EncodingSetInternalRep(objPtr, encoding);
}
*encodingPtr = Tcl_GetEncoding(NULL, name);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* FreeEncodingInternalRep --
*
* The Tcl_FreeInternalRepProc for the "encoding" Tcl_ObjType.
*
*----------------------------------------------------------------------
*/
static void
FreeEncodingInternalRep(
Tcl_Obj *objPtr)
{
Tcl_Encoding encoding;
EncodingGetInternalRep(objPtr, encoding);
Tcl_FreeEncoding(encoding);
}
/*
*----------------------------------------------------------------------
*
* DupEncodingInternalRep --
*
* The Tcl_DupInternalRepProc for the "encoding" Tcl_ObjType.
*
*----------------------------------------------------------------------
*/
static void
DupEncodingInternalRep(
Tcl_Obj *srcPtr,
Tcl_Obj *dupPtr)
{
Tcl_Encoding encoding = Tcl_GetEncoding(NULL, TclGetString(srcPtr));
EncodingSetInternalRep(dupPtr, encoding);
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetEncodingSearchPath --
*
|
| ︙ | ︙ | |||
361 362 363 364 365 366 367 |
int
Tcl_SetEncodingSearchPath(
Tcl_Obj *searchPath)
{
int dummy;
| | | 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 |
int
Tcl_SetEncodingSearchPath(
Tcl_Obj *searchPath)
{
int dummy;
if (TCL_ERROR == TclListObjLength(NULL, searchPath, &dummy)) {
return TCL_ERROR;
}
TclSetProcessGlobalValue(&encodingSearchPath, searchPath, NULL);
return TCL_OK;
}
/*
|
| ︙ | ︙ | |||
408 409 410 411 412 413 414 |
void
TclSetLibraryPath(
Tcl_Obj *path)
{
int dummy;
| | | 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 |
void
TclSetLibraryPath(
Tcl_Obj *path)
{
int dummy;
if (TCL_ERROR == TclListObjLength(NULL, path, &dummy)) {
return;
}
TclSetProcessGlobalValue(&libraryPath, path, NULL);
}
/*
*---------------------------------------------------------------------------
|
| ︙ | ︙ | |||
447 448 449 450 451 452 453 |
FillEncodingFileMap(void)
{
int i, numDirs = 0;
Tcl_Obj *map, *searchPath;
searchPath = Tcl_GetEncodingSearchPath();
Tcl_IncrRefCount(searchPath);
| | | 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 |
FillEncodingFileMap(void)
{
int i, numDirs = 0;
Tcl_Obj *map, *searchPath;
searchPath = Tcl_GetEncodingSearchPath();
Tcl_IncrRefCount(searchPath);
TclListObjLength(NULL, searchPath, &numDirs);
map = Tcl_NewDictObj();
Tcl_IncrRefCount(map);
for (i = numDirs-1; i >= 0; i--) {
/*
* Iterate backwards through the search path so as we overwrite
* entries found, we favor files earlier on the search path.
|
| ︙ | ︙ | |||
471 472 473 474 475 476 477 | TclNewObj(matchFileList); Tcl_ListObjIndex(NULL, searchPath, i, &directory); Tcl_IncrRefCount(directory); Tcl_IncrRefCount(matchFileList); Tcl_FSMatchInDirectory(NULL, matchFileList, directory, "*.enc", &readableFiles); | | | 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 |
TclNewObj(matchFileList);
Tcl_ListObjIndex(NULL, searchPath, i, &directory);
Tcl_IncrRefCount(directory);
Tcl_IncrRefCount(matchFileList);
Tcl_FSMatchInDirectory(NULL, matchFileList, directory, "*.enc",
&readableFiles);
TclListObjGetElements(NULL, matchFileList, &numFiles, &filev);
for (j=0; j<numFiles; j++) {
Tcl_Obj *encodingName, *fileObj;
fileObj = TclPathPart(NULL, filev[j], TCL_PATH_TAIL);
encodingName = TclPathPart(NULL, fileObj, TCL_PATH_ROOT);
Tcl_DictObjPut(NULL, map, encodingName, directory);
Tcl_DecrRefCount(fileObj);
|
| ︙ | ︙ | |||
507 508 509 510 511 512 513 | * Side effects: * Depends on the memory, object, and IO subsystems. * *--------------------------------------------------------------------------- */ /* Those flags must not conflict with other TCL_ENCODING_* flags in tcl.h */ | > > > | | | | 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 |
* Side effects:
* Depends on the memory, object, and IO subsystems.
*
*---------------------------------------------------------------------------
*/
/* Those flags must not conflict with other TCL_ENCODING_* flags in tcl.h */
/* Since TCL_ENCODING_MODIFIED is only used for utf-8/cesu-8 and
* TCL_ENCODING_LE is only used for utf-16/utf-32/ucs-2. re-use the same value */
#define TCL_ENCODING_MODIFIED 0x20 /* Converting NULL bytes to 0xC0 0x80 */
#define TCL_ENCODING_LE TCL_ENCODING_MODIFIED /* Little-endian encoding */
#define TCL_ENCODING_UTF 0x200 /* For UTF-8 encoding, allow 4-byte output sequences */
void
TclInitEncodingSubsystem(void)
{
Tcl_EncodingType type;
TableEncodingData *dataPtr;
unsigned size;
unsigned short i;
union {
char c;
short s;
} isLe;
if (encodingsInitialized) {
return;
}
|
| ︙ | ︙ | |||
550 551 552 553 554 555 556 |
tclIdentityEncoding = Tcl_CreateEncoding(&type);
type.encodingName = "utf-8";
type.toUtfProc = UtfToUtfProc;
type.fromUtfProc = UtfToUtfProc;
type.freeProc = NULL;
type.nullSize = 1;
| > > | > > > > > > > > > > > > > > > | 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 |
tclIdentityEncoding = Tcl_CreateEncoding(&type);
type.encodingName = "utf-8";
type.toUtfProc = UtfToUtfProc;
type.fromUtfProc = UtfToUtfProc;
type.freeProc = NULL;
type.nullSize = 1;
type.clientData = INT2PTR(TCL_ENCODING_UTF);
Tcl_CreateEncoding(&type);
type.clientData = INT2PTR(0);
type.encodingName = "cesu-8";
Tcl_CreateEncoding(&type);
type.toUtfProc = Utf16ToUtfProc;
type.fromUtfProc = UtfToUcs2Proc;
type.freeProc = NULL;
type.nullSize = 2;
type.encodingName = "ucs-2le";
type.clientData = INT2PTR(TCL_ENCODING_LE);
Tcl_CreateEncoding(&type);
type.encodingName = "ucs-2be";
type.clientData = INT2PTR(0);
Tcl_CreateEncoding(&type);
type.encodingName = "ucs-2";
type.clientData = INT2PTR(isLe.c);
Tcl_CreateEncoding(&type);
type.toUtfProc = Utf32ToUtfProc;
type.fromUtfProc = UtfToUtf32Proc;
type.freeProc = NULL;
type.nullSize = 4;
type.encodingName = "utf-32le";
type.clientData = INT2PTR(TCL_ENCODING_LE);
Tcl_CreateEncoding(&type);
type.encodingName = "utf-32be";
type.clientData = INT2PTR(0);
Tcl_CreateEncoding(&type);
type.encodingName = "utf-32";
type.clientData = INT2PTR(isLe.c);
Tcl_CreateEncoding(&type);
type.toUtfProc = Utf16ToUtfProc;
type.fromUtfProc = UtfToUtf16Proc;
type.freeProc = NULL;
type.nullSize = 2;
type.encodingName = "utf-16le";
type.clientData = INT2PTR(TCL_ENCODING_LE);
|
| ︙ | ︙ | |||
699 700 701 702 703 704 705 |
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
const char *
Tcl_GetDefaultEncodingDir(void)
{
int numDirs;
Tcl_Obj *first, *searchPath = Tcl_GetEncodingSearchPath();
| | | 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 |
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
const char *
Tcl_GetDefaultEncodingDir(void)
{
int numDirs;
Tcl_Obj *first, *searchPath = Tcl_GetEncodingSearchPath();
TclListObjLength(NULL, searchPath, &numDirs);
if (numDirs == 0) {
return NULL;
}
Tcl_ListObjIndex(NULL, searchPath, 0, &first);
return TclGetString(first);
}
|
| ︙ | ︙ | |||
1047 1048 1049 1050 1051 1052 1053 |
Encoding *encodingPtr = (Encoding *)ckalloc(sizeof(Encoding));
encodingPtr->name = NULL;
encodingPtr->toUtfProc = typePtr->toUtfProc;
encodingPtr->fromUtfProc = typePtr->fromUtfProc;
encodingPtr->freeProc = typePtr->freeProc;
encodingPtr->nullSize = typePtr->nullSize;
encodingPtr->clientData = typePtr->clientData;
| | | > > | | 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 |
Encoding *encodingPtr = (Encoding *)ckalloc(sizeof(Encoding));
encodingPtr->name = NULL;
encodingPtr->toUtfProc = typePtr->toUtfProc;
encodingPtr->fromUtfProc = typePtr->fromUtfProc;
encodingPtr->freeProc = typePtr->freeProc;
encodingPtr->nullSize = typePtr->nullSize;
encodingPtr->clientData = typePtr->clientData;
if (typePtr->nullSize == 2) {
encodingPtr->lengthProc = (LengthProc *) unilen;
} else if (typePtr->nullSize == 4) {
encodingPtr->lengthProc = (LengthProc *) unilen4;
} else {
encodingPtr->lengthProc = (LengthProc *) strlen;
}
encodingPtr->refCount = 1;
encodingPtr->hPtr = NULL;
if (typePtr->encodingName) {
Tcl_HashEntry *hPtr;
int isNew;
|
| ︙ | ︙ | |||
1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 |
if (src == NULL) {
srcLen = 0;
} else if (srcLen < 0) {
srcLen = encodingPtr->lengthProc(src);
}
flags = TCL_ENCODING_START | TCL_ENCODING_END;
while (1) {
result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
flags, &state, dst, dstLen, &srcRead, &dstWrote, &dstChars);
soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
if (result != TCL_CONVERT_NOSPACE) {
Tcl_DStringSetLength(dstPtr, soFar);
return Tcl_DStringValue(dstPtr);
}
| > > > > < < | 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 |
if (src == NULL) {
srcLen = 0;
} else if (srcLen < 0) {
srcLen = encodingPtr->lengthProc(src);
}
flags = TCL_ENCODING_START | TCL_ENCODING_END;
if (encodingPtr->toUtfProc == UtfToUtfProc) {
flags |= TCL_ENCODING_MODIFIED | TCL_ENCODING_UTF;
}
while (1) {
result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
flags, &state, dst, dstLen, &srcRead, &dstWrote, &dstChars);
soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
src += srcRead;
if (result != TCL_CONVERT_NOSPACE) {
Tcl_DStringSetLength(dstPtr, soFar);
return Tcl_DStringValue(dstPtr);
}
flags &= ~TCL_ENCODING_START;
srcLen -= srcRead;
if (Tcl_DStringLength(dstPtr) == 0) {
Tcl_DStringSetLength(dstPtr, dstLen);
}
Tcl_DStringSetLength(dstPtr, 2 * Tcl_DStringLength(dstPtr) + 1);
dst = Tcl_DStringValue(dstPtr) + soFar;
dstLen = Tcl_DStringLength(dstPtr) - soFar - 1;
|
| ︙ | ︙ | |||
1242 1243 1244 1245 1246 1247 1248 |
} else if (charLimited) {
maxChars = *dstCharsPtr;
}
if (!noTerminate) {
/*
* If there are any null characters in the middle of the buffer,
| | > > > < < | 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 |
} else if (charLimited) {
maxChars = *dstCharsPtr;
}
if (!noTerminate) {
/*
* If there are any null characters in the middle of the buffer,
* they will converted to the UTF-8 null character (\xC0\x80). To get
* the actual \0 at the end of the destination buffer, we need to
* append it manually. First make room for it...
*/
dstLen--;
}
if (encodingPtr->toUtfProc == UtfToUtfProc) {
flags |= TCL_ENCODING_MODIFIED | TCL_ENCODING_UTF;
}
do {
Tcl_EncodingState savedState = *statePtr;
result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
dstCharsPtr);
if (*dstCharsPtr <= maxChars) {
break;
}
dstLen = Tcl_UtfAtIndex(dst, maxChars) - dst + (TCL_UTF_MAX - 1);
*statePtr = savedState;
} while (1);
if (!noTerminate) {
/* ...and then append it */
dst[*dstWrotePtr] = '\0';
}
|
| ︙ | ︙ | |||
1324 1325 1326 1327 1328 1329 1330 |
srcLen = 0;
} else if (srcLen < 0) {
srcLen = strlen(src);
}
flags = TCL_ENCODING_START | TCL_ENCODING_END;
while (1) {
result = encodingPtr->fromUtfProc(encodingPtr->clientData, src,
| | > | > | < < | 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 |
srcLen = 0;
} else if (srcLen < 0) {
srcLen = strlen(src);
}
flags = TCL_ENCODING_START | TCL_ENCODING_END;
while (1) {
result = encodingPtr->fromUtfProc(encodingPtr->clientData, src,
srcLen, flags, &state, dst, dstLen,
&srcRead, &dstWrote, &dstChars);
soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
src += srcRead;
if (result != TCL_CONVERT_NOSPACE) {
int i = soFar + encodingPtr->nullSize - 1;
while (i >= soFar) {
Tcl_DStringSetLength(dstPtr, i--);
}
return Tcl_DStringValue(dstPtr);
}
flags &= ~TCL_ENCODING_START;
srcLen -= srcRead;
if (Tcl_DStringLength(dstPtr) == 0) {
Tcl_DStringSetLength(dstPtr, dstLen);
}
Tcl_DStringSetLength(dstPtr, 2 * Tcl_DStringLength(dstPtr) + 1);
dst = Tcl_DStringValue(dstPtr) + soFar;
dstLen = Tcl_DStringLength(dstPtr) - soFar - 1;
|
| ︙ | ︙ | |||
1426 1427 1428 1429 1430 1431 1432 |
}
if (dstCharsPtr == NULL) {
dstCharsPtr = &dstChars;
}
dstLen -= encodingPtr->nullSize;
result = encodingPtr->fromUtfProc(encodingPtr->clientData, src, srcLen,
| | | < < < | 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 |
}
if (dstCharsPtr == NULL) {
dstCharsPtr = &dstChars;
}
dstLen -= encodingPtr->nullSize;
result = encodingPtr->fromUtfProc(encodingPtr->clientData, src, srcLen,
flags, statePtr, dst, dstLen, srcReadPtr,
dstWrotePtr, dstCharsPtr);
memset(&dst[*dstWrotePtr], '\0', encodingPtr->nullSize);
return result;
}
/*
*---------------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
1454 1455 1456 1457 1458 1459 1460 | * Side effects: * The absolute pathname for the application is computed and stored to be * returned later by [info nameofexecutable]. * *--------------------------------------------------------------------------- */ #undef Tcl_FindExecutable | | | > | 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 |
* Side effects:
* The absolute pathname for the application is computed and stored to be
* returned later by [info nameofexecutable].
*
*---------------------------------------------------------------------------
*/
#undef Tcl_FindExecutable
const char *
Tcl_FindExecutable(
const char *argv0) /* The value of the application's argv[0]
* (native). */
{
const char *version = Tcl_InitSubsystems();
TclpSetInitialEncodings();
TclpFindExecutable(argv0);
return version;
}
/*
*---------------------------------------------------------------------------
*
* OpenEncodingFileChannel --
*
|
| ︙ | ︙ | |||
1497 1498 1499 1500 1501 1502 1503 |
Tcl_Obj *fileNameObj = Tcl_DuplicateObj(nameObj);
Tcl_Obj *searchPath = Tcl_DuplicateObj(Tcl_GetEncodingSearchPath());
Tcl_Obj *map = TclGetProcessGlobalValue(&encodingFileMap);
Tcl_Obj **dir, *path, *directory = NULL;
Tcl_Channel chan = NULL;
int i, numDirs;
| | | 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 |
Tcl_Obj *fileNameObj = Tcl_DuplicateObj(nameObj);
Tcl_Obj *searchPath = Tcl_DuplicateObj(Tcl_GetEncodingSearchPath());
Tcl_Obj *map = TclGetProcessGlobalValue(&encodingFileMap);
Tcl_Obj **dir, *path, *directory = NULL;
Tcl_Channel chan = NULL;
int i, numDirs;
TclListObjGetElements(NULL, searchPath, &numDirs, &dir);
Tcl_IncrRefCount(nameObj);
Tcl_AppendToObj(fileNameObj, ".enc", -1);
Tcl_IncrRefCount(fileNameObj);
Tcl_DictObjGet(NULL, map, nameObj, &directory);
/*
* Check that any cached directory is still on the encoding search path.
|
| ︙ | ︙ | |||
2166 2167 2168 2169 2170 2171 2172 | * None. * *------------------------------------------------------------------------- */ static int UtfToUtfProc( | | | 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 |
* None.
*
*-------------------------------------------------------------------------
*/
static int
UtfToUtfProc(
ClientData clientData, /* additional flags, e.g. TCL_ENCODING_MODIFIED */
const char *src, /* Source string in UTF-8. */
int srcLen, /* Source string length in bytes. */
int flags, /* Conversion control flags. */
TCL_UNUSED(Tcl_EncodingState *),
char *dst, /* Output buffer in which converted string is
* stored. */
int dstLen, /* The maximum length of output buffer in
|
| ︙ | ︙ | |||
2205 2206 2207 2208 2209 2210 2211 |
srcClose -= 6;
}
if (flags & TCL_ENCODING_CHAR_LIMIT) {
charLimit = *dstCharsPtr;
}
dstStart = dst;
| > | | | | > | | | | | | > > > > > > | > > > > > > > > > > > | | > > > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 |
srcClose -= 6;
}
if (flags & TCL_ENCODING_CHAR_LIMIT) {
charLimit = *dstCharsPtr;
}
dstStart = dst;
flags |= PTR2INT(clientData);
dstEnd = dst + dstLen - ((flags & TCL_ENCODING_UTF) ? TCL_UTF_MAX : 6);
for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
/*
* If there is more string to follow, this will ensure that the
* last UTF-8 character in the source buffer hasn't been cut off.
*/
result = TCL_CONVERT_MULTIBYTE;
break;
}
if (dst > dstEnd) {
result = TCL_CONVERT_NOSPACE;
break;
}
if (UCHAR(*src) < 0x80 && !((UCHAR(*src) == 0) && (flags & TCL_ENCODING_MODIFIED))) {
/*
* Copy 7bit characters, but skip null-bytes when we are in input
* mode, so that they get converted to 0xC080.
*/
*dst++ = *src++;
} else if ((UCHAR(*src) == 0xC0) && (src + 1 < srcEnd)
&& (UCHAR(src[1]) == 0x80) && !(flags & TCL_ENCODING_MODIFIED)) {
/*
* Convert 0xC080 to real nulls when we are in output mode.
*/
*dst++ = 0;
src += 2;
} else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
/*
* Always check before using TclUtfToUCS4. Not doing can so
* cause it 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 & TCL_ENCODING_MODIFIED) {
if (flags & TCL_ENCODING_STOPONERROR) {
result = TCL_CONVERT_MULTIBYTE;
break;
}
ch = UCHAR(*src++);
} else {
char chbuf[2];
chbuf[0] = UCHAR(*src++); chbuf[1] = 0;
TclUtfToUCS4(chbuf, &ch);
}
dst += Tcl_UniCharToUtf(ch, dst);
} else {
int low;
const char *saveSrc = src;
size_t len = TclUtfToUCS4(src, &ch);
if ((len < 2) && (ch != 0) && (flags & TCL_ENCODING_STOPONERROR)
&& (flags & TCL_ENCODING_MODIFIED)) {
result = TCL_CONVERT_SYNTAX;
break;
}
src += len;
if (!(flags & TCL_ENCODING_UTF) && (ch > 0x3FF)) {
if (ch > 0xFFFF) {
/* CESU-8 6-byte sequence for chars > U+FFFF */
ch -= 0x10000;
*dst++ = 0xED;
*dst++ = (char) (((ch >> 16) & 0x0F) | 0xA0);
*dst++ = (char) (((ch >> 10) & 0x3F) | 0x80);
ch = (ch & 0x0CFF) | 0xDC00;
}
goto cesu8;
} else if ((ch | 0x7FF) == 0xDFFF) {
/*
* A surrogate character is detected, handle especially.
*/
low = ch;
len = (src <= srcEnd-3) ? TclUtfToUCS4(src, &low) : 0;
if (((low & ~0x3FF) != 0xDC00) || (ch & 0x400)) {
if (flags & TCL_ENCODING_STOPONERROR) {
result = TCL_CONVERT_UNKNOWN;
src = saveSrc;
break;
}
cesu8:
*dst++ = (char) (((ch >> 12) | 0xE0) & 0xEF);
*dst++ = (char) (((ch >> 6) | 0x80) & 0xBF);
*dst++ = (char) ((ch | 0x80) & 0xBF);
continue;
}
src += len;
dst += Tcl_UniCharToUtf(ch, dst);
ch = low;
} else if (!Tcl_UniCharIsUnicode(ch)) {
if (flags & TCL_ENCODING_STOPONERROR) {
result = TCL_CONVERT_UNKNOWN;
src = saveSrc;
break;
}
if (!(flags & TCL_ENCODING_MODIFIED)) {
ch = 0xFFFD;
}
}
dst += Tcl_UniCharToUtf(ch, dst);
}
}
*srcReadPtr = src - srcStart;
*dstWrotePtr = dst - dstStart;
*dstCharsPtr = numChars;
return result;
}
/*
*-------------------------------------------------------------------------
*
* Utf32ToUtfProc --
*
* Convert from UTF-32 to UTF-8.
*
* Results:
* Returns TCL_OK if conversion was successful.
*
* Side effects:
* None.
*
*-------------------------------------------------------------------------
*/
static int
Utf32ToUtfProc(
ClientData clientData, /* additional flags, e.g. TCL_ENCODING_LE */
const char *src, /* Source string in Unicode. */
int srcLen, /* Source string length in bytes. */
int flags, /* Conversion control flags. */
TCL_UNUSED(Tcl_EncodingState *),
char *dst, /* Output buffer in which converted string is
* stored. */
int dstLen, /* The maximum length of output buffer in
* bytes. */
int *srcReadPtr, /* Filled with the number of bytes from the
* source string that were converted. This may
* be less than the original source length if
* there was a problem converting some source
* characters. */
int *dstWrotePtr, /* Filled with the number of bytes that were
* stored in the output buffer as a result of
* the conversion. */
int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
{
const char *srcStart, *srcEnd;
const char *dstEnd, *dstStart;
int result, numChars, charLimit = INT_MAX;
int ch;
flags |= PTR2INT(clientData);
if (flags & TCL_ENCODING_CHAR_LIMIT) {
charLimit = *dstCharsPtr;
}
result = TCL_OK;
/*
* Check alignment with utf-32 (4 == sizeof(UTF-32))
*/
if ((srcLen % 4) != 0) {
result = TCL_CONVERT_MULTIBYTE;
srcLen &= -4;
}
srcStart = src;
srcEnd = src + srcLen;
dstStart = dst;
dstEnd = dst + dstLen - TCL_UTF_MAX;
for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
if (dst > dstEnd) {
result = TCL_CONVERT_NOSPACE;
break;
}
if (flags & TCL_ENCODING_LE) {
ch = (src[3] & 0xFF) << 24 | (src[2] & 0xFF) << 16 | (src[1] & 0xFF) << 8 | (src[0] & 0xFF);
} else {
ch = (src[0] & 0xFF) << 24 | (src[1] & 0xFF) << 16 | (src[2] & 0xFF) << 8 | (src[3] & 0xFF);
}
/*
* Special case for 1-byte utf chars for speed. Make sure we work with
* unsigned short-size data.
*/
if ((ch > 0) && (ch < 0x80)) {
*dst++ = (ch & 0xFF);
} else {
dst += Tcl_UniCharToUtf(ch, dst);
}
src += sizeof(unsigned int);
}
*srcReadPtr = src - srcStart;
*dstWrotePtr = dst - dstStart;
*dstCharsPtr = numChars;
return result;
}
/*
*-------------------------------------------------------------------------
*
* UtfToUtf32Proc --
*
* Convert from UTF-8 to UTF-32.
*
* Results:
* Returns TCL_OK if conversion was successful.
*
* Side effects:
* None.
*
*-------------------------------------------------------------------------
*/
static int
UtfToUtf32Proc(
ClientData clientData, /* additional flags, e.g. TCL_ENCODING_LE */
const char *src, /* Source string in UTF-8. */
int srcLen, /* Source string length in bytes. */
int flags, /* Conversion control flags. */
TCL_UNUSED(Tcl_EncodingState *),
char *dst, /* Output buffer in which converted string is
* stored. */
int dstLen, /* The maximum length of output buffer in
* bytes. */
int *srcReadPtr, /* Filled with the number of bytes from the
* source string that were converted. This may
* be less than the original source length if
* there was a problem converting some source
* characters. */
int *dstWrotePtr, /* Filled with the number of bytes that were
* stored in the output buffer as a result of
* the conversion. */
int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
{
const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
int result, numChars;
int ch, len;
srcStart = src;
srcEnd = src + srcLen;
srcClose = srcEnd;
if ((flags & TCL_ENCODING_END) == 0) {
srcClose -= TCL_UTF_MAX;
}
dstStart = dst;
dstEnd = dst + dstLen - sizeof(Tcl_UniChar);
flags |= PTR2INT(clientData);
result = TCL_OK;
for (numChars = 0; src < srcEnd; numChars++) {
if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
/*
* If there is more string to follow, this will ensure that the
* last UTF-8 character in the source buffer hasn't been cut off.
*/
result = TCL_CONVERT_MULTIBYTE;
break;
}
if (dst > dstEnd) {
result = TCL_CONVERT_NOSPACE;
break;
}
len = TclUtfToUCS4(src, &ch);
if (!Tcl_UniCharIsUnicode(ch)) {
if (flags & TCL_ENCODING_STOPONERROR) {
result = TCL_CONVERT_UNKNOWN;
break;
}
ch = 0xFFFD;
}
src += len;
if (flags & TCL_ENCODING_LE) {
*dst++ = (ch & 0xFF);
*dst++ = ((ch >> 8) & 0xFF);
*dst++ = ((ch >> 16) & 0xFF);
*dst++ = ((ch >> 24) & 0xFF);
} else {
*dst++ = ((ch >> 24) & 0xFF);
*dst++ = ((ch >> 16) & 0xFF);
*dst++ = ((ch >> 8) & 0xFF);
*dst++ = (ch & 0xFF);
}
}
*srcReadPtr = src - srcStart;
*dstWrotePtr = dst - dstStart;
*dstCharsPtr = numChars;
return result;
|
| ︙ | ︙ | |||
2410 2411 2412 2413 2414 2415 2416 | * None. * *------------------------------------------------------------------------- */ static int UtfToUtf16Proc( | | | 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 |
* None.
*
*-------------------------------------------------------------------------
*/
static int
UtfToUtf16Proc(
ClientData clientData, /* additional flags, e.g. TCL_ENCODING_LE */
const char *src, /* Source string in UTF-8. */
int srcLen, /* Source string length in bytes. */
int flags, /* Conversion control flags. */
TCL_UNUSED(Tcl_EncodingState *),
char *dst, /* Output buffer in which converted string is
* stored. */
int dstLen, /* The maximum length of output buffer in
|
| ︙ | ︙ | |||
2433 2434 2435 2436 2437 2438 2439 |
* the conversion. */
int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
{
const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
int result, numChars;
| | > | > > > > > > > > | | 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 |
* the conversion. */
int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
{
const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
int result, numChars;
int ch, len;
srcStart = src;
srcEnd = src + srcLen;
srcClose = srcEnd;
if ((flags & TCL_ENCODING_END) == 0) {
srcClose -= TCL_UTF_MAX;
}
dstStart = dst;
dstEnd = dst + dstLen - sizeof(Tcl_UniChar);
flags |= PTR2INT(clientData);
result = TCL_OK;
for (numChars = 0; src < srcEnd; numChars++) {
if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
/*
* If there is more string to follow, this will ensure that the
* last UTF-8 character in the source buffer hasn't been cut off.
*/
result = TCL_CONVERT_MULTIBYTE;
break;
}
if (dst > dstEnd) {
result = TCL_CONVERT_NOSPACE;
break;
}
len = TclUtfToUCS4(src, &ch);
if (!Tcl_UniCharIsUnicode(ch)) {
if (flags & TCL_ENCODING_STOPONERROR) {
result = TCL_CONVERT_UNKNOWN;
break;
}
ch = 0xFFFD;
}
src += len;
if (flags & TCL_ENCODING_LE) {
if (ch <= 0xFFFF) {
*dst++ = (ch & 0xFF);
*dst++ = (ch >> 8);
} else {
*dst++ = (((ch - 0x10000) >> 10) & 0xFF);
*dst++ = (((ch - 0x10000) >> 18) & 0x3) | 0xD8;
*dst++ = (ch & 0xFF);
|
| ︙ | ︙ | |||
2530 2531 2532 2533 2534 2535 2536 |
* the conversion. */
int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
{
const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
int result, numChars;
| | | 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 |
* the conversion. */
int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
{
const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
int result, numChars;
#if TCL_UTF_MAX < 4
int len;
#endif
Tcl_UniChar ch = 0;
flags |= PTR2INT(clientData);
srcStart = src;
srcEnd = src + srcLen;
|
| ︙ | ︙ | |||
2561 2562 2563 2564 2565 2566 2567 |
result = TCL_CONVERT_MULTIBYTE;
break;
}
if (dst > dstEnd) {
result = TCL_CONVERT_NOSPACE;
break;
}
| | | 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 |
result = TCL_CONVERT_MULTIBYTE;
break;
}
if (dst > dstEnd) {
result = TCL_CONVERT_NOSPACE;
break;
}
#if TCL_UTF_MAX < 4
src += (len = TclUtfToUniChar(src, &ch));
if ((ch >= 0xD800) && (len < 3)) {
src += TclUtfToUniChar(src, &ch);
ch = 0xFFFD;
}
#else
src += TclUtfToUniChar(src, &ch);
|
| ︙ | ︙ | |||
2592 2593 2594 2595 2596 2597 2598 |
}
}
*srcReadPtr = src - srcStart;
*dstWrotePtr = dst - dstStart;
*dstCharsPtr = numChars;
return result;
}
| | | 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 |
}
}
*srcReadPtr = src - srcStart;
*dstWrotePtr = dst - dstStart;
*dstCharsPtr = numChars;
return result;
}
/*
*-------------------------------------------------------------------------
*
* TableToUtfProc --
*
* Convert from the encoding specified by the TableEncodingData into
* UTF-8.
|
| ︙ | ︙ | |||
2778 2779 2780 2781 2782 2783 2784 | result = TCL_CONVERT_MULTIBYTE; break; } len = TclUtfToUniChar(src, &ch); #if TCL_UTF_MAX > 3 | < < < < | | 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 |
result = TCL_CONVERT_MULTIBYTE;
break;
}
len = TclUtfToUniChar(src, &ch);
#if TCL_UTF_MAX > 3
/* Unicode chars > +U0FFFF cannot be represented in any table encoding */
if (ch & 0xFFFF0000) {
word = 0;
} else
#else
if (!len) {
word = 0;
} else
|
| ︙ | ︙ | |||
2978 2979 2980 2981 2982 2983 2984 | len = TclUtfToUniChar(src, &ch); /* * Check for illegal characters. */ if (ch > 0xFF | | | | 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 |
len = TclUtfToUniChar(src, &ch);
/*
* Check for illegal characters.
*/
if (ch > 0xFF
#if TCL_UTF_MAX < 4
|| ((ch >= 0xD800) && (len < 3))
#endif
) {
if (flags & TCL_ENCODING_STOPONERROR) {
result = TCL_CONVERT_UNKNOWN;
break;
}
#if TCL_UTF_MAX < 4
if ((ch >= 0xD800) && (len < 3)) {
len = 4;
}
#endif
/*
* Plunge on, using '?' as a fallback character.
*/
|
| ︙ | ︙ | |||
3034 3035 3036 3037 3038 3039 3040 |
*/
static void
TableFreeProc(
ClientData clientData) /* TableEncodingData that specifies
* encoding. */
{
| | | 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 |
*/
static void
TableFreeProc(
ClientData clientData) /* TableEncodingData that specifies
* encoding. */
{
TableEncodingData *dataPtr = (TableEncodingData *)clientData;
/*
* Make sure we aren't freeing twice on shutdown. [Bug 219314]
*/
ckfree(dataPtr->toUnicode);
dataPtr->toUnicode = NULL;
|
| ︙ | ︙ | |||
3092 3093 3094 3095 3096 3097 3098 |
int *dstWrotePtr, /* Filled with the number of bytes that were
* stored in the output buffer as a result of
* the conversion. */
int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
{
| | | 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 |
int *dstWrotePtr, /* Filled with the number of bytes that were
* stored in the output buffer as a result of
* the conversion. */
int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
{
EscapeEncodingData *dataPtr = (EscapeEncodingData *)clientData;
const char *prefixBytes, *tablePrefixBytes, *srcStart, *srcEnd;
const unsigned short *const *tableToUnicode;
const Encoding *encodingPtr;
int state, result, numChars, charLimit = INT_MAX;
const char *dstStart, *dstEnd;
if (flags & TCL_ENCODING_CHAR_LIMIT) {
|
| ︙ | ︙ | |||
3569 3570 3571 3572 3573 3574 3575 |
return encodingPtr;
}
/*
*---------------------------------------------------------------------------
*
| | | 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 |
return encodingPtr;
}
/*
*---------------------------------------------------------------------------
*
* unilen, unilen4 --
*
* A helper function for the Tcl_ExternalToUtf functions. This function
* is similar to strlen for double-byte characters: it returns the number
* of bytes in a 0x0000 terminated string.
*
* Results:
* As above.
|
| ︙ | ︙ | |||
3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 |
const char *src)
{
unsigned short *p;
p = (unsigned short *) src;
while (*p != 0x0000) {
p++;
}
return (char *) p - src;
}
/*
*-------------------------------------------------------------------------
*
| > > > > > > > > > > > > > | 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 |
const char *src)
{
unsigned short *p;
p = (unsigned short *) src;
while (*p != 0x0000) {
p++;
}
return (char *) p - src;
}
static size_t
unilen4(
const char *src)
{
unsigned int *p;
p = (unsigned int *) src;
while (*p != 0x00000000) {
p++;
}
return (char *) p - src;
}
/*
*-------------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
3627 3628 3629 3630 3631 3632 3633 |
static void
InitializeEncodingSearchPath(
char **valuePtr,
unsigned int *lengthPtr,
Tcl_Encoding *encodingPtr)
{
const char *bytes;
| | | | | | | | 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 |
static void
InitializeEncodingSearchPath(
char **valuePtr,
unsigned int *lengthPtr,
Tcl_Encoding *encodingPtr)
{
const char *bytes;
int i, numDirs, numBytes;
Tcl_Obj *libPathObj, *encodingObj, *searchPathObj;
TclNewLiteralStringObj(encodingObj, "encoding");
TclNewObj(searchPathObj);
Tcl_IncrRefCount(encodingObj);
Tcl_IncrRefCount(searchPathObj);
libPathObj = TclGetLibraryPath();
Tcl_IncrRefCount(libPathObj);
TclListObjLength(NULL, libPathObj, &numDirs);
for (i = 0; i < numDirs; i++) {
Tcl_Obj *directoryObj, *pathObj;
Tcl_StatBuf stat;
Tcl_ListObjIndex(NULL, libPathObj, i, &directoryObj);
pathObj = Tcl_FSJoinToPath(directoryObj, 1, &encodingObj);
Tcl_IncrRefCount(pathObj);
if ((0 == Tcl_FSStat(pathObj, &stat)) && S_ISDIR(stat.st_mode)) {
Tcl_ListObjAppendElement(NULL, searchPathObj, pathObj);
}
Tcl_DecrRefCount(pathObj);
}
Tcl_DecrRefCount(libPathObj);
Tcl_DecrRefCount(encodingObj);
*encodingPtr = libraryPath.encoding;
if (*encodingPtr) {
((Encoding *)(*encodingPtr))->refCount++;
}
bytes = Tcl_GetStringFromObj(searchPathObj, &numBytes);
*lengthPtr = numBytes;
*valuePtr = (char *)ckalloc(numBytes + 1);
memcpy(*valuePtr, bytes, numBytes + 1);
Tcl_DecrRefCount(searchPathObj);
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Changes to generic/tclEnsemble.c.
| ︙ | ︙ | |||
80 81 82 83 84 85 86 |
"ensembleCommand", /* the type's name */
FreeEnsembleCmdRep, /* freeIntRepProc */
DupEnsembleCmdRep, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL /* setFromAnyProc */
};
| | | | | | | | 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 |
"ensembleCommand", /* the type's name */
FreeEnsembleCmdRep, /* freeIntRepProc */
DupEnsembleCmdRep, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL /* setFromAnyProc */
};
#define ECRSetInternalRep(objPtr, ecRepPtr) \
do { \
Tcl_ObjInternalRep ir; \
ir.twoPtrValue.ptr1 = (ecRepPtr); \
ir.twoPtrValue.ptr2 = NULL; \
Tcl_StoreInternalRep((objPtr), &ensembleCmdType, &ir); \
} while (0)
#define ECRGetInternalRep(objPtr, ecRepPtr) \
do { \
const Tcl_ObjInternalRep *irPtr; \
irPtr = TclFetchInternalRep((objPtr), &ensembleCmdType); \
(ecRepPtr) = irPtr ? (EnsembleCmdRep *)irPtr->twoPtrValue.ptr1 : NULL; \
} while (0)
/*
* The internal rep for caching ensemble subcommand lookups and spelling
* corrections.
*/
|
| ︙ | ︙ | |||
161 162 163 164 165 166 167 |
*foundNsPtr, *altFoundNsPtr, *actualCxtPtr;
Tcl_Command token;
Tcl_DictSearch search;
Tcl_Obj *listObj;
const char *simpleName;
int index, done;
| | | 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 |
*foundNsPtr, *altFoundNsPtr, *actualCxtPtr;
Tcl_Command token;
Tcl_DictSearch search;
Tcl_Obj *listObj;
const char *simpleName;
int index, done;
if (nsPtr == NULL || nsPtr->flags & NS_DEAD) {
if (!Tcl_InterpDeleted(interp)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"tried to manipulate ensemble of deleted namespace",
-1));
Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "DEAD", NULL);
}
return TCL_ERROR;
|
| ︙ | ︙ | |||
1726 1727 1728 1729 1730 1731 1732 |
TclDStringAppendLiteral(&buf, "subcommand ?arg ...?");
Tcl_WrongNumArgs(interp, 1, objv, Tcl_DStringValue(&buf));
Tcl_DStringFree(&buf);
return TCL_ERROR;
}
| | | 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 |
TclDStringAppendLiteral(&buf, "subcommand ?arg ...?");
Tcl_WrongNumArgs(interp, 1, objv, Tcl_DStringValue(&buf));
Tcl_DStringFree(&buf);
return TCL_ERROR;
}
if (ensemblePtr->nsPtr->flags & NS_DEAD) {
/*
* Don't know how we got here, but make things give up quickly.
*/
if (!Tcl_InterpDeleted(interp)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"ensemble activated for deleted namespace", -1));
|
| ︙ | ︙ | |||
1755 1756 1757 1758 1759 1760 1761 | * Table of subcommands is still valid; therefore there might be a * valid cache of discovered information which we can reuse. Do the * check here, and if we're still valid, we can jump straight to the * part where we do the invocation of the subcommand. */ EnsembleCmdRep *ensembleCmd; | | | 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 |
* Table of subcommands is still valid; therefore there might be a
* valid cache of discovered information which we can reuse. Do the
* check here, and if we're still valid, we can jump straight to the
* part where we do the invocation of the subcommand.
*/
EnsembleCmdRep *ensembleCmd;
ECRGetInternalRep(subObj, ensembleCmd);
if (ensembleCmd) {
if (ensembleCmd->epoch == ensemblePtr->epoch &&
ensembleCmd->token == (Command *)ensemblePtr->token) {
prefixObj = (Tcl_Obj *)Tcl_GetHashValue(ensembleCmd->hPtr);
Tcl_IncrRefCount(prefixObj);
if (ensembleCmd->fix) {
TclSpellFix(interp, objv, objc, subIdx, subObj, ensembleCmd->fix);
|
| ︙ | ︙ | |||
1886 1887 1888 1889 1890 1891 1892 |
{
Tcl_Obj *copyPtr; /* The actual list of words to dispatch to.
* Will be freed by the dispatch engine. */
Tcl_Obj **copyObjv;
int copyObjc, prefixObjc;
| | | 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 |
{
Tcl_Obj *copyPtr; /* The actual list of words to dispatch to.
* Will be freed by the dispatch engine. */
Tcl_Obj **copyObjv;
int copyObjc, prefixObjc;
TclListObjLength(NULL, prefixObj, &prefixObjc);
if (objc == 2) {
copyPtr = TclListObjCopy(NULL, prefixObj);
} else {
copyPtr = Tcl_NewListObj(objc - 2 + prefixObjc, NULL);
Tcl_ListObjAppendList(NULL, copyPtr, prefixObj);
Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
|
| ︙ | ︙ | |||
1920 1921 1922 1923 1924 1925 1926 | } /* * Hand off to the target command. */ TclSkipTailcall(interp); | | | 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 |
}
/*
* Hand off to the target command.
*/
TclSkipTailcall(interp);
TclListObjGetElements(NULL, copyPtr, ©Objc, ©Objv);
((Interp *)interp)->lookupNsPtr = ensemblePtr->nsPtr;
return TclNREvalObjv(interp, copyObjc, copyObjv, TCL_EVAL_INVOKE, NULL);
}
unknownOrAmbiguousSubcommand:
/*
* Have not been able to match the subcommand asked for with a real
|
| ︙ | ︙ | |||
2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 |
TclNRAddCallback(interp, FreeER, tmp, store, NULL, NULL);
}
store[idx] = fix;
Tcl_IncrRefCount(fix);
TclNRAddCallback(interp, TclNRReleaseValues, fix, NULL, NULL, NULL);
}
/*
*----------------------------------------------------------------------
*
* TclFetchEnsembleRoot --
*
* Returns the root of ensemble rewriting, if any.
| > > > > > > > > > > > > | 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 |
TclNRAddCallback(interp, FreeER, tmp, store, NULL, NULL);
}
store[idx] = fix;
Tcl_IncrRefCount(fix);
TclNRAddCallback(interp, TclNRReleaseValues, fix, NULL, NULL, NULL);
}
Tcl_Obj *const *TclEnsembleGetRewriteValues(
Tcl_Interp *interp /* Current interpreter. */
)
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *const *origObjv = iPtr->ensembleRewrite.sourceObjs;
if (origObjv[0] == NULL) {
origObjv = (Tcl_Obj *const *)origObjv[2];
}
return origObjv;
}
/*
*----------------------------------------------------------------------
*
* TclFetchEnsembleRoot --
*
* Returns the root of ensemble rewriting, if any.
|
| ︙ | ︙ | |||
2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 |
Tcl_Obj *const *
TclFetchEnsembleRoot(
Tcl_Interp *interp,
Tcl_Obj *const *objv,
int objc,
int *objcPtr)
{
Interp *iPtr = (Interp *) interp;
if (iPtr->ensembleRewrite.sourceObjs) {
*objcPtr = objc + iPtr->ensembleRewrite.numRemovedObjs
- iPtr->ensembleRewrite.numInsertedObjs;
| > > > > | > > | 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 |
Tcl_Obj *const *
TclFetchEnsembleRoot(
Tcl_Interp *interp,
Tcl_Obj *const *objv,
int objc,
int *objcPtr)
{
Tcl_Obj *const *sourceObjs;
Interp *iPtr = (Interp *) interp;
if (iPtr->ensembleRewrite.sourceObjs) {
*objcPtr = objc + iPtr->ensembleRewrite.numRemovedObjs
- iPtr->ensembleRewrite.numInsertedObjs;
if (iPtr->ensembleRewrite.sourceObjs[0] == NULL) {
sourceObjs = (Tcl_Obj *const *)iPtr->ensembleRewrite.sourceObjs[1];
} else {
sourceObjs = iPtr->ensembleRewrite.sourceObjs;
}
return sourceObjs;
}
*objcPtr = objc;
return objv;
}
/*
* ----------------------------------------------------------------------
|
| ︙ | ︙ | |||
2402 2403 2404 2405 2406 2407 2408 |
Tcl_Obj *objPtr,
EnsembleConfig *ensemblePtr,
Tcl_HashEntry *hPtr,
Tcl_Obj *fix)
{
EnsembleCmdRep *ensembleCmd;
| | | | 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 |
Tcl_Obj *objPtr,
EnsembleConfig *ensemblePtr,
Tcl_HashEntry *hPtr,
Tcl_Obj *fix)
{
EnsembleCmdRep *ensembleCmd;
ECRGetInternalRep(objPtr, ensembleCmd);
if (ensembleCmd) {
TclCleanupCommandMacro(ensembleCmd->token);
if (ensembleCmd->fix) {
Tcl_DecrRefCount(ensembleCmd->fix);
}
} else {
/*
* Kill the old internal rep, and replace it with a brand new one of
* our own.
*/
ensembleCmd = (EnsembleCmdRep *)ckalloc(sizeof(EnsembleCmdRep));
ECRSetInternalRep(objPtr, ensembleCmd);
}
/*
* Populate the internal rep.
*/
ensembleCmd->epoch = ensemblePtr->epoch;
|
| ︙ | ︙ | |||
2583 2584 2585 2586 2587 2588 2589 |
const char *name;
/*
* There is a list of exactly what subcommands go in the table.
* Must determine the target for each.
*/
| | | 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 |
const char *name;
/*
* There is a list of exactly what subcommands go in the table.
* Must determine the target for each.
*/
TclListObjGetElements(NULL, subList, &subc, &subv);
if (subList == mapDict) {
/*
* Strange case where explicit list of subcommands is same value
* as the dict mapping to targets.
*/
for (i = 0; i < subc; i += 2) {
|
| ︙ | ︙ | |||
2825 2826 2827 2828 2829 2830 2831 |
static void
FreeEnsembleCmdRep(
Tcl_Obj *objPtr)
{
EnsembleCmdRep *ensembleCmd;
| | | 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 |
static void
FreeEnsembleCmdRep(
Tcl_Obj *objPtr)
{
EnsembleCmdRep *ensembleCmd;
ECRGetInternalRep(objPtr, ensembleCmd);
TclCleanupCommandMacro(ensembleCmd->token);
if (ensembleCmd->fix) {
Tcl_DecrRefCount(ensembleCmd->fix);
}
ckfree(ensembleCmd);
}
|
| ︙ | ︙ | |||
2859 2860 2861 2862 2863 2864 2865 |
DupEnsembleCmdRep(
Tcl_Obj *objPtr,
Tcl_Obj *copyPtr)
{
EnsembleCmdRep *ensembleCmd;
EnsembleCmdRep *ensembleCopy = (EnsembleCmdRep *)ckalloc(sizeof(EnsembleCmdRep));
| | | | 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 |
DupEnsembleCmdRep(
Tcl_Obj *objPtr,
Tcl_Obj *copyPtr)
{
EnsembleCmdRep *ensembleCmd;
EnsembleCmdRep *ensembleCopy = (EnsembleCmdRep *)ckalloc(sizeof(EnsembleCmdRep));
ECRGetInternalRep(objPtr, ensembleCmd);
ECRSetInternalRep(copyPtr, ensembleCopy);
ensembleCopy->epoch = ensembleCmd->epoch;
ensembleCopy->token = ensembleCmd->token;
ensembleCopy->token->refCount++;
ensembleCopy->fix = ensembleCmd->fix;
if (ensembleCopy->fix) {
Tcl_IncrRefCount(ensembleCopy->fix);
|
| ︙ | ︙ | |||
2984 2985 2986 2987 2988 2989 2990 |
(void) Tcl_GetEnsembleSubcommandList(NULL, ensemble, &listObj);
if (listObj != NULL) {
int sclen;
const char *str;
Tcl_Obj *matchObj = NULL;
| | | 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 |
(void) Tcl_GetEnsembleSubcommandList(NULL, ensemble, &listObj);
if (listObj != NULL) {
int sclen;
const char *str;
Tcl_Obj *matchObj = NULL;
if (TclListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) {
goto failed;
}
for (i=0 ; i<len ; i++) {
str = TclGetStringFromObj(elems[i], &sclen);
if ((sclen == (int) numBytes) && !memcmp(word, str, numBytes)) {
/*
* Exact match! Excellent!
|
| ︙ | ︙ | |||
3104 3105 3106 3107 3108 3109 3110 |
* that we also reject dealing with multi-element rewrites if we are in a
* safe interpreter, as there is otherwise a (highly gnarly!) way to make
* Tcl crash open to exploit.
*/
doneMapLookup:
Tcl_ListObjAppendElement(NULL, replaced, replacement);
| | | 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 |
* that we also reject dealing with multi-element rewrites if we are in a
* safe interpreter, as there is otherwise a (highly gnarly!) way to make
* Tcl crash open to exploit.
*/
doneMapLookup:
Tcl_ListObjAppendElement(NULL, replaced, replacement);
if (TclListObjGetElements(NULL, targetCmdObj, &len, &elems) != TCL_OK) {
goto failed;
} else if (len != 1) {
/*
* Note that at this point we know we can't issue any special
* instruction sequence as the mapping isn't one that we support at
* the compiled level.
*/
|
| ︙ | ︙ | |||
3386 3387 3388 3389 3390 3391 3392 |
/*
* Push the words of the command. Take care; the command words may be
* scripts that have backslashes in them, and [info frame 0] can see the
* difference. Hence the call to TclContinuationsEnterDerived...
*/
| | | 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 |
/*
* Push the words of the command. Take care; the command words may be
* scripts that have backslashes in them, and [info frame 0] can see the
* difference. Hence the call to TclContinuationsEnterDerived...
*/
TclListObjGetElements(NULL, replacements, &numWords, &words);
for (i = 0, tokPtr = parsePtr->tokenPtr; i < parsePtr->numWords;
i++, tokPtr = TokenAfter(tokPtr)) {
if (i > 0 && i < numWords+1) {
bytes = TclGetString(words[i-1]);
PushLiteral(envPtr, bytes, words[i-1]->length);
continue;
}
|
| ︙ | ︙ |
Changes to generic/tclEnv.c.
| ︙ | ︙ | |||
416 417 418 419 420 421 422 423 424 425 426 427 428 429 |
*/
name = Tcl_ExternalToUtfDString(NULL, assignment, -1, &nameString);
value = (char *)strchr(name, '=');
if ((value != NULL) && (value != name)) {
value[0] = '\0';
TclSetEnv(name, value+1);
}
TclEnvEpoch++;
Tcl_DStringFree(&nameString);
return 0;
}
| > > > > > > > > > > | 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 |
*/
name = Tcl_ExternalToUtfDString(NULL, assignment, -1, &nameString);
value = (char *)strchr(name, '=');
if ((value != NULL) && (value != name)) {
value[0] = '\0';
#if defined(_WIN32)
if (tenviron == NULL) {
/*
* When we are started from main(), the _wenviron array could
* be NULL and will be initialized by the first _wgetenv() call.
*/
(void) _wgetenv(L"WINDIR");
}
#endif
TclSetEnv(name, value+1);
}
TclEnvEpoch++;
Tcl_DStringFree(&nameString);
return 0;
}
|
| ︙ | ︙ |
Changes to generic/tclEvent.c.
| ︙ | ︙ | |||
10 11 12 13 14 15 16 17 18 19 20 21 22 23 | * 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. */ #include "tclInt.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. */ | > | 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | * 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. */ #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. */ |
| ︙ | ︙ | |||
225 226 227 228 229 230 231 | * support one handler setting another handler. */ Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix); errPtr = assocPtr->firstBgPtr; | | | 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 | * support one handler setting another handler. */ Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix); errPtr = assocPtr->firstBgPtr; TclListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv); tempObjv = (Tcl_Obj**)ckalloc((prefixObjc+2) * sizeof(Tcl_Obj *)); memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *)); tempObjv[prefixObjc] = errPtr->errorMsg; tempObjv[prefixObjc+1] = errPtr->returnOpts; Tcl_AllowExceptions(interp); code = Tcl_EvalObjv(interp, prefixObjc+2, tempObjv, TCL_EVAL_GLOBAL); |
| ︙ | ︙ | |||
1012 1013 1014 1015 1016 1017 1018 | * dependent. * * 2. so that they can be finalized in a known order w/o causing the * subsequent re-initialization of a subsystem in the act of shutting * down another. * * Results: | | > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 |
* dependent.
*
* 2. so that they can be finalized in a known order w/o causing the
* subsequent re-initialization of a subsystem in the act of shutting
* down another.
*
* Results:
* The full Tcl version with build information.
*
* Side effects:
* Varied, see the respective initialization routines.
*
*-------------------------------------------------------------------------
*/
MODULE_SCOPE const TclStubs tclStubs;
#ifndef STRINGIFY
# define STRINGIFY(x) STRINGIFY1(x)
# define STRINGIFY1(x) #x
#endif
static const struct {
const TclStubs *stubs;
const char version[256];
} stubInfo = {
&tclStubs, {TCL_PATCH_LEVEL "+" STRINGIFY(TCL_VERSION_UUID)
#if defined(__clang__) && defined(__clang_major__)
".clang-" STRINGIFY(__clang_major__)
#if __clang_minor__ < 10
"0"
#endif
STRINGIFY(__clang_minor__)
#endif
#ifdef TCL_COMPILE_DEBUG
".compiledebug"
#endif
#ifdef TCL_COMPILE_STATS
".compilestats"
#endif
#if defined(__cplusplus) && !defined(__OBJC__)
".cplusplus"
#endif
#ifndef NDEBUG
".debug"
#endif
#if !defined(__clang__) && !defined(__INTEL_COMPILER) && defined(__GNUC__)
".gcc-" STRINGIFY(__GNUC__)
#if __GNUC_MINOR__ < 10
"0"
#endif
STRINGIFY(__GNUC_MINOR__)
#endif
#ifdef __INTEL_COMPILER
".icc-" STRINGIFY(__INTEL_COMPILER)
#endif
#if (defined(_WIN32) && !defined(_WIN64)) || (ULONG_MAX == 0xffffffffUL)
".ilp32"
#endif
#ifdef TCL_MEM_DEBUG
".memdebug"
#endif
#if defined(_MSC_VER)
".msvc-" STRINGIFY(_MSC_VER)
#endif
#ifdef USE_NMAKE
".nmake"
#endif
#ifdef TCL_NO_DEPRECATED
".no-deprecate"
#endif
#if !TCL_THREADS
".no-thread"
#endif
#ifndef TCL_CFG_OPTIMIZED
".no-optimize"
#endif
#ifdef __OBJC__
".objective-c"
#if defined(__cplusplus)
"plusplus"
#endif
#endif
#ifdef TCL_CFG_PROFILED
".profile"
#endif
#ifdef PURIFY
".purify"
#endif
#ifdef STATIC_BUILD
".static"
#endif
#if TCL_UTF_MAX < 4
".utf-16"
#endif
}};
const char *
Tcl_InitSubsystems(void)
{
if (inExit != 0) {
Tcl_Panic("Tcl_InitSubsystems called while exiting");
}
if (subsystemsInitialized == 0) {
|
| ︙ | ︙ | |||
1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 |
TclInitEncodingSubsystem(); /* Process wide encoding init. */
TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */
subsystemsInitialized = 1;
}
TclpInitUnlock();
}
TclInitNotifier();
}
/*
*----------------------------------------------------------------------
*
* Tcl_Finalize --
*
| > | 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 |
TclInitEncodingSubsystem(); /* Process wide encoding init. */
TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */
subsystemsInitialized = 1;
}
TclpInitUnlock();
}
TclInitNotifier();
return stubInfo.version;
}
/*
*----------------------------------------------------------------------
*
* Tcl_Finalize --
*
|
| ︙ | ︙ | |||
1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 |
cdPtr->clientData = clientData;
result = TclpThreadCreate(idPtr, NewThreadProc, cdPtr, stackSize, flags);
if (result != TCL_OK) {
ckfree(cdPtr);
}
return result;
#else
return TCL_ERROR;
#endif /* TCL_THREADS */
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
| > > > > > > | 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 |
cdPtr->clientData = clientData;
result = TclpThreadCreate(idPtr, NewThreadProc, cdPtr, stackSize, flags);
if (result != TCL_OK) {
ckfree(cdPtr);
}
return result;
#else
(void)idPtr;
(void)proc;
(void)clientData;
(void)stackSize;
(void)flags;
return TCL_ERROR;
#endif /* TCL_THREADS */
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Changes to generic/tclExecute.c.
| ︙ | ︙ | |||
189 190 191 192 193 194 195 |
do { \
tosPtr = esPtr->tosPtr; \
} while (0)
#define PUSH_TAUX_OBJ(objPtr) \
do { \
if (auxObjList) { \
| | | | | 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 |
do { \
tosPtr = esPtr->tosPtr; \
} while (0)
#define PUSH_TAUX_OBJ(objPtr) \
do { \
if (auxObjList) { \
(objPtr)->length += auxObjList->length; \
} \
(objPtr)->internalRep.twoPtrValue.ptr1 = auxObjList; \
auxObjList = (objPtr); \
} while (0)
#define POP_TAUX_OBJ() \
do { \
tmpPtr = auxObjList; \
auxObjList = (Tcl_Obj *)tmpPtr->internalRep.twoPtrValue.ptr1; \
Tcl_DecrRefCount(tmpPtr); \
|
| ︙ | ︙ | |||
501 502 503 504 505 506 507 |
} while (0)
/*
* Macro used in this file to save a function call for common uses of
* TclGetNumberFromObj(). The ANSI C "prototype" is:
*
* MODULE_SCOPE int GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
| | | | | | 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 |
} while (0)
/*
* Macro used in this file to save a function call for common uses of
* TclGetNumberFromObj(). 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) = (ClientData) \
(&((objPtr)->internalRep.wideValue)), TCL_OK) : \
TclHasInternalRep((objPtr), &tclDoubleType) \
? (((isnan((objPtr)->internalRep.doubleValue)) \
? (*(tPtr) = TCL_NUMBER_NAN) \
: (*(tPtr) = TCL_NUMBER_DOUBLE)), \
*(ptrPtr) = (ClientData) \
(&((objPtr)->internalRep.doubleValue)), TCL_OK) : \
(((objPtr)->bytes != NULL) && ((objPtr)->length == 0)) \
? TCL_ERROR : \
TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
|
| ︙ | ︙ | |||
665 666 667 668 669 670 671 | #define OUT_OF_MEMORY ((Tcl_Obj *) -4) /* * Declarations for local procedures to this file: */ #ifdef TCL_COMPILE_STATS | | | 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 | #define OUT_OF_MEMORY ((Tcl_Obj *) -4) /* * Declarations for local procedures to this file: */ #ifdef TCL_COMPILE_STATS static int EvalStatsCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); #endif /* TCL_COMPILE_STATS */ #ifdef TCL_COMPILE_DEBUG static const char * GetOpcodeName(const unsigned char *pc); static void PrintByteCodeInfo(ByteCode *codePtr); static const char * StringForResultCode(int result); |
| ︙ | ︙ | |||
755 756 757 758 759 760 761 |
static void
ReleaseDictIterator(
Tcl_Obj *objPtr)
{
Tcl_DictSearch *searchPtr;
Tcl_Obj *dictPtr;
| | | | 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 |
static void
ReleaseDictIterator(
Tcl_Obj *objPtr)
{
Tcl_DictSearch *searchPtr;
Tcl_Obj *dictPtr;
const Tcl_ObjInternalRep *irPtr;
irPtr = TclFetchInternalRep(objPtr, &dictIteratorType);
assert(irPtr != NULL);
/*
* First kill the search, and then release the reference to the dictionary
* that we were holding.
*/
|
| ︙ | ︙ | |||
1361 1362 1363 1364 1365 1366 1367 |
NULL, NULL);
Tcl_NRExprObj(interp, objPtr, resultPtr);
return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
}
static int
CopyCallback(
| | | 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 |
NULL, NULL);
Tcl_NRExprObj(interp, objPtr, resultPtr);
return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
}
static int
CopyCallback(
void *data[],
TCL_UNUSED(Tcl_Interp *),
int result)
{
Tcl_Obj **resultPtrPtr = (Tcl_Obj **)data[0];
Tcl_Obj *resultPtr = (Tcl_Obj *)data[1];
if (result == TCL_OK) {
|
| ︙ | ︙ | |||
1419 1420 1421 1422 1423 1424 1425 |
Tcl_NRAddCallback(interp, ExprObjCallback, state, resultPtr,
NULL, NULL);
return TclNRExecuteByteCode(interp, codePtr);
}
static int
ExprObjCallback(
| | | 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 |
Tcl_NRAddCallback(interp, ExprObjCallback, state, resultPtr,
NULL, NULL);
return TclNRExecuteByteCode(interp, codePtr);
}
static int
ExprObjCallback(
void *data[],
Tcl_Interp *interp,
int result)
{
Tcl_InterpState state = (Tcl_InterpState)data[0];
Tcl_Obj *resultPtr = (Tcl_Obj *)data[1];
if (result == TCL_OK) {
|
| ︙ | ︙ | |||
1470 1471 1472 1473 1474 1475 1476 |
* to avoid compiler warning. */
/*
* Get the expression ByteCode from the object. If it exists, make sure it
* is valid in the current context.
*/
| | | | 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 |
* to avoid compiler warning. */
/*
* Get the expression ByteCode from the object. If it exists, make sure it
* is valid in the current context.
*/
ByteCodeGetInternalRep(objPtr, &exprCodeType, codePtr);
if (codePtr != NULL) {
Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;
if (((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != namespacePtr)
|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)
|| (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) {
Tcl_StoreInternalRep(objPtr, &exprCodeType, NULL);
codePtr = NULL;
}
}
if (codePtr == NULL) {
/*
* TIP #280: No invoker (yet) - Expression compilation.
|
| ︙ | ︙ | |||
1534 1535 1536 1537 1538 1539 1540 | /* *---------------------------------------------------------------------- * * DupExprCodeInternalRep -- * * Part of the Tcl object type implementation for Tcl expression | | | | 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 | /* *---------------------------------------------------------------------- * * DupExprCodeInternalRep -- * * Part of the Tcl object type implementation for Tcl expression * bytecode. We do not copy the bytecode internalrep. Instead, we return * without setting copyPtr->typePtr, so the copy is a plain string copy * of the expression value, and if it is to be used as a compiled * expression, it will just need a recompile. * * This makes sense, because with Tcl's copy-on-write practices, the * usual (only?) time Tcl_DuplicateObj() will be called is when the copy * is about to be modified, which would invalidate any copied bytecode * anyway. The only reason it might make sense to copy the bytecode is if * we had some modifying routines that operated directly on the internalrep, * like we do for lists and dicts. * * Results: * None. * * Side effects: * None. |
| ︙ | ︙ | |||
1586 1587 1588 1589 1590 1591 1592 |
*/
static void
FreeExprCodeInternalRep(
Tcl_Obj *objPtr)
{
ByteCode *codePtr;
| | | 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 |
*/
static void
FreeExprCodeInternalRep(
Tcl_Obj *objPtr)
{
ByteCode *codePtr;
ByteCodeGetInternalRep(objPtr, &exprCodeType, codePtr);
assert(codePtr != NULL);
TclReleaseByteCode(codePtr);
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
1625 1626 1627 1628 1629 1630 1631 |
/*
* If the object is not already of tclByteCodeType, compile it (and reset
* the compilation flags in the interpreter; this should be done after any
* compilation). Otherwise, check that it is "fresh" enough.
*/
| | | 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 |
/*
* If the object is not already of tclByteCodeType, compile it (and reset
* the compilation flags in the interpreter; this should be done after any
* compilation). Otherwise, check that it is "fresh" enough.
*/
ByteCodeGetInternalRep(objPtr, &tclByteCodeType, codePtr);
if (codePtr != NULL) {
/*
* Make sure the Bytecode hasn't been invalidated by, e.g., someone
* redefining a command with a compile procedure (this might make the
* compiled code wrong). The object needs to be recompiled if it was
* compiled in/for a different interpreter, or for a different
* namespace, or for the same namespace but with different name
|
| ︙ | ︙ | |||
1771 1772 1773 1774 1775 1776 1777 |
* information.
*/
iPtr->invokeCmdFramePtr = invoker;
iPtr->invokeWord = word;
TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
iPtr->invokeCmdFramePtr = NULL;
| | | 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 |
* information.
*/
iPtr->invokeCmdFramePtr = invoker;
iPtr->invokeWord = word;
TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
iPtr->invokeCmdFramePtr = NULL;
ByteCodeGetInternalRep(objPtr, &tclByteCodeType, codePtr);
if (iPtr->varFramePtr->localCachePtr) {
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
}
return codePtr;
}
|
| ︙ | ︙ | |||
1805 1806 1807 1808 1809 1810 1811 |
int
TclIncrObj(
Tcl_Interp *interp,
Tcl_Obj *valuePtr,
Tcl_Obj *incrPtr)
{
| | | 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 |
int
TclIncrObj(
Tcl_Interp *interp,
Tcl_Obj *valuePtr,
Tcl_Obj *incrPtr)
{
void *ptr1, *ptr2;
int type1, type2;
mp_int value, incr;
mp_err err;
if (Tcl_IsShared(valuePtr)) {
Tcl_Panic("%s called with shared object", "TclIncrObj");
}
|
| ︙ | ︙ | |||
1853 1854 1855 1856 1857 1858 1859 |
}
if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
Tcl_WideInt w1, w2, sum;
w1 = *((const Tcl_WideInt *)ptr1);
w2 = *((const Tcl_WideInt *)ptr2);
| | | 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 |
}
if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
Tcl_WideInt w1, w2, sum;
w1 = *((const Tcl_WideInt *)ptr1);
w2 = *((const Tcl_WideInt *)ptr2);
sum = (Tcl_WideInt)((Tcl_WideUInt)w1 + (Tcl_WideUInt)w2);
/*
* Check for overflow.
*/
if (!Overflowing(w1, w2, sum)) {
TclSetIntObj(valuePtr, sum);
|
| ︙ | ︙ | |||
2015 2016 2017 2018 2019 2020 2021 |
iPtr->evalFlags &= ~TCL_EVAL_DISCARD_RESULT;
return TCL_OK;
}
static int
TEBCresume(
| | | 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 |
iPtr->evalFlags &= ~TCL_EVAL_DISCARD_RESULT;
return TCL_OK;
}
static int
TEBCresume(
void *data[],
Tcl_Interp *interp,
int result)
{
/*
* Compiler cast directive - not a real variable.
* Interp *iPtr = (Interp *) interp;
*/
|
| ︙ | ︙ | |||
2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 |
* yield. The yield is switched into multi-return mode (via the
* 'yieldParameter').
*/
Tcl_IncrRefCount(valuePtr);
iPtr->execEnvPtr = corPtr->callerEEPtr;
TclSetTailcall(interp, valuePtr);
iPtr->execEnvPtr = corPtr->eePtr;
yieldParameter = (PTR2INT(NULL)+1); /*==CORO_ACTIVATE_YIELDM*/
doYield:
/* TIP #280: Record the last piece of info needed by
* 'TclGetSrcInfoForPc', and push the frame.
*/
| > | 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 |
* yield. The yield is switched into multi-return mode (via the
* 'yieldParameter').
*/
Tcl_IncrRefCount(valuePtr);
iPtr->execEnvPtr = corPtr->callerEEPtr;
TclSetTailcall(interp, valuePtr);
corPtr->yieldPtr = valuePtr;
iPtr->execEnvPtr = corPtr->eePtr;
yieldParameter = (PTR2INT(NULL)+1); /*==CORO_ACTIVATE_YIELDM*/
doYield:
/* TIP #280: Record the last piece of info needed by
* 'TclGetSrcInfoForPc', and push the frame.
*/
|
| ︙ | ︙ | |||
3019 3020 3021 3022 3023 3024 3025 | DECACHE_STACK_INFO(); pc += 6; TEBC_YIELD(); TclMarkTailcall(interp); TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); | | | 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 |
DECACHE_STACK_INFO();
pc += 6;
TEBC_YIELD();
TclMarkTailcall(interp);
TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
TclListObjGetElements(NULL, objPtr, &objc, &objv);
TclNRAddCallback(interp, TclNRReleaseValues, objPtr, NULL, NULL, NULL);
return TclNREvalObjv(interp, objc, objv, TCL_EVAL_INVOKE, NULL);
/*
* -----------------------------------------------------------------
* Start of INST_LOAD instructions.
*
|
| ︙ | ︙ | |||
3699 3700 3701 3702 3703 3704 3705 |
cleanup = 0;
varPtr = LOCAL(opnd);
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
if (TclIsVarDirectModifyable(varPtr)) {
| | | | 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 |
cleanup = 0;
varPtr = LOCAL(opnd);
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
if (TclIsVarDirectModifyable(varPtr)) {
void *ptr;
int type;
objPtr = varPtr->value.objPtr;
if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK) {
if (type == TCL_NUMBER_INT) {
Tcl_WideInt augend = *((const Tcl_WideInt *)ptr);
Tcl_WideInt sum = (Tcl_WideInt)((Tcl_WideUInt)augend + (Tcl_WideUInt)increment);
/*
* Overflow when (augend and sum have different sign) and
* (augend and increment have the same sign). This is
* encapsulated in the Overflowing macro.
*/
|
| ︙ | ︙ | |||
4859 4860 4861 4862 4863 4864 4865 |
TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
/*
* Extract the desired list element.
*/
if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK)
| | | 4860 4861 4862 4863 4864 4865 4866 4867 4868 4869 4870 4871 4872 4873 4874 |
TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
/*
* Extract the desired list element.
*/
if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK)
&& !TclHasInternalRep(value2Ptr, &tclListType)) {
int code;
DECACHE_STACK_INFO();
code = TclGetIntForIndexM(interp, value2Ptr, objc-1, &index);
CACHE_STACK_INFO();
if (code == TCL_OK) {
TclDecrRefCount(value2Ptr);
|
| ︙ | ︙ | |||
5257 5258 5259 5260 5261 5262 5263 |
length = Tcl_UtfToUpper(TclGetString(objResultPtr));
Tcl_SetObjLength(objResultPtr, length);
TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
} else {
length = Tcl_UtfToUpper(TclGetString(valuePtr));
Tcl_SetObjLength(valuePtr, length);
| | | | | 5258 5259 5260 5261 5262 5263 5264 5265 5266 5267 5268 5269 5270 5271 5272 5273 5274 5275 5276 5277 5278 5279 5280 5281 5282 5283 5284 5285 5286 5287 5288 5289 5290 5291 5292 5293 5294 5295 5296 5297 5298 5299 5300 5301 5302 5303 5304 5305 5306 |
length = Tcl_UtfToUpper(TclGetString(objResultPtr));
Tcl_SetObjLength(objResultPtr, length);
TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
} else {
length = Tcl_UtfToUpper(TclGetString(valuePtr));
Tcl_SetObjLength(valuePtr, length);
TclFreeInternalRep(valuePtr);
TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
case INST_STR_LOWER:
valuePtr = OBJ_AT_TOS;
TRACE(("\"%.20s\" => ", O2S(valuePtr)));
if (Tcl_IsShared(valuePtr)) {
s1 = TclGetStringFromObj(valuePtr, &length);
TclNewStringObj(objResultPtr, s1, length);
length = Tcl_UtfToLower(TclGetString(objResultPtr));
Tcl_SetObjLength(objResultPtr, length);
TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
} else {
length = Tcl_UtfToLower(TclGetString(valuePtr));
Tcl_SetObjLength(valuePtr, length);
TclFreeInternalRep(valuePtr);
TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
case INST_STR_TITLE:
valuePtr = OBJ_AT_TOS;
TRACE(("\"%.20s\" => ", O2S(valuePtr)));
if (Tcl_IsShared(valuePtr)) {
s1 = TclGetStringFromObj(valuePtr, &length);
TclNewStringObj(objResultPtr, s1, length);
length = Tcl_UtfToTitle(TclGetString(objResultPtr));
Tcl_SetObjLength(objResultPtr, length);
TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
} else {
length = Tcl_UtfToTitle(TclGetString(valuePtr));
Tcl_SetObjLength(valuePtr, length);
TclFreeInternalRep(valuePtr);
TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
case INST_STR_INDEX:
value2Ptr = OBJ_AT_TOS;
valuePtr = OBJ_UNDER_TOS;
|
| ︙ | ︙ | |||
5365 5366 5367 5368 5369 5370 5371 |
&toIdx) != TCL_OK) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
CACHE_STACK_INFO();
| < < < | < < < | | | 5366 5367 5368 5369 5370 5371 5372 5373 5374 5375 5376 5377 5378 5379 5380 5381 5382 5383 |
&toIdx) != TCL_OK) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
CACHE_STACK_INFO();
if (toIdx < 0) {
TclNewObj(objResultPtr);
} else {
objResultPtr = Tcl_GetRange(OBJ_AT_DEPTH(2), fromIdx, toIdx);
}
TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_V(1, 3, 1);
case INST_STR_RANGE_IMM:
valuePtr = OBJ_AT_TOS;
fromIdx = TclGetInt4AtPtr(pc+1);
|
| ︙ | ︙ | |||
5400 5401 5402 5403 5404 5405 5406 |
/*
assert ( toIdx != TCL_INDEX_NONE );
*
* Extra safety for legacy bytecodes:
*/
if (toIdx == TCL_INDEX_NONE) {
| | < | | < < < < < < < < | | | | | | | | < | | < < | < < | < | > | 5395 5396 5397 5398 5399 5400 5401 5402 5403 5404 5405 5406 5407 5408 5409 5410 5411 5412 5413 5414 5415 5416 5417 5418 5419 5420 5421 5422 5423 5424 5425 |
/*
assert ( toIdx != TCL_INDEX_NONE );
*
* Extra safety for legacy bytecodes:
*/
if (toIdx == TCL_INDEX_NONE) {
TclNewObj(objResultPtr);
} else {
toIdx = TclIndexDecode(toIdx, length - 1);
/*
assert ( fromIdx != TCL_INDEX_NONE );
*
* Extra safety for legacy bytecodes:
*/
if (fromIdx == TCL_INDEX_NONE) {
fromIdx = TCL_INDEX_START;
}
fromIdx = TclIndexDecode(fromIdx, length - 1);
if (toIdx < 0) {
TclNewObj(objResultPtr);
} else {
objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
}
}
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
NEXT_INST_F(9, 1, 1);
{
Tcl_UniChar *ustring1, *ustring2, *ustring3, *end, *p;
int length3, endIdx;
|
| ︙ | ︙ | |||
5533 5534 5535 5536 5537 5538 5539 |
}
ustring3 = Tcl_GetUnicodeFromObj(value3Ptr, &length3);
objResultPtr = Tcl_NewUnicodeObj(ustring1, 0);
p = ustring1;
end = ustring1 + length;
for (; ustring1 < end; ustring1++) {
| | > > | 5514 5515 5516 5517 5518 5519 5520 5521 5522 5523 5524 5525 5526 5527 5528 5529 5530 |
}
ustring3 = Tcl_GetUnicodeFromObj(value3Ptr, &length3);
objResultPtr = Tcl_NewUnicodeObj(ustring1, 0);
p = ustring1;
end = ustring1 + length;
for (; ustring1 < end; ustring1++) {
if ((*ustring1 == *ustring2) &&
/* Fix bug [69218ab7b]: restrict max compare length. */
(end-ustring1 >= length2) && (length2==1 ||
memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2)
== 0)) {
if (p != ustring1) {
Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1-p);
p = ustring1 + length2;
} else {
p += length2;
|
| ︙ | ︙ | |||
5605 5606 5607 5608 5609 5610 5611 | value2Ptr = OBJ_UNDER_TOS; /* Pattern */ /* * Check that at least one of the objects is Unicode before promoting * both. */ | | | | 5588 5589 5590 5591 5592 5593 5594 5595 5596 5597 5598 5599 5600 5601 5602 5603 |
value2Ptr = OBJ_UNDER_TOS; /* Pattern */
/*
* Check that at least one of the objects is Unicode before promoting
* both.
*/
if (TclHasInternalRep(valuePtr, &tclStringType)
|| TclHasInternalRep(value2Ptr, &tclStringType)) {
Tcl_UniChar *ustring1, *ustring2;
ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
match = TclUniCharMatch(ustring1, length, ustring2, length2,
nocase);
} else if (TclIsPureByteArray(valuePtr) && !nocase) {
|
| ︙ | ︙ | |||
5738 5739 5740 5741 5742 5743 5744 |
/*
* End of string-related instructions.
* -----------------------------------------------------------------
* Start of numeric operator instructions.
*/
{
| | | 5721 5722 5723 5724 5725 5726 5727 5728 5729 5730 5731 5732 5733 5734 5735 |
/*
* End of string-related instructions.
* -----------------------------------------------------------------
* Start of numeric operator instructions.
*/
{
void *ptr1, *ptr2;
int type1, type2;
Tcl_WideInt w1, w2, wResult;
case INST_NUM_TYPE:
if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
type1 = 0;
} else if (type1 == TCL_NUMBER_BIG) {
|
| ︙ | ︙ | |||
5917 5918 5919 5920 5921 5922 5923 |
*/
if ((wResult < 0 || (wResult == 0 &&
((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) &&
(wResult * w2 != w1)) {
wResult -= 1;
}
| | > | 5900 5901 5902 5903 5904 5905 5906 5907 5908 5909 5910 5911 5912 5913 5914 5915 |
*/
if ((wResult < 0 || (wResult == 0 &&
((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) &&
(wResult * w2 != w1)) {
wResult -= 1;
}
wResult = (Tcl_WideInt)((Tcl_WideUInt)w1 -
(Tcl_WideUInt)w2*(Tcl_WideUInt)wResult);
goto wideResultOfArithmetic;
}
break;
case INST_RSHIFT:
if (w2 < 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
| ︙ | ︙ | |||
6012 6013 6014 6015 6016 6017 6018 |
} else {
int shift = (int) w2;
/*
* Handle shifts within the native long range.
*/
| | | | | 5996 5997 5998 5999 6000 6001 6002 6003 6004 6005 6006 6007 6008 6009 6010 6011 6012 6013 |
} else {
int shift = (int) w2;
/*
* Handle shifts within the native long range.
*/
if (((size_t) shift < CHAR_BIT*sizeof(long))
&& !((w1>0 ? w1 : ~w1) &
-(1UL<<(CHAR_BIT*sizeof(long) - 1 - shift)))) {
wResult = (Tcl_WideUInt)w1 << shift;
goto wideResultOfArithmetic;
}
}
/*
* Too large; need to use the broken-out function.
*/
|
| ︙ | ︙ | |||
6124 6125 6126 6127 6128 6129 6130 |
if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
w1 = *((const Tcl_WideInt *)ptr1);
w2 = *((const Tcl_WideInt *)ptr2);
switch (*pc) {
case INST_ADD:
| | | | 6108 6109 6110 6111 6112 6113 6114 6115 6116 6117 6118 6119 6120 6121 6122 6123 6124 6125 6126 6127 6128 6129 6130 6131 6132 6133 |
if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
w1 = *((const Tcl_WideInt *)ptr1);
w2 = *((const Tcl_WideInt *)ptr2);
switch (*pc) {
case INST_ADD:
wResult = (Tcl_WideInt)((Tcl_WideUInt)w1 + (Tcl_WideUInt)w2);
/*
* Check for overflow.
*/
if (Overflowing(w1, w2, wResult)) {
goto overflow;
}
goto wideResultOfArithmetic;
case INST_SUB:
wResult = (Tcl_WideInt)((Tcl_WideUInt)w1 - (Tcl_WideUInt)w2);
/*
* Must check for overflow. The macro tests for overflows in
* sums by looking at the sign bits. As we have a subtraction
* here, we are adding -w2. As -w2 could in turn overflow, we
* test with ~w2 instead: it has the opposite sign bit to w2
* so it does the job. Note that the only "bad" case (w2==0)
* is irrelevant for this macro, as in that case w1 and
|
| ︙ | ︙ | |||
6395 6396 6397 6398 6399 6400 6401 |
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
| | | 6379 6380 6381 6382 6383 6384 6385 6386 6387 6388 6389 6390 6391 6392 6393 |
if (valuePtr->bytes == NULL) {
TRACE_APPEND(("numeric, same Tcl_Obj\n"));
NEXT_INST_F(1, 0, 0);
}
if (Tcl_IsShared(valuePtr)) {
/*
* Here we do some surgery within the Tcl_Obj internals. We want
* to copy the internalrep, but not the string, so we temporarily hide
* the string so we do not copy it.
*/
char *savedString = valuePtr->bytes;
valuePtr->bytes = NULL;
objResultPtr = Tcl_DuplicateObj(valuePtr);
|
| ︙ | ︙ | |||
6420 6421 6422 6423 6424 6425 6426 |
/*
* End of numeric operator instructions.
* -----------------------------------------------------------------
*/
case INST_TRY_CVT_TO_BOOLEAN:
valuePtr = OBJ_AT_TOS;
| | | 6404 6405 6406 6407 6408 6409 6410 6411 6412 6413 6414 6415 6416 6417 6418 |
/*
* 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);
|
| ︙ | ︙ | |||
7255 7256 7257 7258 7259 7260 7261 |
dictPtr = POP_OBJECT();
searchPtr = (Tcl_DictSearch *)ckalloc(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
| | | | | | | | 7239 7240 7241 7242 7243 7244 7245 7246 7247 7248 7249 7250 7251 7252 7253 7254 7255 7256 7257 7258 7259 7260 7261 7262 7263 7264 7265 7266 7267 7268 7269 7270 7271 7272 7273 7274 7275 7276 7277 7278 7279 7280 7281 7282 7283 7284 7285 7286 7287 7288 |
dictPtr = POP_OBJECT();
searchPtr = (Tcl_DictSearch *)ckalloc(sizeof(Tcl_DictSearch));
if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr,
&valuePtr, &done) != TCL_OK) {
/*
* dictPtr is no longer on the stack, and we're not
* moving it into the internalrep of an iterator. We need
* to drop the refcount [Tcl Bug 9b352768e6].
*/
Tcl_DecrRefCount(dictPtr);
ckfree(searchPtr);
TRACE_ERROR(interp);
goto gotError;
}
{
Tcl_ObjInternalRep ir;
TclNewObj(statePtr);
ir.twoPtrValue.ptr1 = searchPtr;
ir.twoPtrValue.ptr2 = dictPtr;
Tcl_StoreInternalRep(statePtr, &dictIteratorType, &ir);
}
varPtr = LOCAL(opnd);
if (varPtr->value.objPtr) {
if (TclHasInternalRep(varPtr->value.objPtr, &dictIteratorType)) {
Tcl_Panic("mis-issued dictFirst!");
}
TclDecrRefCount(varPtr->value.objPtr);
}
varPtr->value.objPtr = statePtr;
Tcl_IncrRefCount(statePtr);
goto pushDictIteratorResult;
case INST_DICT_NEXT:
opnd = TclGetUInt4AtPtr(pc+1);
TRACE(("%u => ", opnd));
statePtr = (*LOCAL(opnd)).value.objPtr;
{
const Tcl_ObjInternalRep *irPtr;
if (statePtr &&
(irPtr = TclFetchInternalRep(statePtr, &dictIteratorType))) {
searchPtr = (Tcl_DictSearch *)irPtr->twoPtrValue.ptr1;
Tcl_DictObjNext(searchPtr, &keyPtr, &valuePtr, &done);
} else {
Tcl_Panic("mis-issued dictNext!");
}
}
pushDictIteratorResult:
|
| ︙ | ︙ | |||
7542 7543 7544 7545 7546 7547 7548 |
Tcl_WideInt wval;
Tcl_Time now;
switch(TclGetUInt1AtPtr(pc+1)) {
case 0: /* clicks */
#ifdef TCL_WIDE_CLICKS
wval = TclpGetWideClicks();
#else
| | | | | | 7526 7527 7528 7529 7530 7531 7532 7533 7534 7535 7536 7537 7538 7539 7540 7541 7542 7543 7544 7545 7546 7547 7548 7549 7550 7551 7552 7553 |
Tcl_WideInt wval;
Tcl_Time now;
switch(TclGetUInt1AtPtr(pc+1)) {
case 0: /* clicks */
#ifdef TCL_WIDE_CLICKS
wval = TclpGetWideClicks();
#else
wval = (Tcl_WideInt)TclpGetClicks();
#endif
break;
case 1: /* microseconds */
Tcl_GetTime(&now);
wval = (Tcl_WideInt)now.sec * 1000000 + now.usec;
break;
case 2: /* milliseconds */
Tcl_GetTime(&now);
wval = (Tcl_WideInt)now.sec * 1000 + now.usec / 1000;
break;
case 3: /* seconds */
Tcl_GetTime(&now);
wval = (Tcl_WideInt)now.sec;
break;
default:
Tcl_Panic("clockRead instruction with unknown clock#");
}
TclNewIntObj(objResultPtr, wval);
TRACE_WITH_OBJ(("=> "), objResultPtr);
NEXT_INST_F(2, 0, 1);
|
| ︙ | ︙ | |||
7815 7816 7817 7818 7819 7820 7821 |
TclDecrRefCount(valuePtr);
}
#ifdef TCL_COMPILE_DEBUG
if (traceInstructions) {
fprintf(stdout, " ... found catch at %d, catchTop=%d, "
"unwound to %ld, new pc %u\n",
rangePtr->codeOffset, (int) (catchTop - initCatchTop - 1),
| | | 7799 7800 7801 7802 7803 7804 7805 7806 7807 7808 7809 7810 7811 7812 7813 |
TclDecrRefCount(valuePtr);
}
#ifdef TCL_COMPILE_DEBUG
if (traceInstructions) {
fprintf(stdout, " ... found catch at %d, catchTop=%d, "
"unwound to %ld, new pc %u\n",
rangePtr->codeOffset, (int) (catchTop - initCatchTop - 1),
(long)*catchTop, (unsigned) rangePtr->catchOffset);
}
#endif
pc = (codePtr->codeStart + rangePtr->catchOffset);
NEXT_INST_F(0, 0, 0); /* Restart the execution loop at pc. */
/*
* end of infinite loop dispatching on instructions.
|
| ︙ | ︙ | |||
7919 7920 7921 7922 7923 7924 7925 | #undef auxObjList #undef catchTop #undef TCONST #undef esPtr static int FinalizeOONext( | | | 7903 7904 7905 7906 7907 7908 7909 7910 7911 7912 7913 7914 7915 7916 7917 |
#undef auxObjList
#undef catchTop
#undef TCONST
#undef esPtr
static int
FinalizeOONext(
void *data[],
Tcl_Interp *interp,
int result)
{
Interp *iPtr = (Interp *) interp;
CallContext *contextPtr = (CallContext *)data[1];
/*
|
| ︙ | ︙ | |||
7945 7946 7947 7948 7949 7950 7951 |
contextPtr->skip = PTR2INT(data[3]);
contextPtr->oPtr->flags &= ~FILTER_HANDLING;
return result;
}
static int
FinalizeOONextFilter(
| | | 7929 7930 7931 7932 7933 7934 7935 7936 7937 7938 7939 7940 7941 7942 7943 |
contextPtr->skip = PTR2INT(data[3]);
contextPtr->oPtr->flags &= ~FILTER_HANDLING;
return result;
}
static int
FinalizeOONextFilter(
void *data[],
Tcl_Interp *interp,
int result)
{
Interp *iPtr = (Interp *) interp;
CallContext *contextPtr = (CallContext *)data[1];
/*
|
| ︙ | ︙ | |||
8091 8092 8093 8094 8095 8096 8097 |
Tcl_Obj *valuePtr, /* The first operand on the stack. */
Tcl_Obj *value2Ptr) /* The second operand on the stack. */
{
#define WIDE_RESULT(w) \
if (Tcl_IsShared(valuePtr)) { \
return Tcl_NewWideIntObj(w); \
} else { \
| | | | | 8075 8076 8077 8078 8079 8080 8081 8082 8083 8084 8085 8086 8087 8088 8089 8090 8091 8092 8093 8094 8095 8096 8097 8098 8099 8100 8101 8102 8103 8104 8105 8106 8107 8108 8109 |
Tcl_Obj *valuePtr, /* The first operand on the stack. */
Tcl_Obj *value2Ptr) /* The second operand on the stack. */
{
#define WIDE_RESULT(w) \
if (Tcl_IsShared(valuePtr)) { \
return Tcl_NewWideIntObj(w); \
} else { \
TclSetIntObj(valuePtr, (w)); \
return NULL; \
}
#define BIG_RESULT(b) \
if (Tcl_IsShared(valuePtr)) { \
return Tcl_NewBignumObj(b); \
} else { \
Tcl_SetBignumObj(valuePtr, (b)); \
return NULL; \
}
#define DOUBLE_RESULT(d) \
if (Tcl_IsShared(valuePtr)) { \
TclNewDoubleObj(objResultPtr, (d)); \
return objResultPtr; \
} else { \
Tcl_SetDoubleObj(valuePtr, (d)); \
return NULL; \
}
int type1, type2;
void *ptr1, *ptr2;
double d1, d2, dResult;
Tcl_WideInt w1, w2, wResult;
mp_int big1, big2, bigResult, bigRemainder;
Tcl_Obj *objResultPtr;
int invalid, zero;
long shift;
mp_err err;
|
| ︙ | ︙ | |||
8161 8162 8163 8164 8165 8166 8167 | wQuotient = w1 / w2; /* * Force Tcl's integer division rules. * TODO: examine for logic simplification */ | | | | | > | | 8145 8146 8147 8148 8149 8150 8151 8152 8153 8154 8155 8156 8157 8158 8159 8160 8161 8162 8163 8164 8165 8166 8167 8168 8169 8170 8171 8172 8173 8174 |
wQuotient = w1 / w2;
/*
* Force Tcl's integer division rules.
* TODO: examine for logic simplification
*/
if (((wQuotient < 0)
|| ((wQuotient == 0)
&& ((w1 < 0 && w2 > 0)
|| (w1 > 0 && w2 < 0))))
&& (wQuotient * w2 != w1)) {
wQuotient -= 1;
}
wRemainder = (Tcl_WideInt)((Tcl_WideUInt)w1 -
(Tcl_WideUInt)w2*(Tcl_WideUInt)wQuotient);
WIDE_RESULT(wRemainder);
}
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
/* TODO: internals intrusion */
if ((w1 > ((Tcl_WideInt)0)) ^ !mp_isneg(&big2)) {
/*
* Arguments are opposite sign; remainder is sum.
*/
err = mp_init_i64(&big1, w1);
if (err == MP_OKAY) {
err = mp_add(&big2, &big1, &big2);
|
| ︙ | ︙ | |||
8288 8289 8290 8291 8292 8293 8294 |
* Handle shifts within the native wide range.
*/
if ((type1 == TCL_NUMBER_INT)
&& ((size_t)shift < CHAR_BIT*sizeof(Tcl_WideInt))) {
w1 = *((const Tcl_WideInt *)ptr1);
if (!((w1>0 ? w1 : ~w1)
| | | | 8273 8274 8275 8276 8277 8278 8279 8280 8281 8282 8283 8284 8285 8286 8287 8288 8289 |
* Handle shifts within the native wide range.
*/
if ((type1 == TCL_NUMBER_INT)
&& ((size_t)shift < CHAR_BIT*sizeof(Tcl_WideInt))) {
w1 = *((const Tcl_WideInt *)ptr1);
if (!((w1>0 ? w1 : ~w1)
& -(((Tcl_WideUInt)1)
<< (CHAR_BIT*sizeof(Tcl_WideInt) - 1 - shift)))) {
WIDE_RESULT((Tcl_WideUInt)w1 << shift);
}
}
} else {
/*
* Quickly force large right shifts to 0 or -1.
*/
|
| ︙ | ︙ | |||
8445 8446 8447 8448 8449 8450 8451 | * Anything to the first power is itself */ return NULL; } negativeExponent = (w2 < 0); | | | 8430 8431 8432 8433 8434 8435 8436 8437 8438 8439 8440 8441 8442 8443 8444 |
* Anything to the first power is itself
*/
return NULL;
}
negativeExponent = (w2 < 0);
oddExponent = (int)w2 & 1;
} else {
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
negativeExponent = mp_isneg(&big2);
err = mp_mod_2d(&big2, 1, &big2);
oddExponent = (err == MP_OKAY) && !mp_iszero(&big2);
mp_clear(&big2);
}
|
| ︙ | ︙ | |||
8535 8536 8537 8538 8539 8540 8541 |
assert(type1 == TCL_NUMBER_INT && type2 == TCL_NUMBER_INT);
if (w1 == 2) {
/*
* Reduce small powers of 2 to shifts.
*/
| | | | | | 8520 8521 8522 8523 8524 8525 8526 8527 8528 8529 8530 8531 8532 8533 8534 8535 8536 8537 8538 8539 8540 8541 8542 8543 8544 8545 8546 8547 |
assert(type1 == TCL_NUMBER_INT && type2 == TCL_NUMBER_INT);
if (w1 == 2) {
/*
* Reduce small powers of 2 to shifts.
*/
if ((Tcl_WideUInt)w2 < (Tcl_WideUInt)CHAR_BIT*sizeof(Tcl_WideInt) - 1) {
WIDE_RESULT(((Tcl_WideInt)1) << (int)w2);
}
goto overflowExpon;
}
if (w1 == -2) {
int signum = oddExponent ? -1 : 1;
/*
* Reduce small powers of 2 to shifts.
*/
if ((Tcl_WideUInt)w2 < CHAR_BIT * sizeof(Tcl_WideInt) - 1) {
WIDE_RESULT(signum * (((Tcl_WideInt)1) << (int) w2));
}
goto overflowExpon;
}
if (w2 - 2 < (long)MaxBase64Size
&& w1 <= MaxBase64[w2 - 2]
&& w1 >= -MaxBase64[w2 - 2]) {
/*
|
| ︙ | ︙ | |||
8666 8667 8668 8669 8670 8671 8672 | doubleResult: #ifndef ACCEPT_NAN /* * Check now for IEEE floating-point error. */ | | | | | 8651 8652 8653 8654 8655 8656 8657 8658 8659 8660 8661 8662 8663 8664 8665 8666 8667 8668 8669 8670 8671 8672 8673 8674 8675 8676 8677 8678 8679 8680 8681 8682 8683 8684 8685 8686 8687 8688 8689 8690 8691 8692 |
doubleResult:
#ifndef ACCEPT_NAN
/*
* Check now for IEEE floating-point error.
*/
if (isnan(dResult)) {
TclExprFloatError(interp, dResult);
return GENERAL_ARITHMETIC_ERROR;
}
#endif
DOUBLE_RESULT(dResult);
}
if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
w1 = *((const Tcl_WideInt *)ptr1);
w2 = *((const Tcl_WideInt *)ptr2);
switch (opcode) {
case INST_ADD:
wResult = (Tcl_WideInt)((Tcl_WideUInt)w1 + (Tcl_WideUInt)w2);
if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT))
{
/*
* Check for overflow.
*/
if (Overflowing(w1, w2, wResult)) {
goto overflowBasic;
}
}
break;
case INST_SUB:
wResult = (Tcl_WideInt)((Tcl_WideUInt)w1 - (Tcl_WideUInt)w2);
if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT))
{
/*
* Must check for overflow. The macro tests for overflows
* in sums by looking at the sign bits. As we have a
* subtraction here, we are adding -w2. As -w2 could in
* turn overflow, we test with ~w2 instead: it has the
|
| ︙ | ︙ | |||
8813 8814 8815 8816 8817 8818 8819 |
}
static Tcl_Obj *
ExecuteExtendedUnaryMathOp(
int opcode, /* What operation to perform. */
Tcl_Obj *valuePtr) /* The operand on the stack. */
{
| | | 8798 8799 8800 8801 8802 8803 8804 8805 8806 8807 8808 8809 8810 8811 8812 |
}
static Tcl_Obj *
ExecuteExtendedUnaryMathOp(
int opcode, /* What operation to perform. */
Tcl_Obj *valuePtr) /* The operand on the stack. */
{
void *ptr = NULL;
int type;
Tcl_WideInt w;
mp_int big;
Tcl_Obj *objResultPtr;
mp_err err = MP_OKAY;
(void) GetNumberFromObj(NULL, valuePtr, &ptr, &type);
|
| ︙ | ︙ | |||
8893 8894 8895 8896 8897 8898 8899 |
int
TclCompareTwoNumbers(
Tcl_Obj *valuePtr,
Tcl_Obj *value2Ptr)
{
int type1 = TCL_NUMBER_NAN, type2 = TCL_NUMBER_NAN, compare;
| | | 8878 8879 8880 8881 8882 8883 8884 8885 8886 8887 8888 8889 8890 8891 8892 |
int
TclCompareTwoNumbers(
Tcl_Obj *valuePtr,
Tcl_Obj *value2Ptr)
{
int type1 = TCL_NUMBER_NAN, type2 = TCL_NUMBER_NAN, compare;
void *ptr1, *ptr2;
mp_int big1, big2;
double d1, d2, tmp;
Tcl_WideInt w1, w2;
(void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
(void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);
|
| ︙ | ︙ | |||
8919 8920 8921 8922 8923 8924 8925 | /* * If the double has a fractional part, or if the long can be * converted to double without loss of precision, then compare as * doubles. */ | | | 8904 8905 8906 8907 8908 8909 8910 8911 8912 8913 8914 8915 8916 8917 8918 |
/*
* If the double has a fractional part, or if the long can be
* converted to double without loss of precision, then compare as
* doubles.
*/
if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt) || w1 == (Tcl_WideInt)d1
|| modf(d2, &tmp) != 0.0) {
goto doubleCompare;
}
/*
* Otherwise, to make comparision based on full precision, need to
* convert the double to a suitably sized integer.
|
| ︙ | ︙ | |||
8942 8943 8944 8945 8946 8947 8948 |
if (d2 < (double)WIDE_MIN) {
return MP_GT;
}
if (d2 > (double)WIDE_MAX) {
return MP_LT;
}
| | | 8927 8928 8929 8930 8931 8932 8933 8934 8935 8936 8937 8938 8939 8940 8941 |
if (d2 < (double)WIDE_MIN) {
return MP_GT;
}
if (d2 > (double)WIDE_MAX) {
return MP_LT;
}
w2 = (Tcl_WideInt)d2;
goto wideCompare;
case TCL_NUMBER_BIG:
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
if (mp_isneg(&big2)) {
compare = MP_GT;
} else {
compare = MP_LT;
|
| ︙ | ︙ | |||
8967 8968 8969 8970 8971 8972 8973 | d2 = *((const double *)ptr2); doubleCompare: return (d1 < d2) ? MP_LT : ((d1 > d2) ? MP_GT : MP_EQ); case TCL_NUMBER_INT: w2 = *((const Tcl_WideInt *)ptr2); d2 = (double) w2; if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt) | | | | | 8952 8953 8954 8955 8956 8957 8958 8959 8960 8961 8962 8963 8964 8965 8966 8967 8968 8969 8970 8971 8972 8973 8974 8975 8976 8977 8978 |
d2 = *((const double *)ptr2);
doubleCompare:
return (d1 < d2) ? MP_LT : ((d1 > d2) ? MP_GT : MP_EQ);
case TCL_NUMBER_INT:
w2 = *((const Tcl_WideInt *)ptr2);
d2 = (double) w2;
if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
|| w2 == (Tcl_WideInt)d2 || modf(d1, &tmp) != 0.0) {
goto doubleCompare;
}
if (d1 < (double)WIDE_MIN) {
return MP_LT;
}
if (d1 > (double)WIDE_MAX) {
return MP_GT;
}
w1 = (Tcl_WideInt)d1;
goto wideCompare;
case TCL_NUMBER_BIG:
if (isinf(d1)) {
return (d1 > 0.0) ? MP_GT : MP_LT;
}
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
if ((d1 < (double)WIDE_MAX) && (d1 > (double)WIDE_MIN)) {
if (mp_isneg(&big2)) {
compare = MP_GT;
} else {
|
| ︙ | ︙ | |||
9012 9013 9014 9015 9016 9017 9018 |
switch (type2) {
case TCL_NUMBER_INT:
compare = mp_cmp_d(&big1, 0);
mp_clear(&big1);
return compare;
case TCL_NUMBER_DOUBLE:
d2 = *((const double *)ptr2);
| | | 8997 8998 8999 9000 9001 9002 9003 9004 9005 9006 9007 9008 9009 9010 9011 |
switch (type2) {
case TCL_NUMBER_INT:
compare = mp_cmp_d(&big1, 0);
mp_clear(&big1);
return compare;
case TCL_NUMBER_DOUBLE:
d2 = *((const double *)ptr2);
if (isinf(d2)) {
compare = (d2 > 0.0) ? MP_LT : MP_GT;
mp_clear(&big1);
return compare;
}
if ((d2 < (double)WIDE_MAX) && (d2 > (double)WIDE_MIN)) {
compare = mp_cmp_d(&big1, 0);
mp_clear(&big1);
|
| ︙ | ︙ | |||
9208 9209 9210 9211 9212 9213 9214 |
Tcl_Interp *interp, /* Interpreter to which error information
* pertains. */
const unsigned char *pc, /* Points to the instruction being executed
* when the illegal type was found. */
Tcl_Obj *opndPtr) /* Points to the operand holding the value
* with the illegal type. */
{
| | | 9193 9194 9195 9196 9197 9198 9199 9200 9201 9202 9203 9204 9205 9206 9207 |
Tcl_Interp *interp, /* Interpreter to which error information
* pertains. */
const unsigned char *pc, /* Points to the instruction being executed
* when the illegal type was found. */
Tcl_Obj *opndPtr) /* Points to the operand holding the value
* with the illegal type. */
{
void *ptr;
int type;
const unsigned char opcode = *pc;
const char *description, *op = "unknown";
if (opcode == INST_EXPON) {
op = "**";
} else if (opcode <= INST_LNOT) {
|
| ︙ | ︙ | |||
9615 9616 9617 9618 9619 9620 9621 |
TclExprFloatError(
Tcl_Interp *interp, /* Where to store error message. */
double value) /* Value returned after error; used to
* distinguish underflows from overflows. */
{
const char *s;
| | | | 9600 9601 9602 9603 9604 9605 9606 9607 9608 9609 9610 9611 9612 9613 9614 9615 9616 9617 9618 |
TclExprFloatError(
Tcl_Interp *interp, /* Where to store error message. */
double value) /* Value returned after error; used to
* distinguish underflows from overflows. */
{
const char *s;
if ((errno == EDOM) || isnan(value)) {
s = "domain error: argument not in valid range";
Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, NULL);
} else if ((errno == ERANGE) || isinf(value)) {
if (value == 0.0) {
s = "floating-point value too small to represent";
Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, NULL);
} else {
s = "floating-point value too large to represent";
Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
|
| ︙ | ︙ | |||
9847 9848 9849 9850 9851 9852 9853 |
objBytesIfUnshared = 0.0;
strBytesIfUnshared = 0.0;
strBytesSharedMultX = 0.0;
strBytesSharedOnce = 0.0;
for (i = 0; i < globalTablePtr->numBuckets; i++) {
for (entryPtr = globalTablePtr->buckets[i]; entryPtr != NULL;
entryPtr = entryPtr->nextPtr) {
| | | 9832 9833 9834 9835 9836 9837 9838 9839 9840 9841 9842 9843 9844 9845 9846 |
objBytesIfUnshared = 0.0;
strBytesIfUnshared = 0.0;
strBytesSharedMultX = 0.0;
strBytesSharedOnce = 0.0;
for (i = 0; i < globalTablePtr->numBuckets; i++) {
for (entryPtr = globalTablePtr->buckets[i]; entryPtr != NULL;
entryPtr = entryPtr->nextPtr) {
if (TclHasInternalRep(entryPtr->objPtr, &tclByteCodeType)) {
numByteCodeLits++;
}
(void) TclGetStringFromObj(entryPtr->objPtr, &length);
refCountSum += entryPtr->refCount;
objBytesIfUnshared += (entryPtr->refCount * sizeof(Tcl_Obj));
strBytesIfUnshared += (entryPtr->refCount * (length+1));
if (entryPtr->refCount > 1) {
|
| ︙ | ︙ |
Changes to generic/tclFCmd.c.
| ︙ | ︙ | |||
1002 1003 1004 1005 1006 1007 1008 | Tcl_IncrRefCount(objStrings); /* * Use objStrings as a list object. */ | | | 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 |
Tcl_IncrRefCount(objStrings);
/*
* Use objStrings as a list object.
*/
if (TclListObjLength(interp, objStrings, &numObjStrings) != TCL_OK) {
goto end;
}
attributeStringsAllocated = (const char **)
TclStackAlloc(interp, (1+numObjStrings) * sizeof(char *));
for (index = 0; index < numObjStrings; index++) {
Tcl_ListObjIndex(interp, objStrings, index, &objPtr);
attributeStringsAllocated[index] = TclGetString(objPtr);
|
| ︙ | ︙ |
Changes to generic/tclFileName.c.
| ︙ | ︙ | |||
513 514 515 516 517 518 519 |
}
/*
* Compute the number of elements in the result.
*/
if (lenPtr != NULL) {
| | | 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 |
}
/*
* Compute the number of elements in the result.
*/
if (lenPtr != NULL) {
TclListObjLength(NULL, resultPtr, lenPtr);
}
return resultPtr;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
1328 1329 1330 1331 1332 1333 1334 |
if (i == (objc-1)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing argument to \"-types\"", -1));
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
return TCL_ERROR;
}
typePtr = objv[i+1];
| | | 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 |
if (i == (objc-1)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing argument to \"-types\"", -1));
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
return TCL_ERROR;
}
typePtr = objv[i+1];
if (TclListObjLength(interp, typePtr, &length) != TCL_OK) {
return TCL_ERROR;
}
i++;
break;
case GLOB_LAST: /* -- */
i++;
goto endOfForLoop;
|
| ︙ | ︙ | |||
1450 1451 1452 1453 1454 1455 1456 |
if (typePtr != NULL) {
/*
* The rest of the possible type arguments (except 'd') are platform
* specific. We don't complain when they are used on an incompatible
* platform.
*/
| | | 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 |
if (typePtr != NULL) {
/*
* The rest of the possible type arguments (except 'd') are platform
* specific. We don't complain when they are used on an incompatible
* platform.
*/
TclListObjLength(interp, typePtr, &length);
if (length <= 0) {
goto skipTypes;
}
globTypes = (Tcl_GlobTypeData *)TclStackAlloc(interp, sizeof(Tcl_GlobTypeData));
globTypes->type = 0;
globTypes->perm = 0;
globTypes->macType = NULL;
|
| ︙ | ︙ | |||
1520 1521 1522 1523 1524 1525 1526 |
}
globTypes->macType = look;
Tcl_IncrRefCount(look);
} else {
Tcl_Obj *item;
| | | 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 |
}
globTypes->macType = look;
Tcl_IncrRefCount(look);
} else {
Tcl_Obj *item;
if ((TclListObjLength(NULL, look, &len) == TCL_OK)
&& (len == 3)) {
Tcl_ListObjIndex(interp, look, 0, &item);
if (!strcmp("macintosh", Tcl_GetString(item))) {
Tcl_ListObjIndex(interp, look, 1, &item);
if (!strcmp("type", Tcl_GetString(item))) {
Tcl_ListObjIndex(interp, look, 2, &item);
if (globTypes->macType != NULL) {
|
| ︙ | ︙ | |||
1627 1628 1629 1630 1631 1632 1633 |
result = TCL_ERROR;
goto endOfGlob;
}
}
}
if ((globFlags & TCL_GLOBMODE_NO_COMPLAIN) == 0) {
| | | 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 |
result = TCL_ERROR;
goto endOfGlob;
}
}
}
if ((globFlags & TCL_GLOBMODE_NO_COMPLAIN) == 0) {
if (TclListObjLength(interp, Tcl_GetObjResult(interp),
&length) != TCL_OK) {
/*
* This should never happen. Maybe we should be more dramatic.
*/
result = TCL_ERROR;
goto endOfGlob;
|
| ︙ | ︙ | |||
2010 2011 2012 2013 2014 2015 2016 |
if ((tclPlatform != TCL_PLATFORM_WINDOWS) || (prefixLen != 2)
|| (pre[1] != ':')) {
prefixLen++;
}
}
| | | 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 |
if ((tclPlatform != TCL_PLATFORM_WINDOWS) || (prefixLen != 2)
|| (pre[1] != ':')) {
prefixLen++;
}
}
TclListObjGetElements(NULL, filenamesObj, &objc, &objv);
for (i = 0; i< objc; i++) {
int len;
const char *oldStr = TclGetStringFromObj(objv[i], &len);
Tcl_Obj *elem;
if (len == prefixLen) {
if ((pattern[0] == '\0')
|
| ︙ | ︙ | |||
2339 2340 2341 2342 2343 2344 2345 |
result = Tcl_FSMatchInDirectory(interp, subdirsPtr, pathPtr,
pattern, &dirOnly);
*p = save;
if (result == TCL_OK) {
int subdirc, i, repair = -1;
Tcl_Obj **subdirv;
| | | | | 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 |
result = Tcl_FSMatchInDirectory(interp, subdirsPtr, pathPtr,
pattern, &dirOnly);
*p = save;
if (result == TCL_OK) {
int subdirc, i, repair = -1;
Tcl_Obj **subdirv;
result = TclListObjGetElements(interp, subdirsPtr,
&subdirc, &subdirv);
for (i=0; result==TCL_OK && i<subdirc; i++) {
Tcl_Obj *copy = NULL;
if (pathPtr == NULL && Tcl_GetString(subdirv[i])[0] == '~') {
TclListObjLength(NULL, matchesObj, &repair);
copy = subdirv[i];
subdirv[i] = Tcl_NewStringObj("./", 2);
Tcl_AppendObjToObj(subdirv[i], copy);
Tcl_IncrRefCount(subdirv[i]);
}
result = DoGlob(interp, matchesObj, separators, subdirv[i],
1, p+1, types);
if (copy) {
int end;
Tcl_DecrRefCount(subdirv[i]);
subdirv[i] = copy;
TclListObjLength(NULL, matchesObj, &end);
while (repair < end) {
const char *bytes;
int numBytes;
Tcl_Obj *fixme, *newObj;
Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme);
bytes = TclGetStringFromObj(fixme, &numBytes);
|
| ︙ | ︙ |
Changes to generic/tclGet.c.
| ︙ | ︙ | |||
49 50 51 52 53 54 55 |
obj.length = strlen(src);
obj.typePtr = NULL;
code = Tcl_GetIntFromObj(interp, &obj, intPtr);
if (obj.refCount > 1) {
Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
| | | 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 |
obj.length = strlen(src);
obj.typePtr = NULL;
code = Tcl_GetIntFromObj(interp, &obj, intPtr);
if (obj.refCount > 1) {
Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
TclFreeInternalRep(&obj);
return code;
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetDouble --
|
| ︙ | ︙ | |||
93 94 95 96 97 98 99 |
obj.length = strlen(src);
obj.typePtr = NULL;
code = Tcl_GetDoubleFromObj(interp, &obj, doublePtr);
if (obj.refCount > 1) {
Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
| | | 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 |
obj.length = strlen(src);
obj.typePtr = NULL;
code = Tcl_GetDoubleFromObj(interp, &obj, doublePtr);
if (obj.refCount > 1) {
Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
TclFreeInternalRep(&obj);
return code;
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetBoolean --
|
| ︙ | ︙ |
Changes to generic/tclGetDate.y.
| ︙ | ︙ | |||
132 133 134 135 136 137 138 | /* * The offset of tm_year of struct tm returned by localtime, gmtime, etc. * Posix requires 1900. */ #define TM_YEAR_BASE 1900 | | | | 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 |
/*
* The offset of tm_year of struct tm returned by localtime, gmtime, etc.
* Posix requires 1900.
*/
#define TM_YEAR_BASE 1900
#define HOUR(x) ((int) (60 * (x)))
#define SECSPERDAY (24L * 60L * 60L)
#define IsLeapYear(x) (((x) % 4 == 0) && ((x) % 100 != 0 || (x) % 400 == 0))
/*
* An entry in the lexical lookup table.
*/
typedef struct _TABLE {
const char *name;
|
| ︙ | ︙ |
Changes to generic/tclHash.c.
| ︙ | ︙ | |||
31 32 33 34 35 36 37 | * The following macro takes a preliminary integer hash value and produces an * index into a hash tables bucket list. The idea is to make it so that * preliminary values that are arbitrarily similar will end up in different * buckets. The hash function was taken from a random-number generator. */ #define RANDOM_INDEX(tablePtr, i) \ | | | 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 |
* The following macro takes a preliminary integer hash value and produces an
* index into a hash tables bucket list. The idea is to make it so that
* preliminary values that are arbitrarily similar will end up in different
* buckets. The hash function was taken from a random-number generator.
*/
#define RANDOM_INDEX(tablePtr, i) \
((((i)*1103515245UL) >> (tablePtr)->downShift) & (tablePtr)->mask)
/*
* Prototypes for the array hash key methods.
*/
static Tcl_HashEntry * AllocArrayEntry(Tcl_HashTable *tablePtr, void *keyPtr);
static int CompareArrayKeys(void *keyPtr, Tcl_HashEntry *hPtr);
|
| ︙ | ︙ |
Changes to generic/tclIO.c.
| ︙ | ︙ | |||
320 321 322 323 324 325 326 |
ChannelState *statePtr; /* The saved lookup result */
Tcl_Interp *interp; /* The interp in which the lookup was done. */
size_t epoch; /* The epoch of the channel when the lookup
* was done. Use to verify validity. */
size_t refCount; /* Share this struct among many Tcl_Obj. */
} ResolvedChanName;
| | | | | | | | | | | | 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 |
ChannelState *statePtr; /* The saved lookup result */
Tcl_Interp *interp; /* The interp in which the lookup was done. */
size_t epoch; /* The epoch of the channel when the lookup
* was done. Use to verify validity. */
size_t refCount; /* Share this struct among many Tcl_Obj. */
} ResolvedChanName;
static void DupChannelInternalRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static void FreeChannelInternalRep(Tcl_Obj *objPtr);
static const Tcl_ObjType chanObjType = {
"channel", /* name for this type */
FreeChannelInternalRep, /* freeIntRepProc */
DupChannelInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL /* setFromAnyProc */
};
#define ChanSetInternalRep(objPtr, resPtr) \
do { \
Tcl_ObjInternalRep ir; \
(resPtr)->refCount++; \
ir.twoPtrValue.ptr1 = (resPtr); \
ir.twoPtrValue.ptr2 = NULL; \
Tcl_StoreInternalRep((objPtr), &chanObjType, &ir); \
} while (0)
#define ChanGetInternalRep(objPtr, resPtr) \
do { \
const Tcl_ObjInternalRep *irPtr; \
irPtr = TclFetchInternalRep((objPtr), &chanObjType); \
(resPtr) = irPtr ? (ResolvedChanName *)irPtr->twoPtrValue.ptr1 : NULL; \
} while (0)
#define BUSY_STATE(st, fl) \
((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \
(((st)->csPtrW) && ((fl) & TCL_WRITABLE)))
|
| ︙ | ︙ | |||
1520 1521 1522 1523 1524 1525 1526 |
ResolvedChanName *resPtr = NULL;
Tcl_Channel chan;
if (interp == NULL) {
return TCL_ERROR;
}
| | | 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 |
ResolvedChanName *resPtr = NULL;
Tcl_Channel chan;
if (interp == NULL) {
return TCL_ERROR;
}
ChanGetInternalRep(objPtr, resPtr);
if (resPtr) {
/*
* Confirm validity of saved lookup results.
*/
statePtr = resPtr->statePtr;
if ((resPtr->interp == interp) /* Same interp context */
|
| ︙ | ︙ | |||
1542 1543 1544 1545 1546 1547 1548 |
}
}
chan = Tcl_GetChannel(interp, TclGetString(objPtr), NULL);
if (chan == NULL) {
if (resPtr) {
| | | | 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 |
}
}
chan = Tcl_GetChannel(interp, TclGetString(objPtr), NULL);
if (chan == NULL) {
if (resPtr) {
Tcl_StoreInternalRep(objPtr, &chanObjType, NULL);
}
return TCL_ERROR;
}
if (resPtr && resPtr->refCount == 1) {
/*
* Re-use the ResolvedCmdName struct.
*/
Tcl_Release((ClientData) resPtr->statePtr);
} else {
resPtr = (ResolvedChanName *) ckalloc(sizeof(ResolvedChanName));
resPtr->refCount = 0;
ChanSetInternalRep(objPtr, resPtr); /* Overwrites, if needed */
}
statePtr = ((Channel *)chan)->state;
resPtr->statePtr = statePtr;
Tcl_Preserve((ClientData) statePtr);
resPtr->interp = interp;
resPtr->epoch = statePtr->epoch;
|
| ︙ | ︙ | |||
3656 3657 3658 3659 3660 3661 3662 |
}
/*
* A user may try to call half-close from within a channel close handler.
* That won't do.
*/
| | | 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 |
}
/*
* A user may try to call half-close from within a channel close handler.
* That won't do.
*/
if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
if (interp) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"illegal recursive call to close through close-handler"
" of channel", -1));
}
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 |
int srcLen, /* Length of UTF-8 string in bytes. */
Tcl_Encoding encoding)
{
ChannelState *statePtr = chanPtr->state;
/* State info for channel */
char *nextNewLine = NULL;
int endEncoding, saved = 0, total = 0, flushed = 0, needNlFlush = 0;
if (srcLen) {
WillWrite(chanPtr);
}
/*
* Write the terminated escape sequence even if srcLen is 0.
*/
endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);
if (GotFlag(statePtr, CHANNEL_LINEBUFFERED)
|| (statePtr->outputTranslation != TCL_TRANSLATE_LF)) {
nextNewLine = (char *)memchr(src, '\n', srcLen);
}
while (srcLen + saved + endEncoding > 0) {
ChannelBuffer *bufPtr;
| > | | 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 |
int srcLen, /* Length of UTF-8 string in bytes. */
Tcl_Encoding encoding)
{
ChannelState *statePtr = chanPtr->state;
/* State info for channel */
char *nextNewLine = NULL;
int endEncoding, saved = 0, total = 0, flushed = 0, needNlFlush = 0;
char safe[BUFFER_PADDING];
if (srcLen) {
WillWrite(chanPtr);
}
/*
* Write the terminated escape sequence even if srcLen is 0.
*/
endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);
if (GotFlag(statePtr, CHANNEL_LINEBUFFERED)
|| (statePtr->outputTranslation != TCL_TRANSLATE_LF)) {
nextNewLine = (char *)memchr(src, '\n', srcLen);
}
while (srcLen + saved + endEncoding > 0) {
ChannelBuffer *bufPtr;
char *dst;
int result, srcRead, dstLen, dstWrote, srcLimit = srcLen;
if (nextNewLine) {
srcLimit = nextNewLine - src;
}
/* Get space to write into */
|
| ︙ | ︙ | |||
4380 4381 4382 4383 4384 4385 4386 |
if ((result != TCL_OK) && (srcRead + dstWrote == 0)) {
/*
* We're reading from invalid/incomplete UTF-8.
*/
ReleaseChannelBuffer(bufPtr);
if (total == 0) {
| | | 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 4394 4395 |
if ((result != TCL_OK) && (srcRead + dstWrote == 0)) {
/*
* We're reading from invalid/incomplete UTF-8.
*/
ReleaseChannelBuffer(bufPtr);
if (total == 0) {
Tcl_SetErrno(EILSEQ);
return -1;
}
break;
}
bufPtr->nextAdded += dstWrote;
src += srcRead;
|
| ︙ | ︙ | |||
8601 8602 8603 8604 8605 8606 8607 |
*/
static void
ChannelTimerProc(
ClientData clientData)
{
Channel *chanPtr = (Channel *)clientData;
| | | > > > > > | | | | | | | | | | | | | | > > > | 8602 8603 8604 8605 8606 8607 8608 8609 8610 8611 8612 8613 8614 8615 8616 8617 8618 8619 8620 8621 8622 8623 8624 8625 8626 8627 8628 8629 8630 8631 8632 8633 8634 8635 8636 8637 8638 8639 8640 8641 8642 8643 8644 8645 8646 8647 8648 8649 8650 8651 8652 8653 8654 8655 8656 8657 |
*/
static void
ChannelTimerProc(
ClientData clientData)
{
Channel *chanPtr = (Channel *)clientData;
/* State info for channel */
ChannelState *statePtr = chanPtr->state;
/* Preserve chanPtr to guard against deallocation in Tcl_NotifyChannel. */
TclChannelPreserve((Tcl_Channel)chanPtr);
Tcl_Preserve(statePtr);
statePtr->timer = NULL;
if (statePtr->interestMask & TCL_WRITABLE
&& GotFlag(statePtr, CHANNEL_NONBLOCKING)
&& !GotFlag(statePtr, BG_FLUSH_SCHEDULED)
) {
/*
* Restart the timer in case a channel handler reenters the event loop
* before UpdateInterest gets called by Tcl_NotifyChannel.
*/
statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
ChannelTimerProc,chanPtr);
Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_WRITABLE);
}
/* The channel may have just been closed from within Tcl_NotifyChannel */
if (!GotFlag(statePtr, CHANNEL_INCLOSE)) {
if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)
&& (statePtr->interestMask & TCL_READABLE)
&& (statePtr->inQueueHead != NULL)
&& IsBufferReady(statePtr->inQueueHead)) {
/*
* Restart the timer in case a channel handler reenters the event loop
* before UpdateInterest gets called by Tcl_NotifyChannel.
*/
statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
ChannelTimerProc,chanPtr);
Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE);
} else {
UpdateInterest(chanPtr);
}
}
Tcl_Release(statePtr);
TclChannelRelease((Tcl_Channel)chanPtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_CreateChannelHandler --
*
|
| ︙ | ︙ | |||
8699 8700 8701 8702 8703 8704 8705 |
chPtr->chanPtr = chanPtr;
chPtr->nextPtr = statePtr->chPtr;
statePtr->chPtr = chPtr;
}
/*
* The remainder of the initialization below is done regardless of whether
| | | 8708 8709 8710 8711 8712 8713 8714 8715 8716 8717 8718 8719 8720 8721 8722 |
chPtr->chanPtr = chanPtr;
chPtr->nextPtr = statePtr->chPtr;
statePtr->chPtr = chPtr;
}
/*
* The remainder of the initialization below is done regardless of whether
* this is a new record or a modification of an old one.
*/
chPtr->mask = mask;
/*
* Recompute the interest mask for the channel - this call may actually be
* disabling an existing handler.
|
| ︙ | ︙ | |||
9423 9424 9425 9426 9427 9428 9429 |
}
bufPtr = bufPtr->nextPtr;
}
if (bufPtr) {
/* Split the overflowing buffer in two */
int extra = (int) (inBytes - csPtr->toRead);
| | | | | | | | | 9432 9433 9434 9435 9436 9437 9438 9439 9440 9441 9442 9443 9444 9445 9446 9447 9448 9449 9450 9451 9452 |
}
bufPtr = bufPtr->nextPtr;
}
if (bufPtr) {
/* Split the overflowing buffer in two */
int extra = (int) (inBytes - csPtr->toRead);
/* Note that going with int for extra assumes that inBytes is not too
* much over toRead to require a wide itself. If that gets violated
* then the calculations involving extra must be made wide too.
*
* Noted with Win32/MSVC debug build treating the warning (possible of
* data in long long to int conversion) as error.
*/
bufPtr = AllocChannelBuffer(extra);
tail->nextAdded -= extra;
memcpy(InsertPoint(bufPtr), InsertPoint(tail), extra);
bufPtr->nextAdded += extra;
bufPtr->nextPtr = tail->nextPtr;
|
| ︙ | ︙ | |||
10962 10963 10964 10965 10966 10967 10968 |
void
Tcl_SetChannelErrorInterp(
Tcl_Interp *interp, /* Interp to store the data into. */
Tcl_Obj *msg) /* Error message to store. */
{
Interp *iPtr = (Interp *) interp;
| < < < | < > > > > > > | 10971 10972 10973 10974 10975 10976 10977 10978 10979 10980 10981 10982 10983 10984 10985 10986 10987 10988 10989 10990 10991 10992 10993 10994 10995 |
void
Tcl_SetChannelErrorInterp(
Tcl_Interp *interp, /* Interp to store the data into. */
Tcl_Obj *msg) /* Error message to store. */
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *disposePtr = iPtr->chanMsg;
if (msg != NULL) {
iPtr->chanMsg = FixLevelCode(msg);
Tcl_IncrRefCount(iPtr->chanMsg);
} else {
iPtr->chanMsg = NULL;
}
if (disposePtr != NULL) {
TclDecrRefCount(disposePtr);
}
return;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
10998 10999 11000 11001 11002 11003 11004 |
void
Tcl_SetChannelError(
Tcl_Channel chan, /* Channel to store the data into. */
Tcl_Obj *msg) /* Error message to store. */
{
ChannelState *statePtr = ((Channel *) chan)->state;
| < < < | < > > > > > > | 11009 11010 11011 11012 11013 11014 11015 11016 11017 11018 11019 11020 11021 11022 11023 11024 11025 11026 11027 11028 11029 11030 11031 11032 11033 |
void
Tcl_SetChannelError(
Tcl_Channel chan, /* Channel to store the data into. */
Tcl_Obj *msg) /* Error message to store. */
{
ChannelState *statePtr = ((Channel *) chan)->state;
Tcl_Obj *disposePtr = statePtr->chanMsg;
if (msg != NULL) {
statePtr->chanMsg = FixLevelCode(msg);
Tcl_IncrRefCount(statePtr->chanMsg);
} else {
statePtr->chanMsg = NULL;
}
if (disposePtr != NULL) {
TclDecrRefCount(disposePtr);
}
return;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
11051 11052 11053 11054 11055 11056 11057 |
* Syntax = (option value)... ?message?
*
* Bad message syntax causes a panic, because the other side uses
* Tcl_GetReturnOptions and list construction functions to marshall the
* information. Hence an error means that we've got serious breakage.
*/
| | | 11064 11065 11066 11067 11068 11069 11070 11071 11072 11073 11074 11075 11076 11077 11078 |
* Syntax = (option value)... ?message?
*
* Bad message syntax causes a panic, because the other side uses
* Tcl_GetReturnOptions and list construction functions to marshall the
* information. Hence an error means that we've got serious breakage.
*/
res = TclListObjGetElements(NULL, msg, &lc, &lv);
if (res != TCL_OK) {
Tcl_Panic("Tcl_SetChannelError: bad syntax of message");
}
explicitResult = (1 == (lc % 2));
numOptions = lc - explicitResult;
|
| ︙ | ︙ | |||
11257 11258 11259 11260 11261 11262 11263 |
}
return chanTypePtr->truncateProc;
}
/*
*----------------------------------------------------------------------
*
| | | | | | | | | 11270 11271 11272 11273 11274 11275 11276 11277 11278 11279 11280 11281 11282 11283 11284 11285 11286 11287 11288 11289 11290 11291 11292 11293 11294 11295 11296 11297 11298 11299 11300 11301 11302 11303 11304 11305 11306 11307 11308 11309 11310 11311 11312 11313 11314 11315 11316 11317 11318 11319 11320 11321 11322 11323 11324 11325 11326 11327 11328 11329 11330 11331 11332 11333 11334 11335 |
}
return chanTypePtr->truncateProc;
}
/*
*----------------------------------------------------------------------
*
* DupChannelInternalRep --
*
* Initialize the internal representation of a new Tcl_Obj to a copy of
* the internal representation of an existing string object.
*
* Results:
* None.
*
* Side effects:
* copyPtr's internal rep is set to a copy of srcPtr's internal
* representation.
*
*----------------------------------------------------------------------
*/
static void
DupChannelInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have
* an internal rep of type "Channel". */
Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not
* currently have an internal rep.*/
{
ResolvedChanName *resPtr;
ChanGetInternalRep(srcPtr, resPtr);
assert(resPtr);
ChanSetInternalRep(copyPtr, resPtr);
}
/*
*----------------------------------------------------------------------
*
* FreeChannelInternalRep --
*
* Release statePtr storage.
*
* Results:
* None.
*
* Side effects:
* May cause state to be freed.
*
*----------------------------------------------------------------------
*/
static void
FreeChannelInternalRep(
Tcl_Obj *objPtr) /* Object with internal rep to free. */
{
ResolvedChanName *resPtr;
ChanGetInternalRep(objPtr, resPtr);
assert(resPtr);
if (resPtr->refCount-- > 1) {
return;
}
Tcl_Release(resPtr->statePtr);
ckfree(resPtr);
}
|
| ︙ | ︙ |
Changes to generic/tclIOGT.c.
| ︙ | ︙ | |||
104 105 106 107 108 109 110 | */ typedef struct ResultBuffer ResultBuffer; static inline void ResultClear(ResultBuffer *r); static inline void ResultInit(ResultBuffer *r); static inline int ResultEmpty(ResultBuffer *r); | | | 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 | */ typedef struct ResultBuffer ResultBuffer; static inline void ResultClear(ResultBuffer *r); static inline void ResultInit(ResultBuffer *r); static inline int ResultEmpty(ResultBuffer *r); static inline size_t ResultCopy(ResultBuffer *r, unsigned char *buf, size_t toRead); static inline void ResultAdd(ResultBuffer *r, unsigned char *buf, size_t toWrite); /* * This structure describes the channel type structure for Tcl-based * transformations. |
| ︙ | ︙ | |||
270 271 272 273 274 275 276 |
TransformChannelData *dataPtr;
Tcl_DString ds;
if (chan == NULL) {
return TCL_ERROR;
}
| | | 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 |
TransformChannelData *dataPtr;
Tcl_DString ds;
if (chan == NULL) {
return TCL_ERROR;
}
if (TCL_OK != TclListObjLength(interp, cmdObjPtr, &objc)) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("-command value is not a list", -1));
return TCL_ERROR;
}
chanPtr = (Channel *) chan;
statePtr = chanPtr->state;
|
| ︙ | ︙ | |||
1364 1365 1366 1367 1368 1369 1370 | * * Result: * The number of actually copied bytes, possibly less than 'toRead'. * *---------------------------------------------------------------------- */ | | | | 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 |
*
* Result:
* The number of actually copied bytes, possibly less than 'toRead'.
*
*----------------------------------------------------------------------
*/
static inline size_t
ResultCopy(
ResultBuffer *r, /* The buffer to read from. */
unsigned char *buf, /* The buffer to copy into. */
size_t toRead) /* Number of requested bytes. */
{
if (ResultEmpty(r)) {
/*
* Nothing to copy in the case of an empty buffer.
*/
return 0;
} else if (r->used == toRead) {
/*
|
| ︙ | ︙ | |||
1427 1428 1429 1430 1431 1432 1433 |
static inline void
ResultAdd(
ResultBuffer *r, /* The buffer to extend. */
unsigned char *buf, /* The buffer to read from. */
size_t toWrite) /* The number of bytes in 'buf'. */
{
| | | 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 |
static inline void
ResultAdd(
ResultBuffer *r, /* The buffer to extend. */
unsigned char *buf, /* The buffer to read from. */
size_t toWrite) /* The number of bytes in 'buf'. */
{
if ((r->used + toWrite + 1) > r->allocated) {
/*
* Extension of the internal buffer is required.
*/
if (r->allocated == 0) {
r->allocated = toWrite + INCREMENT;
r->buf = (unsigned char *)ckalloc(r->allocated);
|
| ︙ | ︙ |
Changes to generic/tclIORChan.c.
| ︙ | ︙ | |||
27 28 29 30 31 32 33 | #define EOK 0 #endif /* * Signatures of all functions used in the C layer of the reflection. */ | | | | | | | | | | | | > > | | | | | 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 |
#define EOK 0
#endif
/*
* Signatures of all functions used in the C layer of the reflection.
*/
static int ReflectClose(void *clientData,
Tcl_Interp *interp, int flags);
static int ReflectInput(void *clientData, char *buf,
int toRead, int *errorCodePtr);
static int ReflectOutput(void *clientData, const char *buf,
int toWrite, int *errorCodePtr);
static void ReflectWatch(void *clientData, int mask);
static int ReflectBlock(void *clientData, int mode);
#if TCL_THREADS
static void ReflectThread(void *clientData, int action);
static int ReflectEventRun(Tcl_Event *ev, int flags);
static int ReflectEventDelete(Tcl_Event *ev, void *cd);
#endif
static long long ReflectSeekWide(void *clientData,
long long offset, int mode, int *errorCodePtr);
#ifndef TCL_NO_DEPRECATED
static int ReflectSeek(void *clientData, long offset,
int mode, int *errorCodePtr);
#endif
static int ReflectGetOption(void *clientData,
Tcl_Interp *interp, const char *optionName,
Tcl_DString *dsPtr);
static int ReflectSetOption(void *clientData,
Tcl_Interp *interp, const char *optionName,
const char *newValue);
static int ReflectTruncate(void *clientData,
long long length);
static void TimerRunRead(void *clientData);
static void TimerRunWrite(void *clientData);
/*
* The C layer channel type/driver definition used by the reflection.
*/
static const Tcl_ChannelType tclRChannelType = {
"tclrchannel", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
TCL_CLOSE2PROC, /* Close channel, clean instance data */
ReflectInput, /* Handle read request */
ReflectOutput, /* Handle write request */
#ifndef TCL_NO_DEPRECATED
ReflectSeek, /* Move location of access point. NULL'able */
#else
NULL,
#endif
ReflectSetOption, /* Set options. NULL'able */
ReflectGetOption, /* Get options. NULL'able */
ReflectWatch, /* Initialize notifier */
NULL, /* Get OS handle from the channel. NULL'able */
ReflectClose, /* No close2 support. NULL'able */
ReflectBlock, /* Set blocking/nonblocking. NULL'able */
NULL, /* Flush channel. Not used by core. NULL'able */
NULL, /* Handle events. NULL'able */
ReflectSeekWide, /* Move access point (64 bit). NULL'able */
#if TCL_THREADS
ReflectThread, /* thread action, tracking owner */
#else
NULL, /* thread action */
#endif
ReflectTruncate /* Truncate. NULL'able */
};
/*
* Instance data for a reflected channel. ===========================
*/
typedef struct {
|
| ︙ | ︙ | |||
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 |
"cget", /* OPT \/ Together or none */
"cgetall", /* OPT /\ of these two */
"configure", /* OPT */
"finalize", /* */
"initialize", /* */
"read", /* OPT */
"seek", /* OPT */
"watch", /* */
"write", /* OPT */
NULL
};
typedef enum {
METH_BLOCKING,
METH_CGET,
METH_CGETALL,
METH_CONFIGURE,
METH_FINAL,
METH_INIT,
METH_READ,
METH_SEEK,
METH_WATCH,
METH_WRITE
} MethodName;
#define FLAG(m) (1 << (m))
#define REQUIRED_METHODS \
(FLAG(METH_INIT) | FLAG(METH_FINAL) | FLAG(METH_WATCH))
#define NULLABLE_METHODS \
(FLAG(METH_BLOCKING) | FLAG(METH_SEEK) | \
| > > | > | | 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 |
"cget", /* OPT \/ Together or none */
"cgetall", /* OPT /\ of these two */
"configure", /* OPT */
"finalize", /* */
"initialize", /* */
"read", /* OPT */
"seek", /* OPT */
"truncate", /* OPT */
"watch", /* */
"write", /* OPT */
NULL
};
typedef enum {
METH_BLOCKING,
METH_CGET,
METH_CGETALL,
METH_CONFIGURE,
METH_FINAL,
METH_INIT,
METH_READ,
METH_SEEK,
METH_TRUNCATE,
METH_WATCH,
METH_WRITE
} MethodName;
#define FLAG(m) (1 << (m))
#define REQUIRED_METHODS \
(FLAG(METH_INIT) | FLAG(METH_FINAL) | FLAG(METH_WATCH))
#define NULLABLE_METHODS \
(FLAG(METH_BLOCKING) | FLAG(METH_SEEK) | \
FLAG(METH_CONFIGURE) | FLAG(METH_CGET) | \
FLAG(METH_CGETALL) | FLAG(METH_TRUNCATE))
#define RANDW \
(TCL_READABLE | TCL_WRITABLE)
#define IMPLIES(a,b) ((!(a)) || (b))
#define NEGIMPL(a,b)
#define HAS(x,f) ((x) & FLAG(f))
#if TCL_THREADS
/*
* Thread specific types and structures.
*
* We are here essentially creating a very specific implementation of 'thread
* send'.
|
| ︙ | ︙ | |||
234 235 236 237 238 239 240 |
ForwardedInput,
ForwardedOutput,
ForwardedSeek,
ForwardedWatch,
ForwardedBlock,
ForwardedSetOpt,
ForwardedGetOpt,
| | > | 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 |
ForwardedInput,
ForwardedOutput,
ForwardedSeek,
ForwardedWatch,
ForwardedBlock,
ForwardedSetOpt,
ForwardedGetOpt,
ForwardedGetOptAll,
ForwardedTruncate
} ForwardedOperation;
/*
* Event used to forward driver invocations to the thread actually managing
* the channel. We cannot construct the command to execute and forward that.
* Because then it will contain a mixture of Tcl_Obj's belonging to both the
* command handler thread (CT), and the thread managing the channel (MT),
|
| ︙ | ︙ | |||
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 |
const char *value; /* Value to set */
};
struct ForwardParamGetOpt {
ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
const char *name; /* Name of option to get, maybe NULL */
Tcl_DString *value; /* Result */
};
/*
* Now join all these together in a single union for convenience.
*/
typedef union ForwardParam {
ForwardParamBase base;
struct ForwardParamInput input;
struct ForwardParamOutput output;
struct ForwardParamSeek seek;
struct ForwardParamWatch watch;
struct ForwardParamBlock block;
struct ForwardParamSetOpt setOpt;
struct ForwardParamGetOpt getOpt;
} ForwardParam;
/*
* Forward declaration.
*/
typedef struct ForwardingResult ForwardingResult;
| > > > > > | 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 |
const char *value; /* Value to set */
};
struct ForwardParamGetOpt {
ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
const char *name; /* Name of option to get, maybe NULL */
Tcl_DString *value; /* Result */
};
struct ForwardParamTruncate {
ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
Tcl_WideInt length; /* I: Length of file. */
};
/*
* Now join all these together in a single union for convenience.
*/
typedef union ForwardParam {
ForwardParamBase base;
struct ForwardParamInput input;
struct ForwardParamOutput output;
struct ForwardParamSeek seek;
struct ForwardParamWatch watch;
struct ForwardParamBlock block;
struct ForwardParamSetOpt setOpt;
struct ForwardParamGetOpt getOpt;
struct ForwardParamTruncate truncate;
} ForwardParam;
/*
* Forward declaration.
*/
typedef struct ForwardingResult ForwardingResult;
|
| ︙ | ︙ | |||
393 394 395 396 397 398 399 | * involved in the forwarding exits. It also clean things up so that we don't * leak resources when threads go away. */ static void ForwardOpToHandlerThread(ReflectedChannel *rcPtr, ForwardedOperation op, const void *param); static int ForwardProc(Tcl_Event *evPtr, int mask); | | | 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 |
* involved in the forwarding exits. It also clean things up so that we don't
* leak resources when threads go away.
*/
static void ForwardOpToHandlerThread(ReflectedChannel *rcPtr,
ForwardedOperation op, const void *param);
static int ForwardProc(Tcl_Event *evPtr, int mask);
static void SrcExitProc(void *clientData);
#define FreeReceivedError(p) \
if ((p)->base.mustFree) { \
ckfree((p)->base.msgStr); \
}
#define PassReceivedErrorInterp(i,p) \
if ((i) != NULL) { \
|
| ︙ | ︙ | |||
492 493 494 495 496 497 498 | * Creates a new channel. * *---------------------------------------------------------------------- */ int TclChanCreateObjCmd( | | | 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 |
* Creates a new channel.
*
*----------------------------------------------------------------------
*/
int
TclChanCreateObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
ReflectedChannel *rcPtr; /* Instance data of the new channel */
Tcl_Obj *rcId; /* Handle of the new channel */
int mode; /* R/W mode of new channel. Has to match
|
| ︙ | ︙ | |||
601 602 603 604 605 606 607 |
/*
* Verify the result.
* - List, of method names. Convert to mask.
* Check for non-optionals through the mask.
* Compare open mode against optional r/w.
*/
| | | 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 |
/*
* Verify the result.
* - List, of method names. Convert to mask.
* Check for non-optionals through the mask.
* Compare open mode against optional r/w.
*/
if (TclListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s initialize\" returned non-list: %s",
TclGetString(cmdObj), TclGetString(resObj)));
Tcl_DecrRefCount(resObj);
goto error;
}
|
| ︙ | ︙ | |||
701 702 703 704 705 706 707 708 709 710 711 712 713 714 |
}
if (!(methods & FLAG(METH_SEEK))) {
#ifndef TCL_NO_DEPRECATED
clonePtr->seekProc = NULL;
#endif
clonePtr->wideSeekProc = NULL;
}
chanPtr->typePtr = clonePtr;
}
/*
* Register the channel in the I/O system, and in our our map for 'chan
* postevent'.
| > > > | 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 |
}
if (!(methods & FLAG(METH_SEEK))) {
#ifndef TCL_NO_DEPRECATED
clonePtr->seekProc = NULL;
#endif
clonePtr->wideSeekProc = NULL;
}
if (!(methods & FLAG(METH_TRUNCATE))) {
clonePtr->truncateProc = NULL;
}
chanPtr->typePtr = clonePtr;
}
/*
* Register the channel in the I/O system, and in our our map for 'chan
* postevent'.
|
| ︙ | ︙ | |||
791 792 793 794 795 796 797 |
Tcl_NotifyChannel(e->rcPtr->chan, e->events);
return 1;
}
static int
ReflectEventDelete(
Tcl_Event *ev,
| | | | 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 |
Tcl_NotifyChannel(e->rcPtr->chan, e->events);
return 1;
}
static int
ReflectEventDelete(
Tcl_Event *ev,
void *cd)
{
/* OWNER thread
*
* Invoked by DeleteThreadReflectedChannelMap() and ReflectClose(). The
* latter ensures that no pending events of this type are run on an
* invalid channel.
*/
ReflectEvent *e = (ReflectEvent *) ev;
if ((ev->proc != ReflectEventRun) || ((cd != NULL) && (cd != e->rcPtr))) {
return 0;
}
return 1;
}
#endif
int
TclChanPostEventObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
/*
* Ensure -> HANDLER thread
*
|
| ︙ | ︙ | |||
994 995 996 997 998 999 1000 | #undef CHAN #undef EVENT } static void TimerRunRead( | | | | 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 |
#undef CHAN
#undef EVENT
}
static void
TimerRunRead(
void *clientData)
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
rcPtr->readTimer = NULL;
Tcl_NotifyChannel(rcPtr->chan, TCL_READABLE);
}
static void
TimerRunWrite(
void *clientData)
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
rcPtr->writeTimer = NULL;
Tcl_NotifyChannel(rcPtr->chan, TCL_WRITABLE);
}
/*
|
| ︙ | ︙ | |||
1054 1055 1056 1057 1058 1059 1060 |
* Syntax = (option value)... ?message?
*
* Bad syntax causes a panic. This is OK because the other side uses
* Tcl_GetReturnOptions and list construction functions to marshall the
* information; if we panic here, something has gone badly wrong already.
*/
| | | 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 |
* Syntax = (option value)... ?message?
*
* Bad syntax causes a panic. This is OK because the other side uses
* Tcl_GetReturnOptions and list construction functions to marshall the
* information; if we panic here, something has gone badly wrong already.
*/
if (TclListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) {
Tcl_Panic("TclChanCaughtErrorBypass: Bad syntax of caught result");
}
if (interp == NULL) {
return;
}
explicitResult = lc & 1; /* Odd number of values? */
|
| ︙ | ︙ | |||
1138 1139 1140 1141 1142 1143 1144 | /* *---------------------------------------------------------------------- * * ReflectClose -- * * This function is invoked when the channel is closed, to delete the | | | | | | 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 |
/*
*----------------------------------------------------------------------
*
* ReflectClose --
*
* This function is invoked when the channel is closed, to delete the
* driver-specific instance data.
*
* Results:
* A posix error.
*
* Side effects:
* Releases memory. Arbitrary, as it calls upon a script.
*
*----------------------------------------------------------------------
*/
static int
ReflectClose(
void *clientData,
Tcl_Interp *interp,
int flags)
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
int result; /* Result code for 'close' */
Tcl_Obj *resObj; /* Result data for 'close' */
ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in
* this interp */
Tcl_HashEntry *hPtr; /* Entry in the above map */
const Tcl_ChannelType *tctPtr;
if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
return EINVAL;
}
if (TclInThreadExit()) {
/*
* This call comes from TclFinalizeIOSystem. There are no
* interpreters, and therefore we cannot call upon the handler command
* anymore. Threading is irrelevant as well. Simply clean up all
* the C level data structures and leave the Tcl level to the other
* finalization functions.
*/
/*
* THREADED => Forward this to the origin thread
*
* Note: DeleteThreadReflectedChannelMap() is the thread exit handler
|
| ︙ | ︙ | |||
1311 1312 1313 1314 1315 1316 1317 | * Allocates memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ static int ReflectInput( | | | 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 |
* Allocates memory. Arbitrary, as it calls upon a script.
*
*----------------------------------------------------------------------
*/
static int
ReflectInput(
void *clientData,
char *buf,
int toRead,
int *errorCodePtr)
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
Tcl_Obj *toReadObj;
int bytec; /* Number of returned bytes */
|
| ︙ | ︙ | |||
1418 1419 1420 1421 1422 1423 1424 | * Allocates memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ static int ReflectOutput( | | | 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 |
* Allocates memory. Arbitrary, as it calls upon a script.
*
*----------------------------------------------------------------------
*/
static int
ReflectOutput(
void *clientData,
const char *buf,
int toWrite,
int *errorCodePtr)
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
Tcl_Obj *bufObj;
Tcl_Obj *resObj; /* Result data for 'write' */
|
| ︙ | ︙ | |||
1547 1548 1549 1550 1551 1552 1553 | * Allocates memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ static long long ReflectSeekWide( | | | 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 |
* Allocates memory. Arbitrary, as it calls upon a script.
*
*----------------------------------------------------------------------
*/
static long long
ReflectSeekWide(
void *clientData,
long long offset,
int seekMode,
int *errorCodePtr)
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
Tcl_Obj *offObj, *baseObj;
Tcl_Obj *resObj; /* Result for 'seek' */
|
| ︙ | ︙ | |||
1624 1625 1626 1627 1628 1629 1630 |
newLoc = -1;
goto stop;
}
#ifndef TCL_NO_DEPRECATED
static int
ReflectSeek(
| | | 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 |
newLoc = -1;
goto stop;
}
#ifndef TCL_NO_DEPRECATED
static int
ReflectSeek(
void *clientData,
long offset,
int seekMode,
int *errorCodePtr)
{
/*
* This function can be invoked from a transformation which is based on
* standard seeking, i.e. non-wide. Because of this we have to implement
|
| ︙ | ︙ | |||
1660 1661 1662 1663 1664 1665 1666 | * Allocates memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ static void ReflectWatch( | | | 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 |
* Allocates memory. Arbitrary, as it calls upon a script.
*
*----------------------------------------------------------------------
*/
static void
ReflectWatch(
void *clientData,
int mask)
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
Tcl_Obj *maskObj;
/*
* We restrict the interest to what the channel can support. IOW there
|
| ︙ | ︙ | |||
1732 1733 1734 1735 1736 1737 1738 | * Allocates memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ static int ReflectBlock( | | | 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 |
* Allocates memory. Arbitrary, as it calls upon a script.
*
*----------------------------------------------------------------------
*/
static int
ReflectBlock(
void *clientData,
int nonblocking)
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
Tcl_Obj *blockObj;
int errorNum; /* EINVAL or EOK (success). */
Tcl_Obj *resObj; /* Result data for 'blocking' */
|
| ︙ | ︙ | |||
1799 1800 1801 1802 1803 1804 1805 | * Allocates memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ static void ReflectThread( | | | 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 |
* Allocates memory. Arbitrary, as it calls upon a script.
*
*----------------------------------------------------------------------
*/
static void
ReflectThread(
void *clientData,
int action)
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
switch (action) {
case TCL_CHANNEL_THREAD_INSERT:
rcPtr->owner = Tcl_GetCurrentThread();
|
| ︙ | ︙ | |||
1836 1837 1838 1839 1840 1841 1842 | * Arbitrary, as it calls upon a Tcl script. * *---------------------------------------------------------------------- */ static int ReflectSetOption( | | | 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 |
* Arbitrary, as it calls upon a Tcl script.
*
*----------------------------------------------------------------------
*/
static int
ReflectSetOption(
void *clientData, /* Channel to query */
Tcl_Interp *interp, /* Interpreter to leave error messages in */
const char *optionName, /* Name of requested option */
const char *newValue) /* The new value */
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
Tcl_Obj *optionObj, *valueObj;
int result; /* Result code for 'configure' */
|
| ︙ | ︙ | |||
1908 1909 1910 1911 1912 1913 1914 | * Arbitrary, as it calls upon a Tcl script. * *---------------------------------------------------------------------- */ static int ReflectGetOption( | | | 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 |
* Arbitrary, as it calls upon a Tcl script.
*
*----------------------------------------------------------------------
*/
static int
ReflectGetOption(
void *clientData, /* Channel to query */
Tcl_Interp *interp, /* Interpreter to leave error messages in */
const char *optionName, /* Name of reuqested option */
Tcl_DString *dsPtr) /* String to place the result into */
{
/*
* This code is special. It has regular passing of Tcl result, and errors.
* The bypass functions are not required.
|
| ︙ | ︙ | |||
2002 2003 2004 2005 2006 2007 2008 |
/*
* NOTE (4): If we extract the string rep we can assume a properly quoted
* string. Together with a separating space this way of simply appending
* the whole string rep might be faster. It also doesn't check if the
* result is a valid list. Nor that the list has an even number elements.
*/
| | | 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 |
/*
* NOTE (4): If we extract the string rep we can assume a properly quoted
* string. Together with a separating space this way of simply appending
* the whole string rep might be faster. It also doesn't check if the
* result is a valid list. Nor that the list has an even number elements.
*/
if (TclListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) {
goto error;
}
if ((listc % 2) == 1) {
/*
* Odd number of elements is wrong.
*/
|
| ︙ | ︙ | |||
2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 |
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
Tcl_Release(rcPtr);
return result;
error:
result = TCL_ERROR;
goto stop;
}
/*
* Helpers. =========================================================
*/
/*
*----------------------------------------------------------------------
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
Tcl_Release(rcPtr);
return result;
error:
result = TCL_ERROR;
goto stop;
}
/*
*----------------------------------------------------------------------
*
* ReflectTruncate --
*
* This function is invoked to truncate a channel's file size.
*
* Results:
* A standard Tcl result code.
*
* Side effects:
* Arbitrary, as it calls upon a Tcl script.
*
*----------------------------------------------------------------------
*/
static int
ReflectTruncate(
void *clientData, /* Channel to query */
long long length) /* Length to truncate to. */
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
Tcl_Obj *lenObj;
int errorNum; /* EINVAL or EOK (success). */
Tcl_Obj *resObj; /* Result for 'truncate' */
/*
* Are we in the correct thread?
*/
#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
p.truncate.length = length;
ForwardOpToHandlerThread(rcPtr, ForwardedTruncate, &p);
if (p.base.code != TCL_OK) {
PassReceivedError(rcPtr->chan, &p);
return EINVAL;
}
return EOK;
}
#endif
/* ASSERT: rcPtr->method & FLAG(METH_TRUNCATE) */
Tcl_Preserve(rcPtr);
lenObj = Tcl_NewWideIntObj(length);
Tcl_IncrRefCount(lenObj);
if (InvokeTclMethod(rcPtr,METH_TRUNCATE,lenObj,NULL,&resObj)!=TCL_OK) {
Tcl_SetChannelError(rcPtr->chan, resObj);
errorNum = EINVAL;
} else {
errorNum = EOK;
}
Tcl_DecrRefCount(lenObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
Tcl_Release(rcPtr);
return errorNum;
}
/*
* Helpers. =========================================================
*/
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
2081 2082 2083 2084 2085 2086 2087 |
{
int events; /* Mask of events to post */
int listc; /* #elements in eventspec list */
Tcl_Obj **listv; /* Elements of eventspec list */
int evIndex; /* Id of event for an element of the eventspec
* list. */
| | | 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 |
{
int events; /* Mask of events to post */
int listc; /* #elements in eventspec list */
Tcl_Obj **listv; /* Elements of eventspec list */
int evIndex; /* Id of event for an element of the eventspec
* list. */
if (TclListObjGetElements(interp, obj, &listc, &listv) != TCL_OK) {
return TCL_ERROR;
}
if (listc < 1) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad %s list: is empty", objName));
return TCL_ERROR;
|
| ︙ | ︙ | |||
2559 2560 2561 2562 2563 2564 2565 |
rcPtr->cmd = NULL;
}
rcPtr->dead = 1;
}
static void
DeleteReflectedChannelMap(
| | | 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 |
rcPtr->cmd = NULL;
}
rcPtr->dead = 1;
}
static void
DeleteReflectedChannelMap(
void *clientData, /* The per-interpreter data structure. */
Tcl_Interp *interp) /* The interpreter being deleted. */
{
ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)clientData;
/* The map */
Tcl_HashSearch hSearch; /* Search variable. */
Tcl_HashEntry *hPtr; /* Search variable. */
ReflectedChannel *rcPtr;
|
| ︙ | ︙ | |||
2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 |
continue;
}
MarkDead(rcPtr);
Tcl_DeleteHashEntry(hPtr);
}
#endif
}
#if TCL_THREADS
/*
*----------------------------------------------------------------------
*
| > > | 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 |
continue;
}
MarkDead(rcPtr);
Tcl_DeleteHashEntry(hPtr);
}
#else
(void)interp;
#endif
}
#if TCL_THREADS
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
2736 2737 2738 2739 2740 2741 2742 | * Deletes the hash table of channels. * *---------------------------------------------------------------------- */ static void DeleteThreadReflectedChannelMap( | | | 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 |
* Deletes the hash table of channels.
*
*----------------------------------------------------------------------
*/
static void
DeleteThreadReflectedChannelMap(
TCL_UNUSED(void *))
{
Tcl_HashSearch hSearch; /* Search variable. */
Tcl_HashEntry *hPtr; /* Search variable. */
Tcl_ThreadId self = Tcl_GetCurrentThread();
ReflectedChannelMap *rcmPtr; /* The map */
ForwardingResult *resultPtr;
|
| ︙ | ︙ | |||
3244 3245 3246 3247 3248 3249 3250 | * Extract list, validate that it is a list, and #elements. See * NOTE (4) as well. */ int listc; Tcl_Obj **listv; | | | 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 |
* Extract list, validate that it is a list, and #elements. See
* NOTE (4) as well.
*/
int listc;
Tcl_Obj **listv;
if (TclListObjGetElements(interp, resObj, &listc,
&listv) != TCL_OK) {
Tcl_DecrRefCount(resObj);
resObj = MarshallError(interp);
ForwardSetObjError(paramPtr, resObj);
} else if ((listc % 2) == 1) {
/*
* Odd number of elements is wrong. [x].
|
| ︙ | ︙ | |||
3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 |
TclDStringAppendLiteral(paramPtr->getOpt.value, " ");
Tcl_DStringAppend(paramPtr->getOpt.value, str, len);
}
}
}
Tcl_Release(rcPtr);
break;
default:
/*
* Bad operation code.
*/
Tcl_Panic("Bad operation code in ForwardProc");
| > > > > > > > > > > > > > | 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 |
TclDStringAppendLiteral(paramPtr->getOpt.value, " ");
Tcl_DStringAppend(paramPtr->getOpt.value, str, len);
}
}
}
Tcl_Release(rcPtr);
break;
case ForwardedTruncate: {
Tcl_Obj *lenObj = Tcl_NewWideIntObj(paramPtr->truncate.length);
Tcl_IncrRefCount(lenObj);
Tcl_Preserve(rcPtr);
if (InvokeTclMethod(rcPtr,METH_TRUNCATE,lenObj,NULL,&resObj)!=TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
}
Tcl_Release(rcPtr);
Tcl_DecrRefCount(lenObj);
break;
}
default:
/*
* Bad operation code.
*/
Tcl_Panic("Bad operation code in ForwardProc");
|
| ︙ | ︙ | |||
3309 3310 3311 3312 3313 3314 3315 |
}
return 1;
}
static void
SrcExitProc(
| | | 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 |
}
return 1;
}
static void
SrcExitProc(
void *clientData)
{
ForwardingEvent *evPtr = (ForwardingEvent *)clientData;
ForwardingResult *resultPtr;
ForwardParam *paramPtr;
/*
* NOTE (2): Can this handler be called with the originator blocked?
|
| ︙ | ︙ |
Changes to generic/tclIORTrans.c.
| ︙ | ︙ | |||
27 28 29 30 31 32 33 | #define EOK 0 #endif /* * Signatures of all functions used in the C layer of the reflection. */ | | | | | | | | | | | | | | 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 |
#define EOK 0
#endif
/*
* Signatures of all functions used in the C layer of the reflection.
*/
static int ReflectClose(void *clientData,
Tcl_Interp *interp, int flags);
static int ReflectInput(void *clientData, char *buf,
int toRead, int *errorCodePtr);
static int ReflectOutput(void *clientData, const char *buf,
int toWrite, int *errorCodePtr);
static void ReflectWatch(void *clientData, int mask);
static int ReflectBlock(void *clientData, int mode);
static long long ReflectSeekWide(void *clientData,
long long offset, int mode, int *errorCodePtr);
#ifndef TCL_NO_DEPRECATED
static int ReflectSeek(void *clientData, long offset,
int mode, int *errorCodePtr);
#endif
static int ReflectGetOption(void *clientData,
Tcl_Interp *interp, const char *optionName,
Tcl_DString *dsPtr);
static int ReflectSetOption(void *clientData,
Tcl_Interp *interp, const char *optionName,
const char *newValue);
static int ReflectHandle(void *clientData, int direction,
void **handle);
static int ReflectNotify(void *clientData, int mask);
/*
* The C layer channel type/driver definition used by the reflection.
*/
static const Tcl_ChannelType tclRTransformType = {
"tclrtransform", /* Type name. */
|
| ︙ | ︙ | |||
87 88 89 90 91 92 93 |
/*
* Structure of the buffer to hold transform results to be consumed by higher
* layers upon reading from the channel, plus the functions to manage such.
*/
typedef struct {
unsigned char *buf; /* Reference to the buffer area. */
| | | | | | | | | | 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 |
/*
* Structure of the buffer to hold transform results to be consumed by higher
* layers upon reading from the channel, plus the functions to manage such.
*/
typedef struct {
unsigned char *buf; /* Reference to the buffer area. */
size_t allocated; /* Allocated size of the buffer area. */
size_t used; /* Number of bytes in the buffer,
* <= allocated. */
} ResultBuffer;
#define ResultLength(r) ((r)->used)
/* static int ResultLength(ResultBuffer *r); */
static inline void ResultClear(ResultBuffer *r);
static inline void ResultInit(ResultBuffer *r);
static inline void ResultAdd(ResultBuffer *r, unsigned char *buf,
size_t toWrite);
static inline size_t ResultCopy(ResultBuffer *r, unsigned char *buf,
size_t toRead);
#define RB_INCREMENT (512)
/*
* Convenience macro to make some casts easier to use.
*/
|
| ︙ | ︙ | |||
216 217 218 219 220 221 222 | #define REQUIRED_METHODS \ (FLAG(METH_INIT) | FLAG(METH_FINAL)) #define RANDW \ (TCL_READABLE | TCL_WRITABLE) #define IMPLIES(a,b) ((!(a)) || (b)) #define NEGIMPL(a,b) | | | 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 | #define REQUIRED_METHODS \ (FLAG(METH_INIT) | FLAG(METH_FINAL)) #define RANDW \ (TCL_READABLE | TCL_WRITABLE) #define IMPLIES(a,b) ((!(a)) || (b)) #define NEGIMPL(a,b) #define HAS(x,f) ((x) & FLAG(f)) #if TCL_THREADS /* * Thread specific types and structures. * * We are here essentially creating a very specific implementation of 'thread * send'. |
| ︙ | ︙ | |||
359 360 361 362 363 364 365 | * thread involved in the forwarding exits. They also clean things up so that * we don't leak resources when threads go away. */ static void ForwardOpToOwnerThread(ReflectedTransform *rtPtr, ForwardedOperation op, const void *param); static int ForwardProc(Tcl_Event *evPtr, int mask); | | | 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 |
* thread involved in the forwarding exits. They also clean things up so that
* we don't leak resources when threads go away.
*/
static void ForwardOpToOwnerThread(ReflectedTransform *rtPtr,
ForwardedOperation op, const void *param);
static int ForwardProc(Tcl_Event *evPtr, int mask);
static void SrcExitProc(void *clientData);
#define FreeReceivedError(p) \
do { \
if ((p)->base.mustFree) { \
ckfree((p)->base.msgStr); \
} \
} while (0)
|
| ︙ | ︙ | |||
398 399 400 401 402 403 404 | (p)->base.msgStr = (char *) (emsg); \ } while (0) static void ForwardSetObjError(ForwardParam *p, Tcl_Obj *objPtr); static ReflectedTransformMap * GetThreadReflectedTransformMap(void); static void DeleteThreadReflectedTransformMap( | | | 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 | (p)->base.msgStr = (char *) (emsg); \ } while (0) static void ForwardSetObjError(ForwardParam *p, Tcl_Obj *objPtr); static ReflectedTransformMap * GetThreadReflectedTransformMap(void); static void DeleteThreadReflectedTransformMap( void *clientData); #endif /* TCL_THREADS */ #define SetChannelErrorStr(c,msgStr) \ Tcl_SetChannelError((c), Tcl_NewStringObj((msgStr), -1)) static Tcl_Obj * MarshallError(Tcl_Interp *interp); static void UnmarshallErrorResult(Tcl_Interp *interp, |
| ︙ | ︙ | |||
424 425 426 427 428 429 430 | static void FreeReflectedTransform(ReflectedTransform *rtPtr); static void FreeReflectedTransformArgs(ReflectedTransform *rtPtr); static int InvokeTclMethod(ReflectedTransform *rtPtr, const char *method, Tcl_Obj *argOneObj, Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr); static ReflectedTransformMap * GetReflectedTransformMap(Tcl_Interp *interp); | | | 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 | static void FreeReflectedTransform(ReflectedTransform *rtPtr); static void FreeReflectedTransformArgs(ReflectedTransform *rtPtr); static int InvokeTclMethod(ReflectedTransform *rtPtr, const char *method, Tcl_Obj *argOneObj, Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr); static ReflectedTransformMap * GetReflectedTransformMap(Tcl_Interp *interp); static void DeleteReflectedTransformMap(void *clientData, Tcl_Interp *interp); /* * Global constant strings (messages). ================== * These string are used directly as bypass errors, thus they have to be valid * Tcl lists where the last element is the message itself. Hence the * list-quoting to keep the words of the message together. See also [x]. |
| ︙ | ︙ | |||
454 455 456 457 458 459 460 | /* * Helper functions encapsulating some of the thread forwarding to make the * control flow in callers easier. */ static void TimerKill(ReflectedTransform *rtPtr); static void TimerSetup(ReflectedTransform *rtPtr); | | | 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 | /* * Helper functions encapsulating some of the thread forwarding to make the * control flow in callers easier. */ static void TimerKill(ReflectedTransform *rtPtr); static void TimerSetup(ReflectedTransform *rtPtr); static void TimerRun(void *clientData); static int TransformRead(ReflectedTransform *rtPtr, int *errorCodePtr, Tcl_Obj *bufObj); static int TransformWrite(ReflectedTransform *rtPtr, int *errorCodePtr, unsigned char *buf, int toWrite); static int TransformDrain(ReflectedTransform *rtPtr, int *errorCodePtr); |
| ︙ | ︙ | |||
499 500 501 502 503 504 505 | * Creates a new channel. * *---------------------------------------------------------------------- */ int TclChanPushObjCmd( | | | 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 |
* Creates a new channel.
*
*----------------------------------------------------------------------
*/
int
TclChanPushObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
ReflectedTransform *rtPtr; /* Instance data of the new (transform)
* channel. */
Tcl_Obj *chanObj; /* Handle of parent channel */
|
| ︙ | ︙ | |||
603 604 605 606 607 608 609 |
/*
* Verify the result.
* - List, of method names. Convert to mask. Check for non-optionals
* through the mask. Compare open mode against optional r/w.
*/
| | | 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 |
/*
* Verify the result.
* - List, of method names. Convert to mask. Check for non-optionals
* through the mask. Compare open mode against optional r/w.
*/
if (TclListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s initialize\" returned non-list: %s",
TclGetString(cmdObj), TclGetString(resObj)));
Tcl_DecrRefCount(resObj);
goto error;
}
|
| ︙ | ︙ | |||
744 745 746 747 748 749 750 | * latter implies that arbitrary side effects are possible. * *---------------------------------------------------------------------- */ int TclChanPopObjCmd( | | | 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 |
* latter implies that arbitrary side effects are possible.
*
*----------------------------------------------------------------------
*/
int
TclChanPopObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
/*
* Syntax: chan pop CHANNEL
* [0] [1] [2]
|
| ︙ | ︙ | |||
839 840 841 842 843 844 845 |
* Syntax = (option value)... ?message?
*
* Bad syntax causes a panic. This is OK because the other side uses
* Tcl_GetReturnOptions and list construction functions to marshall the
* information; if we panic here, something has gone badly wrong already.
*/
| | | 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 |
* Syntax = (option value)... ?message?
*
* Bad syntax causes a panic. This is OK because the other side uses
* Tcl_GetReturnOptions and list construction functions to marshall the
* information; if we panic here, something has gone badly wrong already.
*/
if (TclListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) {
Tcl_Panic("TclChanCaughtErrorBypass: Bad syntax of caught result");
}
if (interp == NULL) {
return;
}
explicitResult = lc & 1; /* Odd number of values? */
|
| ︙ | ︙ | |||
880 881 882 883 884 885 886 | * Releases memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ static int ReflectClose( | | | 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 |
* Releases memory. Arbitrary, as it calls upon a script.
*
*----------------------------------------------------------------------
*/
static int
ReflectClose(
void *clientData,
Tcl_Interp *interp,
int flags)
{
ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
int errorCode, errorCodeSet = 0;
int result = TCL_OK; /* Result code for 'close' */
Tcl_Obj *resObj; /* Result data for 'close' */
|
| ︙ | ︙ | |||
1059 1060 1061 1062 1063 1064 1065 | * Allocates memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ static int ReflectInput( | | | 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 |
* Allocates memory. Arbitrary, as it calls upon a script.
*
*----------------------------------------------------------------------
*/
static int
ReflectInput(
void *clientData,
char *buf,
int toRead,
int *errorCodePtr)
{
ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
int gotBytes, copied, readBytes;
Tcl_Obj *bufObj;
|
| ︙ | ︙ | |||
1252 1253 1254 1255 1256 1257 1258 | * Allocates memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ static int ReflectOutput( | | | 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 |
* Allocates memory. Arbitrary, as it calls upon a script.
*
*----------------------------------------------------------------------
*/
static int
ReflectOutput(
void *clientData,
const char *buf,
int toWrite,
int *errorCodePtr)
{
ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
/*
|
| ︙ | ︙ | |||
1325 1326 1327 1328 1329 1330 1331 | * scripts. * *---------------------------------------------------------------------- */ static long long ReflectSeekWide( | | | 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 |
* scripts.
*
*----------------------------------------------------------------------
*/
static long long
ReflectSeekWide(
void *clientData,
long long offset,
int seekMode,
int *errorCodePtr)
{
ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
Channel *parent = (Channel *) rtPtr->parent;
Tcl_WideInt curPos; /* Position on the device. */
|
| ︙ | ︙ | |||
1407 1408 1409 1410 1411 1412 1413 |
Tcl_Release(rtPtr);
return curPos;
}
#ifndef TCL_NO_DEPRECATED
static int
ReflectSeek(
| | | 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 |
Tcl_Release(rtPtr);
return curPos;
}
#ifndef TCL_NO_DEPRECATED
static int
ReflectSeek(
void *clientData,
long offset,
int seekMode,
int *errorCodePtr)
{
/*
* This function can be invoked from a transformation which is based on
* standard seeking, i.e. non-wide. Because of this we have to implement
|
| ︙ | ︙ | |||
1443 1444 1445 1446 1447 1448 1449 | * Allocates memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ static void ReflectWatch( | | | 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 |
* Allocates memory. Arbitrary, as it calls upon a script.
*
*----------------------------------------------------------------------
*/
static void
ReflectWatch(
void *clientData,
int mask)
{
ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
Tcl_DriverWatchProc *watchProc;
watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(rtPtr->parent));
watchProc(Tcl_GetChannelInstanceData(rtPtr->parent), mask);
|
| ︙ | ︙ | |||
1494 1495 1496 1497 1498 1499 1500 | * Allocates memory. Arbitrary, as it calls upon a script. * *---------------------------------------------------------------------- */ static int ReflectBlock( | | | 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 |
* Allocates memory. Arbitrary, as it calls upon a script.
*
*----------------------------------------------------------------------
*/
static int
ReflectBlock(
void *clientData,
int nonblocking)
{
ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
/*
* Transformations simply record the blocking mode in their C level
* structure for use by --> ReflectInput. The Tcl level doesn't see this
|
| ︙ | ︙ | |||
1527 1528 1529 1530 1531 1532 1533 | * Arbitrary, per the parent channel. * *---------------------------------------------------------------------- */ static int ReflectSetOption( | | | 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 |
* Arbitrary, per the parent channel.
*
*----------------------------------------------------------------------
*/
static int
ReflectSetOption(
void *clientData, /* Channel to query */
Tcl_Interp *interp, /* Interpreter to leave error messages in */
const char *optionName, /* Name of requested option */
const char *newValue) /* The new value */
{
ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
/*
|
| ︙ | ︙ | |||
1569 1570 1571 1572 1573 1574 1575 | * Arbitrary, per the parent channel. * *---------------------------------------------------------------------- */ static int ReflectGetOption( | | | 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 |
* Arbitrary, per the parent channel.
*
*----------------------------------------------------------------------
*/
static int
ReflectGetOption(
void *clientData, /* Channel to query */
Tcl_Interp *interp, /* Interpreter to leave error messages in */
const char *optionName, /* Name of reuqested option */
Tcl_DString *dsPtr) /* String to place the result into */
{
ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
/*
|
| ︙ | ︙ | |||
1618 1619 1620 1621 1622 1623 1624 | * Arbitrary, per the parent channel. * *---------------------------------------------------------------------- */ static int ReflectHandle( | | | | 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 |
* Arbitrary, per the parent channel.
*
*----------------------------------------------------------------------
*/
static int
ReflectHandle(
void *clientData,
int direction,
void **handlePtr)
{
ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
/*
* Transformations have no handle of their own. As such we simply query
* the parent channel for it. This way the qery will ripple down through
* all transformations until reaches the base channel. Which then returns
|
| ︙ | ︙ | |||
1654 1655 1656 1657 1658 1659 1660 | * Arbitrary, per the parent channel. * *---------------------------------------------------------------------- */ static int ReflectNotify( | | | 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 |
* Arbitrary, per the parent channel.
*
*----------------------------------------------------------------------
*/
static int
ReflectNotify(
void *clientData,
int mask)
{
ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
/*
* An event occured in the underlying channel.
*
|
| ︙ | ︙ | |||
1792 1793 1794 1795 1796 1797 1798 |
/*
* Method placeholder.
*/
/* ASSERT: cmdpfxObj is a Tcl List */
| | | 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 |
/*
* Method placeholder.
*/
/* ASSERT: cmdpfxObj is a Tcl List */
TclListObjGetElements(interp, cmdpfxObj, &listc, &listv);
/*
* See [==] as well.
* Storage for the command prefix and the additional words required for
* the invocation of methods in the command handler.
*
* listv [0] [listc-1] | [listc] [listc+1] |
|
| ︙ | ︙ | |||
2143 2144 2145 2146 2147 2148 2149 | * registered in this interpreter. * *---------------------------------------------------------------------- */ static void DeleteReflectedTransformMap( | | > > | 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 |
* registered in this interpreter.
*
*----------------------------------------------------------------------
*/
static void
DeleteReflectedTransformMap(
void *clientData, /* The per-interpreter data structure. */
Tcl_Interp *interp) /* The interpreter being deleted. */
{
ReflectedTransformMap *rtmPtr; /* The map */
Tcl_HashSearch hSearch; /* Search variable. */
Tcl_HashEntry *hPtr; /* Search variable. */
ReflectedTransform *rtPtr;
#if TCL_THREADS
ForwardingResult *resultPtr;
ForwardingEvent *evPtr;
ForwardParam *paramPtr;
#else
(void)interp;
#endif /* TCL_THREADS */
/*
* Delete all entries. The channels may have been closed already, or will
* be closed later, by the standard IO finalization of an interpreter
* under destruction. Except for the channels which were moved to a
* different interpreter and/or thread. They do not exist from the IO
|
| ︙ | ︙ | |||
2304 2305 2306 2307 2308 2309 2310 | * Deletes the hash table of channels. * *---------------------------------------------------------------------- */ static void DeleteThreadReflectedTransformMap( | | | 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 |
* Deletes the hash table of channels.
*
*----------------------------------------------------------------------
*/
static void
DeleteThreadReflectedTransformMap(
TCL_UNUSED(void *))
{
Tcl_HashSearch hSearch; /* Search variable. */
Tcl_HashEntry *hPtr; /* Search variable. */
Tcl_ThreadId self = Tcl_GetCurrentThread();
ReflectedTransformMap *rtmPtr; /* The map */
ForwardingResult *resultPtr;
|
| ︙ | ︙ | |||
2753 2754 2755 2756 2757 2758 2759 |
}
return 1;
}
static void
SrcExitProc(
| | | 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 |
}
return 1;
}
static void
SrcExitProc(
void *clientData)
{
ForwardingEvent *evPtr = (ForwardingEvent *)clientData;
ForwardingResult *resultPtr;
ForwardParam *paramPtr;
/*
* NOTE (2): Can this handler be called with the originator blocked?
|
| ︙ | ︙ | |||
2893 2894 2895 2896 2897 2898 2899 | * None. * *---------------------------------------------------------------------- */ static void TimerRun( | | | 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 |
* None.
*
*----------------------------------------------------------------------
*/
static void
TimerRun(
void *clientData)
{
ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
rtPtr->timer = NULL;
Tcl_NotifyChannel(rtPtr->chan, TCL_READABLE);
}
|
| ︙ | ︙ | |||
2918 2919 2920 2921 2922 2923 2924 | * * Result: * None. * *---------------------------------------------------------------------- */ | | | 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 |
*
* Result:
* None.
*
*----------------------------------------------------------------------
*/
static inline void
ResultInit(
ResultBuffer *rPtr) /* Reference to the structure to
* initialize. */
{
rPtr->used = 0;
rPtr->allocated = 0;
rPtr->buf = NULL;
|
| ︙ | ︙ | |||
2943 2944 2945 2946 2947 2948 2949 | * * Result: * None. * *---------------------------------------------------------------------- */ | | | 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 |
*
* Result:
* None.
*
*----------------------------------------------------------------------
*/
static inline void
ResultClear(
ResultBuffer *rPtr) /* Reference to the buffer to clear out */
{
rPtr->used = 0;
if (!rPtr->allocated) {
return;
|
| ︙ | ︙ | |||
2974 2975 2976 2977 2978 2979 2980 | * * Result: * None. * *---------------------------------------------------------------------- */ | | | | 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 |
*
* Result:
* None.
*
*----------------------------------------------------------------------
*/
static inline void
ResultAdd(
ResultBuffer *rPtr, /* The buffer to extend */
unsigned char *buf, /* The buffer to read from */
size_t toWrite) /* The number of bytes in 'buf' */
{
if ((rPtr->used + toWrite + 1) > rPtr->allocated) {
/*
* Extension of the internal buffer is required.
* NOTE: Currently linear. Should be doubling to amortize.
*/
|
| ︙ | ︙ | |||
3022 3023 3024 3025 3026 3027 3028 | * * Result: * The number of actually copied bytes, possibly less than 'toRead'. * *---------------------------------------------------------------------- */ | | | | 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 |
*
* Result:
* The number of actually copied bytes, possibly less than 'toRead'.
*
*----------------------------------------------------------------------
*/
static inline size_t
ResultCopy(
ResultBuffer *rPtr, /* The buffer to read from */
unsigned char *buf, /* The buffer to copy into */
size_t toRead) /* Number of requested bytes */
{
int copied;
if (rPtr->used == 0) {
/*
* Nothing to copy in the case of an empty buffer.
*/
|
| ︙ | ︙ |
Changes to generic/tclIOUtil.c.
| ︙ | ︙ | |||
1061 1062 1063 1064 1065 1066 1067 |
if (ret == TCL_OK) {
FsAddMountsToGlobResult(tmpResultPtr, cwd, pattern, types);
/*
* resultPtr and tmpResultPtr are guaranteed to be distinct.
*/
| | | 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 |
if (ret == TCL_OK) {
FsAddMountsToGlobResult(tmpResultPtr, cwd, pattern, types);
/*
* resultPtr and tmpResultPtr are guaranteed to be distinct.
*/
ret = TclListObjGetElements(interp, tmpResultPtr,
&resLength, &elemsPtr);
for (i=0 ; ret==TCL_OK && i<resLength ; i++) {
ret = Tcl_ListObjAppendElement(interp, resultPtr,
TclFSMakePathRelative(interp, elemsPtr[i], cwd));
}
}
TclDecrRefCount(tmpResultPtr);
|
| ︙ | ︙ | |||
1109 1110 1111 1112 1113 1114 1115 |
int dir = (types == NULL || (types->type & TCL_GLOB_TYPE_DIR));
Tcl_Obj *mounts = FsListMounts(pathPtr, pattern);
if (mounts == NULL) {
return;
}
| | | | 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 |
int dir = (types == NULL || (types->type & TCL_GLOB_TYPE_DIR));
Tcl_Obj *mounts = FsListMounts(pathPtr, pattern);
if (mounts == NULL) {
return;
}
if (TclListObjLength(NULL, mounts, &mLength) != TCL_OK || mLength == 0) {
goto endOfMounts;
}
if (TclListObjLength(NULL, resultPtr, &gLength) != TCL_OK) {
goto endOfMounts;
}
for (i=0 ; i<mLength ; i++) {
Tcl_Obj *mElt;
int j;
int found = 0;
|
| ︙ | ︙ | |||
2472 2473 2474 2475 2476 2477 2478 | /* * It's a non-constant attribute list, so do a literal search. */ int i, objc; Tcl_Obj **objv; | | | 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 |
/*
* It's a non-constant attribute list, so do a literal search.
*/
int i, objc;
Tcl_Obj **objv;
if (TclListObjGetElements(NULL, listObj, &objc, &objv) != TCL_OK) {
TclDecrRefCount(listObj);
return TCL_ERROR;
}
for (i=0 ; i<objc ; i++) {
if (!strcmp(attributeName, TclGetString(objv[i]))) {
TclDecrRefCount(listObj);
*indexPtr = i;
|
| ︙ | ︙ | |||
2642 2643 2644 2645 2646 2647 2648 |
*/
retVal = fsRecPtr->fsPtr->internalToNormalizedProc(retCd);
Tcl_IncrRefCount(retVal);
norm = TclFSNormalizeAbsolutePath(interp,retVal);
if (norm != NULL) {
/*
| | | > | 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 |
*/
retVal = fsRecPtr->fsPtr->internalToNormalizedProc(retCd);
Tcl_IncrRefCount(retVal);
norm = TclFSNormalizeAbsolutePath(interp,retVal);
if (norm != NULL) {
/*
* Assign to global storage the pathname of the current
* directory and copy it into thread-local storage as
* well.
*
* At system startup multiple threads could in principle
* call this function simultaneously, which is a little
* peculiar, but should be fine given the mutex locks in
* FSUPdateCWD. Once some value is assigned to the global
* variable the 'else' branch below is always taken, which
* is simpler.
|
| ︙ | ︙ | |||
3005 3006 3007 3008 3009 3010 3011 |
Tcl_FSLoadFile(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Obj *pathPtr, /* Pathname of the file containing the dynamic shared object.
*/
const char *sym1, const char *sym2,
/* Names of two functions to find in the
* dynamic shared object. */
| | | | | 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 |
Tcl_FSLoadFile(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Obj *pathPtr, /* Pathname of the file containing the dynamic shared object.
*/
const char *sym1, const char *sym2,
/* Names of two functions to find in the
* dynamic shared object. */
Tcl_LibraryInitProc **proc1Ptr, Tcl_LibraryInitProc **proc2Ptr,
/* Places to store pointers to the functions
* named by sym1 and sym2. */
Tcl_LoadHandle *handlePtr, /* A place to store the token for the loaded
* object. Can be passed to
* (*unloadProcPtr)() to unload the file. */
TCL_UNUSED(Tcl_FSUnloadFileProc **))
{
const char *symbols[3];
void *procPtrs[2];
int res;
symbols[0] = sym1;
symbols[1] = sym2;
symbols[2] = NULL;
res = Tcl_LoadFile(interp, pathPtr, symbols, 0, procPtrs, handlePtr);
if (res == TCL_OK) {
*proc1Ptr = (Tcl_LibraryInitProc *) procPtrs[0];
*proc2Ptr = (Tcl_LibraryInitProc *) procPtrs[1];
} else {
*proc1Ptr = *proc2Ptr = NULL;
}
return res;
}
|
| ︙ | ︙ | |||
3785 3786 3787 3788 3789 3790 3791 |
Claim();
while (fsRecPtr != NULL) {
if (fsRecPtr->fsPtr->listVolumesProc != NULL) {
Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc();
if (thisFsVolumes != NULL) {
Tcl_ListObjAppendList(NULL, resultPtr, thisFsVolumes);
| > | | | | > | 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 |
Claim();
while (fsRecPtr != NULL) {
if (fsRecPtr->fsPtr->listVolumesProc != NULL) {
Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc();
if (thisFsVolumes != NULL) {
Tcl_ListObjAppendList(NULL, resultPtr, thisFsVolumes);
/*
* The refCount of each list returned by a `listVolumesProc`
* is already incremented. Do not hang onto the list, though.
* It belongs to the filesystem. Add its contents to the
* result we are building, and then decrement the refCount.
*/
Tcl_DecrRefCount(thisFsVolumes);
}
}
fsRecPtr = fsRecPtr->nextPtr;
}
Disclaim();
|
| ︙ | ︙ | |||
4065 4066 4067 4068 4069 4070 4071 |
if ((fsRecPtr->fsPtr != &tclNativeFilesystem)
&& (fsRecPtr->fsPtr->listVolumesProc != NULL)) {
int numVolumes;
Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc();
if (thisFsVolumes != NULL) {
| | | 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 |
if ((fsRecPtr->fsPtr != &tclNativeFilesystem)
&& (fsRecPtr->fsPtr->listVolumesProc != NULL)) {
int numVolumes;
Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc();
if (thisFsVolumes != NULL) {
if (TclListObjLength(NULL, thisFsVolumes, &numVolumes)
!= TCL_OK) {
/*
* This is VERY bad; the listVolumesProc didn't return a
* valid list. Set numVolumes to -1 to skip the loop below
* and just return with the current value of 'type'.
*
* It would be better to signal an error here, but
|
| ︙ | ︙ | |||
4361 4362 4363 4364 4365 4366 4367 | * copyDirectoryProc is found. * *--------------------------------------------------------------------------- */ int Tcl_FSCopyDirectory( | | | < | | | | | 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 |
* copyDirectoryProc is found.
*
*---------------------------------------------------------------------------
*/
int
Tcl_FSCopyDirectory(
Tcl_Obj *srcPathPtr, /* The pathname of the directory to be
* copied. */
Tcl_Obj *destPathPtr, /* The pathname of the target directory. */
Tcl_Obj **errorPtr) /* If not NULL, and there is an error, a place
* to store a pointer to a new object, with
* its refCount already incremented, and
* containing the pathname name of file
* causing the error. */
{
int retVal = -1;
const Tcl_Filesystem *fsPtr, *fsPtr2;
fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);
|
| ︙ | ︙ |
Changes to generic/tclIndexObj.c.
| ︙ | ︙ | |||
21 22 23 24 25 26 27 | static int GetIndexFromObjList(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *tableObjPtr, const char *msg, int flags, int *indexPtr); static void UpdateStringOfIndex(Tcl_Obj *objPtr); static void DupIndex(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr); static void FreeIndex(Tcl_Obj *objPtr); | | | | | 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 | static int GetIndexFromObjList(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *tableObjPtr, const char *msg, int flags, int *indexPtr); static void UpdateStringOfIndex(Tcl_Obj *objPtr); static void DupIndex(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr); static void FreeIndex(Tcl_Obj *objPtr); static int PrefixAllObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int PrefixLongestObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int PrefixMatchObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void PrintUsage(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable); /* * The structure below defines the index Tcl object type by means of functions |
| ︙ | ︙ | |||
69 70 71 72 73 74 75 | */ #define STRING_AT(table, offset) \ (*((const char *const *)(((char *)(table)) + (offset)))) #define NEXT_ENTRY(table, offset) \ (&(STRING_AT(table, offset))) #define EXPAND_OF(indexRep) \ | | | 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 | */ #define STRING_AT(table, offset) \ (*((const char *const *)(((char *)(table)) + (offset)))) #define NEXT_ENTRY(table, offset) \ (&(STRING_AT(table, offset))) #define EXPAND_OF(indexRep) \ (((indexRep)->index >= 0) ? STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index) : "") /* *---------------------------------------------------------------------- * * Tcl_GetIndexFromObj -- * * This function looks up an object's value in a table of strings and |
| ︙ | ︙ | |||
102 103 104 105 106 107 108 |
#ifndef TCL_NO_DEPRECATED
#undef Tcl_GetIndexFromObj
int
Tcl_GetIndexFromObj(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
Tcl_Obj *objPtr, /* Object containing the string to lookup. */
| | | | | 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 |
#ifndef TCL_NO_DEPRECATED
#undef Tcl_GetIndexFromObj
int
Tcl_GetIndexFromObj(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
Tcl_Obj *objPtr, /* Object containing the string to lookup. */
const char *const *tablePtr, /* Array of strings to compare against the
* value of objPtr; last entry must be NULL
* and there must not be duplicate entries. */
const char *msg, /* Identifying word to use in error
* messages. */
int flags, /* 0 or TCL_EXACT */
int *indexPtr) /* Place to store resulting integer index. */
{
if (!(flags & TCL_INDEX_TEMP_TABLE)) {
/*
* See if there is a valid cached result from a previous lookup (doing the
* check here saves the overhead of calling Tcl_GetIndexFromObjStruct in
* the common case where the result is cached).
*/
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &indexType);
if (irPtr) {
IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
/*
* Here's hoping we don't get hit by unfortunate packing constraints
* on odd platforms like a Cray PVP...
*/
if (indexRep->tablePtr == (void *)tablePtr
&& indexRep->offset == sizeof(char *)) {
*indexPtr = indexRep->index;
return TCL_OK;
}
}
}
return Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, sizeof(char *),
|
| ︙ | ︙ | |||
186 187 188 189 190 191 192 |
const char **tablePtr;
/*
* Use Tcl_GetIndexFromObjStruct to do the work to avoid duplicating most
* of the code there. This is a bit ineffiecient but simpler.
*/
| | | 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 |
const char **tablePtr;
/*
* Use Tcl_GetIndexFromObjStruct to do the work to avoid duplicating most
* of the code there. This is a bit ineffiecient but simpler.
*/
result = TclListObjGetElements(interp, tableObjPtr, &objc, &objv);
if (result != TCL_OK) {
return result;
}
/*
* Build a string table from the list.
*/
|
| ︙ | ︙ | |||
231 232 233 234 235 236 237 | * This function looks up an object's value given a starting string and * an offset for the amount of space between strings. This is useful when * the strings are embedded in some other kind of array. * * Results: * If the value of objPtr is identical to or a unique abbreviation for * one of the entries in tablePtr, then the return value is TCL_OK and | | > | | | | > | | | | | | > > | < > | > > > | | 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 |
* This function looks up an object's value given a starting string and
* an offset for the amount of space between strings. This is useful when
* the strings are embedded in some other kind of array.
*
* Results:
* If the value of objPtr is identical to or a unique abbreviation for
* one of the entries in tablePtr, then the return value is TCL_OK and
* the index of the matching entry is stored at *indexPtr
* (unless indexPtr is NULL). If there isn't a proper match, then
* TCL_ERROR is returned and an error message is left in interp's
* result (unless interp is NULL). The msg argument is used in the
* error message; for example, if msg has the value "option" then
* the error message will say something like 'bad option "foo": must
* be ...'
*
* Side effects:
* The result of the lookup is cached as the internal rep of objPtr, so
* that repeated lookups can be done quickly.
*
*----------------------------------------------------------------------
*/
#undef Tcl_GetIndexFromObjStruct
int
Tcl_GetIndexFromObjStruct(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
Tcl_Obj *objPtr, /* Object containing the string to lookup. */
const void *tablePtr, /* The first string in the table. The second
* string will be at this address plus the
* offset, the third plus the offset again,
* etc. The last entry must be NULL and there
* must not be duplicate entries. */
int offset, /* The number of bytes between entries */
const char *msg, /* Identifying word to use in error
* messages. */
int flags, /* 0, TCL_EXACT, TCL_INDEX_TEMP_TABLE or TCL_INDEX_NULL_OK */
void *indexPtr) /* Place to store resulting index. */
{
int index, idx, numAbbrev;
const char *key, *p1;
const char *p2;
const char *const *entryPtr;
Tcl_Obj *resultPtr;
IndexRep *indexRep;
const Tcl_ObjInternalRep *irPtr;
/* Protect against invalid values, like -1 or 0. */
if (offset < (int)sizeof(char *)) {
offset = (int)sizeof(char *);
}
/*
* 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 >= 0)) {
index = indexRep->index;
goto uncachedDone;
}
}
}
/*
* Lookup the value of the object in the table. Accept unique
* abbreviations unless TCL_EXACT is set in flags.
*/
key = objPtr ? TclGetString(objPtr) : "";
index = -1;
numAbbrev = 0;
if (!*key && (flags & TCL_INDEX_NULL_OK)) {
goto uncachedDone;
}
/*
* Scan the table looking for one of:
* - An exact match (always preferred)
* - A single abbreviation (allowed depending on flags)
* - Several abbreviations (never allowed, but overridden by exact match)
*/
for (entryPtr = (const char *const *)tablePtr, idx = 0; *entryPtr != NULL;
entryPtr = NEXT_ENTRY(entryPtr, offset), idx++) {
for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) {
if (*p1 == '\0') {
index = idx;
goto done;
}
}
|
| ︙ | ︙ | |||
340 341 342 343 344 345 346 |
done:
/*
* Cache the found representation. Note that we want to avoid allocating a
* new internal-rep if at all possible since that is potentially a slow
* operation.
*/
| | | | | > > > > > > > > > > > > > > > > > | > | | > > > | 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 |
done:
/*
* Cache the found representation. Note that we want to avoid allocating a
* new internal-rep if at all possible since that is potentially a slow
* operation.
*/
if (objPtr && (index >= 0) && !(flags & TCL_INDEX_TEMP_TABLE)) {
irPtr = TclFetchInternalRep(objPtr, &indexType);
if (irPtr) {
indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
} else {
Tcl_ObjInternalRep ir;
indexRep = (IndexRep*)ckalloc(sizeof(IndexRep));
ir.twoPtrValue.ptr1 = indexRep;
Tcl_StoreInternalRep(objPtr, &indexType, &ir);
}
indexRep->tablePtr = (void *) tablePtr;
indexRep->offset = offset;
indexRep->index = index;
}
uncachedDone:
if (indexPtr != NULL) {
if ((flags>>8) & (int)~sizeof(int)) {
if ((flags>>8) == sizeof(uint64_t)) {
*(uint64_t *)indexPtr = index;
return TCL_OK;
} else if ((flags>>8) == sizeof(uint32_t)) {
*(uint32_t *)indexPtr = index;
return TCL_OK;
} else if ((flags>>8) == sizeof(uint16_t)) {
*(uint16_t *)indexPtr = index;
return TCL_OK;
} else if ((flags>>8) == sizeof(uint8_t)) {
*(uint8_t *)indexPtr = index;
return TCL_OK;
}
}
*(int *)indexPtr = index;
}
return TCL_OK;
error:
if (interp != NULL) {
/*
* Produce a fancy error message.
*/
int count = 0;
TclNewObj(resultPtr);
entryPtr = (const char *const *)tablePtr;
while ((*entryPtr != NULL) && !**entryPtr) {
entryPtr = NEXT_ENTRY(entryPtr, offset);
}
Tcl_AppendStringsToObj(resultPtr,
(numAbbrev>1 && !(flags & TCL_EXACT) ? "ambiguous " : "bad "),
msg, " \"", key, NULL);
if (*entryPtr == NULL) {
Tcl_AppendStringsToObj(resultPtr, "\": no valid options", NULL);
} else {
Tcl_AppendStringsToObj(resultPtr, "\": must be ",
*entryPtr, NULL);
entryPtr = NEXT_ENTRY(entryPtr, offset);
while (*entryPtr != NULL) {
if ((*NEXT_ENTRY(entryPtr, offset) == NULL) && !(flags & TCL_INDEX_NULL_OK)) {
Tcl_AppendStringsToObj(resultPtr, (count > 0 ? "," : ""),
" or ", *entryPtr, NULL);
} else if (**entryPtr) {
Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr, NULL);
count++;
}
entryPtr = NEXT_ENTRY(entryPtr, offset);
}
if ((flags & TCL_INDEX_NULL_OK)) {
Tcl_AppendStringsToObj(resultPtr, ", or \"\"", NULL);
}
}
Tcl_SetObjResult(interp, resultPtr);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", msg, key, NULL);
}
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
419 420 421 422 423 424 425 |
*----------------------------------------------------------------------
*/
static void
UpdateStringOfIndex(
Tcl_Obj *objPtr)
{
| | | 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 |
*----------------------------------------------------------------------
*/
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));
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
448 449 450 451 452 453 454 |
*/
static void
DupIndex(
Tcl_Obj *srcPtr,
Tcl_Obj *dupPtr)
{
| | | | | 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 |
*/
static void
DupIndex(
Tcl_Obj *srcPtr,
Tcl_Obj *dupPtr)
{
Tcl_ObjInternalRep ir;
IndexRep *dupIndexRep = (IndexRep *)ckalloc(sizeof(IndexRep));
memcpy(dupIndexRep, TclFetchInternalRep(srcPtr, &indexType)->twoPtrValue.ptr1,
sizeof(IndexRep));
ir.twoPtrValue.ptr1 = dupIndexRep;
Tcl_StoreInternalRep(dupPtr, &indexType, &ir);
}
/*
*----------------------------------------------------------------------
*
* FreeIndex --
*
|
| ︙ | ︙ | |||
479 480 481 482 483 484 485 |
*----------------------------------------------------------------------
*/
static void
FreeIndex(
Tcl_Obj *objPtr)
{
| | | 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 |
*----------------------------------------------------------------------
*/
static void
FreeIndex(
Tcl_Obj *objPtr)
{
ckfree(TclFetchInternalRep(objPtr, &indexType)->twoPtrValue.ptr1);
objPtr->typePtr = NULL;
}
/*
*----------------------------------------------------------------------
*
* TclInitPrefixCmd --
|
| ︙ | ︙ | |||
536 537 538 539 540 541 542 | * None. * *---------------------------------------------------------------------- */ static int PrefixMatchObjCmd( | | | 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 |
* None.
*
*----------------------------------------------------------------------
*/
static int
PrefixMatchObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int flags = 0, result, index;
int dummyLength, i, errorLength;
Tcl_Obj *errorPtr = NULL;
|
| ︙ | ︙ | |||
585 586 587 588 589 590 591 |
if (i > objc-4) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing value for -error", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL);
return TCL_ERROR;
}
i++;
| | | 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 |
if (i > objc-4) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing value for -error", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL);
return TCL_ERROR;
}
i++;
result = TclListObjLength(interp, objv[i], &errorLength);
if (result != TCL_OK) {
return TCL_ERROR;
}
if ((errorLength % 2) != 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"error options must have an even number of elements",
-1));
|
| ︙ | ︙ | |||
609 610 611 612 613 614 615 |
objPtr = objv[objc - 1];
/*
* Check that table is a valid list first, since we want to handle that
* error case regardless of level.
*/
| | | 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 |
objPtr = objv[objc - 1];
/*
* Check that table is a valid list first, since we want to handle that
* error case regardless of level.
*/
result = TclListObjLength(interp, tablePtr, &dummyLength);
if (result != TCL_OK) {
return result;
}
result = GetIndexFromObjList(interp, objPtr, tablePtr, message, flags,
&index);
if (result != TCL_OK) {
|
| ︙ | ︙ | |||
660 661 662 663 664 665 666 | * None. * *---------------------------------------------------------------------- */ static int PrefixAllObjCmd( | | | | 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 |
* None.
*
*----------------------------------------------------------------------
*/
static int
PrefixAllObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int tableObjc, result, t, length, elemLength;
const char *string, *elemString;
Tcl_Obj **tableObjv, *resultPtr;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "table string");
return TCL_ERROR;
}
result = TclListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
if (result != TCL_OK) {
return result;
}
resultPtr = Tcl_NewListObj(0, NULL);
string = TclGetStringFromObj(objv[2], &length);
for (t = 0; t < tableObjc; t++) {
|
| ︙ | ︙ | |||
717 718 719 720 721 722 723 | * None. * *---------------------------------------------------------------------- */ static int PrefixLongestObjCmd( | | | | 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 |
* None.
*
*----------------------------------------------------------------------
*/
static int
PrefixLongestObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int tableObjc, result, i, t, length, elemLength, resultLength;
const char *string, *elemString, *resultString;
Tcl_Obj **tableObjv;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "table string");
return TCL_ERROR;
}
result = TclListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
if (result != TCL_OK) {
return result;
}
string = TclGetStringFromObj(objv[2], &length);
resultString = NULL;
resultLength = 0;
|
| ︙ | ︙ | |||
847 848 849 850 851 852 853 |
const char *message) /* Error message to print after the leading
* objects in objv. The message may be
* NULL. */
{
Tcl_Obj *objPtr;
int i, len, elemLen;
char flags;
| | | 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 |
const char *message) /* Error message to print after the leading
* objects in objv. The message may be
* NULL. */
{
Tcl_Obj *objPtr;
int i, len, elemLen;
char flags;
Interp *iPtr = (Interp *)interp;
const char *elementStr;
/*
* [incr Tcl] does something fairly horrific when generating error
* messages for its ensembles; it passes the whole set of ensemble
* arguments as a list in the first argument. This means that this code
* causes a problem in iTcl if it attempts to correctly quote all
|
| ︙ | ︙ | |||
883 884 885 886 887 888 889 |
Tcl_AppendObjToObj(objPtr, Tcl_GetObjResult(interp));
Tcl_AppendToObj(objPtr, " or \"", -1);
} else {
Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1);
}
/*
| | | | < < < < < < < < | | | 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 |
Tcl_AppendObjToObj(objPtr, Tcl_GetObjResult(interp));
Tcl_AppendToObj(objPtr, " or \"", -1);
} else {
Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1);
}
/*
* If processing an an ensemble implementation, rewrite the results in
* terms of how the ensemble was invoked.
*/
if (iPtr->ensembleRewrite.sourceObjs != NULL) {
int toSkip = iPtr->ensembleRewrite.numInsertedObjs;
int toPrint = iPtr->ensembleRewrite.numRemovedObjs;
Tcl_Obj *const *origObjv = TclEnsembleGetRewriteValues(interp);
/*
* Only do rewrite the command if all the replaced objects are
* actually arguments (in objv) to this function. Otherwise it just
* gets too complicated and it's to just give a slightly
* confusing error message...
*/
if (objc < toSkip) {
goto addNormalArgumentsToMessage;
}
|
| ︙ | ︙ | |||
926 927 928 929 930 931 932 |
* We assume no object is of index type.
*/
for (i=0 ; i<toPrint ; i++) {
/*
* Add the element, quoting it if necessary.
*/
| | | | 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 |
* We assume no object is of index type.
*/
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 = TclGetStringFromObj(origObjv[i], &elemLen);
}
|
| ︙ | ︙ | |||
975 976 977 978 979 980 981 |
addNormalArgumentsToMessage:
for (i = 0; i < objc; i++) {
/*
* 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.
*/
| | | | 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 |
addNormalArgumentsToMessage:
for (i = 0; i < objc; i++) {
/*
* 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), NULL);
} else {
/*
* Quote the argument if it contains spaces (Bug 942757).
*/
|
| ︙ | ︙ | |||
1422 1423 1424 1425 1426 1427 1428 |
Tcl_Obj *value,
int *codePtr) /* Argument objects. */
{
static const char *const returnCodes[] = {
"ok", "error", "return", "break", "continue", NULL
};
| | | 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 |
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_GetIndexFromObj(NULL, value, returnCodes, NULL, TCL_EXACT,
codePtr) == TCL_OK) {
return TCL_OK;
}
|
| ︙ | ︙ |
Changes to generic/tclInt.decls.
| ︙ | ︙ | |||
180 181 182 183 184 185 186 |
declare 40 {
int TclGetOpenMode(Tcl_Interp *interp, const char *str, int *seekFlagPtr)
}
declare 41 {
Tcl_Command TclGetOriginalCommand(Tcl_Command command)
}
declare 42 {
| | | 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 |
declare 40 {
int TclGetOpenMode(Tcl_Interp *interp, const char *str, int *seekFlagPtr)
}
declare 41 {
Tcl_Command TclGetOriginalCommand(Tcl_Command command)
}
declare 42 {
const char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr)
}
# Removed in 8.5a2:
#declare 43 {
# int TclGlobalInvoke(Tcl_Interp *interp, int argc, const char **argv,
# int flags)
#}
declare 44 {
|
| ︙ | ︙ | |||
236 237 238 239 240 241 242 |
}
declare 55 {
Proc *TclIsProc(Command *cmdPtr)
}
# Replaced with TclpLoadFile in 8.1:
# declare 56 {
# int TclLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
| | | | 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 |
}
declare 55 {
Proc *TclIsProc(Command *cmdPtr)
}
# Replaced with TclpLoadFile in 8.1:
# declare 56 {
# int TclLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
# char *sym2, Tcl_LibraryInitProc **proc1Ptr,
# Tcl_LibraryInitProc **proc2Ptr)
# }
# Signature changed to take a length in 8.1:
# declare 57 {
# int TclLooksLikeInt(char *p)
# }
declare 58 {
Var *TclLookupVar(Tcl_Interp *interp, const char *part1, const char *part2,
|
| ︙ | ︙ | |||
405 406 407 408 409 410 411 |
#}
# Removed in 8.4b2:
#declare 100 {
# Tcl_Obj *TclSetIndexedScalar(Tcl_Interp *interp, int localIndex,
# Tcl_Obj *objPtr, int flags)
#}
declare 101 {
| | | 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 |
#}
# Removed in 8.4b2:
#declare 100 {
# Tcl_Obj *TclSetIndexedScalar(Tcl_Interp *interp, int localIndex,
# Tcl_Obj *objPtr, int flags)
#}
declare 101 {
const char *TclSetPreInitScript(const char *string)
}
declare 102 {
void TclSetupEnv(Tcl_Interp *interp)
}
declare 103 {
int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto,
int *portPtr)
|
| ︙ | ︙ | |||
549 550 551 552 553 554 555 |
# int TclpChdir(const char *dirName)
#}
declare 138 {
const char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
}
#declare 139 {
# int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
| | | | 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 |
# int TclpChdir(const char *dirName)
#}
declare 138 {
const char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
}
#declare 139 {
# int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
# char *sym2, Tcl_LibraryInitProc **proc1Ptr,
# Tcl_LibraryInitProc **proc2Ptr, void **clientDataPtr)
#}
#declare 140 {
# int TclLooksLikeInt(const char *bytes, int length)
#}
# This is used by TclX, but should otherwise be considered private
declare 141 {
const char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
|
| ︙ | ︙ | |||
1022 1023 1024 1025 1026 1027 1028 |
Tcl_Obj *myNamePtr, int myFlags)
}
declare 256 {
int TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr,
Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags)
}
declare 257 {
| | | < < < < < | 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 |
Tcl_Obj *myNamePtr, int myFlags)
}
declare 256 {
int TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr,
Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags)
}
declare 257 {
void TclStaticLibrary(Tcl_Interp *interp, const char *prefix,
Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc)
}
# TIP 431: temporary directory creation function
declare 258 {
Tcl_Obj *TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj)
}
declare 259 {
void TclUnusedStubEntry(void)
}
##############################################################################
# Define the platform specific internal Tcl interface. These functions are
# only available on the designated platform.
|
| ︙ | ︙ |
Changes to generic/tclInt.h.
| ︙ | ︙ | |||
411 412 413 414 415 416 417 | * commandPathSourceList field. */ }; /* * Flags used to represent the status of a namespace: * * NS_DYING - 1 means Tcl_DeleteNamespace has been called to delete the | | | | > | | | < | | | | < < | | | 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 | * commandPathSourceList field. */ }; /* * Flags used to represent the status of a namespace: * * NS_DYING - 1 means Tcl_DeleteNamespace has been called to delete the * namespace. There may still be active call frames on the Tcl * stack that refer to the namespace. When the last call frame * referring to it has been popped, its remaining variables and * commands are destroyed and it is marked "dead" (NS_DEAD). * NS_TEARDOWN -1 means that TclTeardownNamespace has already been called on * this namespace and it should not be called again [Bug 1355942]. * NS_DEAD - 1 means Tcl_DeleteNamespace has been called to delete the * namespace and no call frames still refer to it. It is no longer * accessible by name. Its variables and commands have already * been destroyed. When the last namespaceName object in any byte * code unit that refers to the namespace has been freed (i.e., * when the namespace's refCount is 0), the namespace's storage * will be freed. * NS_SUPPRESS_COMPILATION - * Marks the commands in this namespace for not being compiled, * forcing them to be looked up every time. */ #define NS_DYING 0x01 #define NS_TEARDOWN 0x02 #define NS_DEAD 0x04 #define NS_SUPPRESS_COMPILATION 0x08 /* * Flags passed to TclGetNamespaceForQualName: * * TCL_GLOBAL_ONLY - (see tcl.h) Look only in the global ns. * TCL_NAMESPACE_ONLY - (see tcl.h) Look only in the context ns. |
| ︙ | ︙ | |||
1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 |
int auxNumLevels; /* While the coroutine is running the
* numLevels of the create/resume command is
* stored here; for suspended coroutines it
* holds the nesting numLevels at yield. */
int nargs; /* Number of args required for resuming this
* coroutine; -2 means "0 or 1" (default), -1
* means "any" */
} CoroutineData;
typedef struct ExecEnv {
ExecStack *execStackPtr; /* Points to the first item in the evaluation
* stack on the heap. */
Tcl_Obj *constants[2]; /* Pointers to constant "0" and "1" objs. */
struct Tcl_Interp *interp;
| > > > > > | 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 |
int auxNumLevels; /* While the coroutine is running the
* numLevels of the create/resume command is
* stored here; for suspended coroutines it
* holds the nesting numLevels at yield. */
int nargs; /* Number of args required for resuming this
* coroutine; -2 means "0 or 1" (default), -1
* means "any" */
Tcl_Obj *yieldPtr; /* The command to yield to. Stored here in
* order to reset splice point in
* TclNRCoroutineActivateCallback if the
* coroutine is busy.
*/
} CoroutineData;
typedef struct ExecEnv {
ExecStack *execStackPtr; /* Points to the first item in the evaluation
* stack on the heap. */
Tcl_Obj *constants[2]; /* Pointers to constant "0" and "1" objs. */
struct Tcl_Interp *interp;
|
| ︙ | ︙ | |||
2735 2736 2737 2738 2739 2740 2741 | *---------------------------------------------------------------- */ MODULE_SCOPE char *tclNativeExecutableName; MODULE_SCOPE int tclFindExecutableSearchDone; MODULE_SCOPE char *tclMemDumpFileName; MODULE_SCOPE TclPlatformType tclPlatform; | < | 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 | *---------------------------------------------------------------- */ MODULE_SCOPE char *tclNativeExecutableName; MODULE_SCOPE int tclFindExecutableSearchDone; MODULE_SCOPE char *tclMemDumpFileName; MODULE_SCOPE TclPlatformType tclPlatform; MODULE_SCOPE Tcl_Encoding tclIdentityEncoding; /* * TIP #233 (Virtualized Time) * Data for the time hooks, if any. */ |
| ︙ | ︙ | |||
2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 | MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp, Tcl_Obj *objv[], int objc, void *codePtr, CmdFrame *cfPtr, int cmd, int 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 double TclBignumToDouble(const void *bignum); MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string, int strLen, const unsigned char *pattern, int ptnLen, int flags); MODULE_SCOPE double TclCeil(const void *a); MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan); MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan); | > > > | 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 | MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp, Tcl_Obj *objv[], int objc, void *codePtr, CmdFrame *cfPtr, int cmd, int 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 int TclAsyncNotifier(int sigNumber, Tcl_ThreadId threadId, ClientData 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, int strLen, const unsigned char *pattern, int ptnLen, int flags); MODULE_SCOPE double TclCeil(const void *a); MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan); MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan); |
| ︙ | ︙ | |||
2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 | const char *cmdName, Tcl_Namespace *nsPtr, Tcl_ObjCmdProc *proc, ClientData 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 int TclFindDictElement(Tcl_Interp *interp, const char *dict, int dictLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *literalPtr); /* TIP #280 - Modified token based evaluation, with line information. */ MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script, int numBytes, int flags, int line, | > | 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 | const char *cmdName, Tcl_Namespace *nsPtr, Tcl_ObjCmdProc *proc, ClientData 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 int TclFindDictElement(Tcl_Interp *interp, const char *dict, int dictLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *literalPtr); /* TIP #280 - Modified token based evaluation, with line information. */ MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script, int numBytes, int flags, int line, |
| ︙ | ︙ | |||
2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 | MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, Tcl_Obj *objPtr); MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, Tcl_DString *toAppendPtr); MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr); MODULE_SCOPE Tcl_Obj *const *TclFetchEnsembleRoot(Tcl_Interp *interp, Tcl_Obj *const *objv, int objc, int *objcPtr); MODULE_SCOPE Tcl_Namespace *TclEnsureNamespace(Tcl_Interp *interp, Tcl_Namespace *namespacePtr); MODULE_SCOPE void TclFinalizeAllocSubsystem(void); MODULE_SCOPE void TclFinalizeAsync(void); MODULE_SCOPE void TclFinalizeDoubleConversion(void); MODULE_SCOPE void TclFinalizeEncodingSubsystem(void); MODULE_SCOPE void TclFinalizeEnvironment(void); | > | 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 | MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, Tcl_Obj *objPtr); MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, Tcl_DString *toAppendPtr); MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr); MODULE_SCOPE Tcl_Obj *const *TclFetchEnsembleRoot(Tcl_Interp *interp, Tcl_Obj *const *objv, int objc, int *objcPtr); MODULE_SCOPE Tcl_Obj *const *TclEnsembleGetRewriteValues(Tcl_Interp *interp); MODULE_SCOPE Tcl_Namespace *TclEnsureNamespace(Tcl_Interp *interp, Tcl_Namespace *namespacePtr); MODULE_SCOPE void TclFinalizeAllocSubsystem(void); MODULE_SCOPE void TclFinalizeAsync(void); MODULE_SCOPE void TclFinalizeDoubleConversion(void); MODULE_SCOPE void TclFinalizeEncodingSubsystem(void); MODULE_SCOPE void TclFinalizeEnvironment(void); |
| ︙ | ︙ | |||
3129 3130 3131 3132 3133 3134 3135 | MODULE_SCOPE void TclParseInit(Tcl_Interp *interp, const char *string, int numBytes, Tcl_Parse *parsePtr); MODULE_SCOPE int TclParseAllWhiteSpace(const char *src, int numBytes); MODULE_SCOPE int TclProcessReturn(Tcl_Interp *interp, int code, int level, Tcl_Obj *returnOpts); MODULE_SCOPE int TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); MODULE_SCOPE Tcl_Obj * TclpTempFileName(void); | | > > > > > > > > > > > | 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 | MODULE_SCOPE void TclParseInit(Tcl_Interp *interp, const char *string, int numBytes, Tcl_Parse *parsePtr); MODULE_SCOPE int TclParseAllWhiteSpace(const char *src, int numBytes); MODULE_SCOPE int TclProcessReturn(Tcl_Interp *interp, int code, int level, Tcl_Obj *returnOpts); 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 * TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep, int len); MODULE_SCOPE void TclpAlertNotifier(ClientData clientData); MODULE_SCOPE ClientData TclpNotifierData(void); MODULE_SCOPE void TclpServiceModeHook(int mode); MODULE_SCOPE void TclpSetTimer(const Tcl_Time *timePtr); MODULE_SCOPE int TclpWaitForEvent(const Tcl_Time *timePtr); MODULE_SCOPE void TclpCreateFileHandler(int fd, int mask, Tcl_FileProc *proc, ClientData clientData); MODULE_SCOPE int TclpDeleteFile(const void *path); MODULE_SCOPE void TclpDeleteFileHandler(int fd); MODULE_SCOPE void TclpFinalizeCondition(Tcl_Condition *condPtr); MODULE_SCOPE void TclpFinalizeMutex(Tcl_Mutex *mutexPtr); MODULE_SCOPE void TclpFinalizeNotifier(ClientData clientData); MODULE_SCOPE void TclpFinalizePipes(void); MODULE_SCOPE void TclpFinalizeSockets(void); MODULE_SCOPE int TclCreateSocketAddress(Tcl_Interp *interp, struct addrinfo **addrlist, const char *host, int port, int willBind, const char **errorMsgPtr); MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, ClientData clientData, int stackSize, int flags); MODULE_SCOPE int TclpFindVariable(const char *name, int *lengthPtr); MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr, unsigned int *lengthPtr, Tcl_Encoding *encodingPtr); MODULE_SCOPE void TclpInitLock(void); MODULE_SCOPE ClientData TclpInitNotifier(void); MODULE_SCOPE void TclpInitPlatform(void); MODULE_SCOPE void TclpInitUnlock(void); MODULE_SCOPE Tcl_Obj * TclpObjListVolumes(void); MODULE_SCOPE void TclpGlobalLock(void); MODULE_SCOPE void TclpGlobalUnlock(void); MODULE_SCOPE int TclpMatchFiles(Tcl_Interp *interp, char *separators, Tcl_DString *dirPtr, char *pattern, char *tail); |
| ︙ | ︙ | |||
3174 3175 3176 3177 3178 3179 3180 | 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); | | > | | | 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 | 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, Tcl_PathPart portion); MODULE_SCOPE char * TclpReadlink(const char *fileName, Tcl_DString *linkPtr); MODULE_SCOPE void TclpSetVariables(Tcl_Interp *interp); MODULE_SCOPE void * TclThreadStorageKeyGet(Tcl_ThreadDataKey *keyPtr); MODULE_SCOPE void TclThreadStorageKeySet(Tcl_ThreadDataKey *keyPtr, void *data); MODULE_SCOPE TCL_NORETURN void TclpThreadExit(int status); MODULE_SCOPE void TclRememberCondition(Tcl_Condition *mutex); MODULE_SCOPE void TclRememberJoinableThread(Tcl_ThreadId id); MODULE_SCOPE void TclRememberMutex(Tcl_Mutex *mutex); MODULE_SCOPE void TclRemoveScriptLimitCallbacks(Tcl_Interp *interp); MODULE_SCOPE int TclReToGlob(Tcl_Interp *interp, const char *reStr, int reStrLen, Tcl_DString *dsPtr, int *flagsPtr, int *quantifiersFoundPtr); MODULE_SCOPE int TclScanElement(const char *string, int length, char *flagPtr); MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp, Tcl_Obj *cmdPrefix); MODULE_SCOPE void TclSetBignumInternalRep(Tcl_Obj *objPtr, void *bignumValue); MODULE_SCOPE int TclSetBooleanFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); MODULE_SCOPE void TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Command *cmdPtr); MODULE_SCOPE void TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr); MODULE_SCOPE void TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr, |
| ︙ | ︙ | |||
4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 | MODULE_SCOPE int TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr, int before, int after, int *indexPtr); MODULE_SCOPE int TclIndexDecode(int encoded, int endValue); /* Constants used in index value encoding routines. */ #define TCL_INDEX_END (-2) #define TCL_INDEX_START (0) /* *---------------------------------------------------------------- * Macros used by the Tcl core to create and release Tcl objects. * TclNewObj(objPtr) creates a new object denoting an empty string. * TclDecrRefCount(objPtr) decrements the object's reference count, and frees * the object if its reference count is zero. These macros are inline versions | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
MODULE_SCOPE int TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr,
int before, int after, int *indexPtr);
MODULE_SCOPE int TclIndexDecode(int encoded, int endValue);
/* Constants used in index value encoding routines. */
#define TCL_INDEX_END (-2)
#define TCL_INDEX_START (0)
/*
*----------------------------------------------------------------------
*
* TclScaleTime --
*
* TIP #233 (Virtualized Time): Wrapper around the time virutalisation
* rescale function to hide the binding of the clientData.
*
* This is static inline code; it's like a macro, but a function. It's
* used because this is a piece of code that ends up in places that are a
* bit performance sensitive.
*
* Results:
* None
*
* Side effects:
* Updates the time structure (given as an argument) with what the time
* should be after virtualisation.
*
*----------------------------------------------------------------------
*/
static inline void
TclScaleTime(
Tcl_Time *timePtr)
{
if (timePtr != NULL) {
tclScaleTimeProcPtr(timePtr, tclTimeClientData);
}
}
/*
*----------------------------------------------------------------
* Macros used by the Tcl core to create and release Tcl objects.
* TclNewObj(objPtr) creates a new object denoting an empty string.
* TclDecrRefCount(objPtr) decrements the object's reference count, and frees
* the object if its reference count is zero. These macros are inline versions
|
| ︙ | ︙ | |||
4272 4273 4274 4275 4276 4277 4278 |
(objPtr)->length = 0; \
(objPtr)->typePtr = NULL; \
TCL_DTRACE_OBJ_CREATE(objPtr)
/*
* Invalidate the string rep first so we can use the bytes value for our
* pointer chain, and signal an obj deletion (as opposed to shimmering) with
| | | | 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 |
(objPtr)->length = 0; \
(objPtr)->typePtr = NULL; \
TCL_DTRACE_OBJ_CREATE(objPtr)
/*
* Invalidate the string rep first so we can use the bytes value for our
* pointer chain, and signal an obj deletion (as opposed to shimmering) with
* 'length == TCL_INDEX_NONE'.
* Use empty 'if ; else' to handle use in unbraced outer if/else conditions.
*/
# define TclDecrRefCount(objPtr) \
if ((objPtr)->refCount-- > 1) ; else { \
if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \
TCL_DTRACE_OBJ_FREE(objPtr); \
if ((objPtr)->bytes \
&& ((objPtr)->bytes != &tclEmptyString)) { \
ckfree((objPtr)->bytes); \
} \
(objPtr)->length = TCL_INDEX_NONE; \
TclFreeObjStorage(objPtr); \
TclIncrObjsFreed(); \
} else { \
TclFreeObj(objPtr); \
} \
}
|
| ︙ | ︙ | |||
4306 4307 4308 4309 4310 4311 4312 | * The PURIFY mode is like the regular mode, but instead of doing block * Tcl_Obj allocation and keeping a freed list for efficiency, it always * allocates and frees a single Tcl_Obj so that tools like Purify can better * track memory leaks. */ # define TclAllocObjStorageEx(interp, objPtr) \ | | | 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 | * The PURIFY mode is like the regular mode, but instead of doing block * Tcl_Obj allocation and keeping a freed list for efficiency, it always * allocates and frees a single Tcl_Obj so that tools like Purify can better * track memory leaks. */ # define TclAllocObjStorageEx(interp, objPtr) \ (objPtr) = (Tcl_Obj *)ckalloc(sizeof(Tcl_Obj)) # define TclFreeObjStorageEx(interp, objPtr) \ ckfree(objPtr) #undef USE_THREAD_ALLOC #undef USE_TCLALLOC #elif TCL_THREADS && defined(USE_THREAD_ALLOC) |
| ︙ | ︙ | |||
4432 4433 4434 4435 4436 4437 4438 | #undef USE_THREAD_ALLOC #endif /* TCL_MEM_DEBUG */ /* *---------------------------------------------------------------- * Macro used by the Tcl core to set a Tcl_Obj's string representation to a | | | > > > > > > > | > > | < < | | 4482 4483 4484 4485 4486 4487 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 4498 4499 4500 4501 4502 4503 4504 4505 4506 4507 4508 4509 4510 4511 4512 4513 4514 4515 4516 4517 4518 4519 4520 |
#undef USE_THREAD_ALLOC
#endif /* TCL_MEM_DEBUG */
/*
*----------------------------------------------------------------
* Macro used by the Tcl core to set a Tcl_Obj's string representation to a
* copy of the "len" bytes starting at "bytePtr". The value of "len" must
* not be negative. When "len" is 0, then it is acceptable to pass
* "bytePtr" = NULL. When "len" > 0, "bytePtr" must not be NULL, and it
* must point to a location from which "len" bytes may be read. These
* constraints are not checked here. The validity of the bytes copied
* as a value string representation is also not verififed. This macro
* must not be called while "objPtr" is being freed or when "objPtr"
* already has a string representation. The caller must use
* this macro properly. Improper use can lead to dangerous results.
* Because "len" is referenced multiple times, take care that it is an
* expression with the same value each use.
*
* The ANSI C "prototype" for this macro is:
*
* MODULE_SCOPE void TclInitStringRep(Tcl_Obj *objPtr, char *bytePtr, int len);
*
*----------------------------------------------------------------
*/
#define TclInitStringRep(objPtr, bytePtr, len) \
if ((len) == 0) { \
(objPtr)->bytes = &tclEmptyString; \
(objPtr)->length = 0; \
} else { \
(objPtr)->bytes = (char *)ckalloc((unsigned int)(len) + 1U); \
memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)); \
(objPtr)->bytes[len] = '\0'; \
(objPtr)->length = (len); \
}
/*
*----------------------------------------------------------------
|
| ︙ | ︙ | |||
4482 4483 4484 4485 4486 4487 4488 | /* *---------------------------------------------------------------- * Macro used by the Tcl core to clean out an object's internal * representation. Does not actually reset the rep's bytes. The ANSI C * "prototype" for this macro is: * | | | > > > > | 4539 4540 4541 4542 4543 4544 4545 4546 4547 4548 4549 4550 4551 4552 4553 4554 4555 4556 4557 4558 4559 4560 4561 4562 4563 4564 4565 4566 4567 |
/*
*----------------------------------------------------------------
* Macro used by the Tcl core to clean out an object's internal
* representation. Does not actually reset the rep's bytes. The ANSI C
* "prototype" for this macro is:
*
* MODULE_SCOPE void TclFreeInternalRep(Tcl_Obj *objPtr);
*----------------------------------------------------------------
*/
#define TclFreeInternalRep(objPtr) \
if ((objPtr)->typePtr != NULL) { \
if ((objPtr)->typePtr->freeIntRepProc != NULL) { \
(objPtr)->typePtr->freeIntRepProc(objPtr); \
} \
(objPtr)->typePtr = NULL; \
}
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 8
# define TclFreeIntRep(objPtr) TclFreeInternalRep(objPtr)
#endif
/*
*----------------------------------------------------------------
* Macro used by the Tcl core to clean out an object's string representation.
* The ANSI C "prototype" for this macro is:
*
* MODULE_SCOPE void TclInvalidateStringRep(Tcl_Obj *objPtr);
|
| ︙ | ︙ | |||
4704 4705 4706 4707 4708 4709 4710 | * MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); *---------------------------------------------------------------- */ MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); #define TclIsPureDict(objPtr) \ (((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType)) | | | | | 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 4781 4782 | * MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); *---------------------------------------------------------------- */ MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); #define TclIsPureDict(objPtr) \ (((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType)) #define TclHasInternalRep(objPtr, type) \ ((objPtr)->typePtr == (type)) #define TclFetchInternalRep(objPtr, type) \ (TclHasInternalRep((objPtr), (type)) ? &((objPtr)->internalRep) : NULL) /* *---------------------------------------------------------------- * Macro used by the Tcl core to compare Unicode strings. On big-endian * systems we can use the more efficient memcmp, but this would not be * lexically correct on little-endian systems. The ANSI C "prototype" for |
| ︙ | ︙ | |||
4753 4754 4755 4756 4757 4758 4759 | *---------------------------------------------------------------------- * * Core procedure added to libtommath for bignum manipulation. * *---------------------------------------------------------------------- */ | | | | | | | | 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 | *---------------------------------------------------------------------- * * Core procedure added to libtommath for bignum manipulation. * *---------------------------------------------------------------------- */ MODULE_SCOPE Tcl_LibraryInitProc TclTommath_Init; /* *---------------------------------------------------------------------- * * External (platform specific) initialization routine, these declarations * explicitly don't use EXTERN since this code does not get compiled into the * library: * *---------------------------------------------------------------------- */ 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; /* *---------------------------------------------------------------- * 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); |
| ︙ | ︙ | |||
4797 4798 4799 4800 4801 4802 4803 |
* MODULE_SCOPE void TclSetIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
* MODULE_SCOPE void TclSetDoubleObj(Tcl_Obj *objPtr, double d);
*----------------------------------------------------------------
*/
#define TclSetIntObj(objPtr, i) \
do { \
| | | | | | 4858 4859 4860 4861 4862 4863 4864 4865 4866 4867 4868 4869 4870 4871 4872 4873 4874 4875 4876 4877 4878 4879 4880 4881 4882 4883 |
* MODULE_SCOPE void TclSetIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
* MODULE_SCOPE void TclSetDoubleObj(Tcl_Obj *objPtr, double d);
*----------------------------------------------------------------
*/
#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:
|
| ︙ | ︙ | |||
4836 4837 4838 4839 4840 4841 4842 4843 4844 4845 4846 4847 4848 4849 |
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 TclNewDoubleObj(objPtr, d) \
do { \
TclIncrObjsAllocated(); \
TclAllocObjStorage(objPtr); \
(objPtr)->refCount = 0; \
(objPtr)->bytes = NULL; \
| > > > | 4897 4898 4899 4900 4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 4911 4912 4913 |
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 TclNewIndexObj(objPtr, w) \
TclNewIntObj(objPtr, w)
#define TclNewDoubleObj(objPtr, d) \
do { \
TclIncrObjsAllocated(); \
TclAllocObjStorage(objPtr); \
(objPtr)->refCount = 0; \
(objPtr)->bytes = NULL; \
|
| ︙ | ︙ | |||
4861 4862 4863 4864 4865 4866 4867 4868 4869 4870 4871 4872 4873 4874 4875 4876 4877 4878 4879 4880 |
(objPtr)->typePtr = NULL; \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
#else /* TCL_MEM_DEBUG */
#define TclNewIntObj(objPtr, w) \
(objPtr) = Tcl_NewWideIntObj(w)
#define TclNewDoubleObj(objPtr, d) \
(objPtr) = Tcl_NewDoubleObj(d)
#define TclNewStringObj(objPtr, s, len) \
(objPtr) = Tcl_NewStringObj((s), (len))
#endif /* TCL_MEM_DEBUG */
/*
* The sLiteral argument *must* be a string literal; the incantation with
* sizeof(sLiteral "") will fail to compile otherwise.
*/
#define TclNewLiteralStringObj(objPtr, sLiteral) \
| > > > | | | | | | < < < < < < < | 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 4937 4938 4939 4940 4941 4942 4943 4944 4945 4946 4947 4948 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 |
(objPtr)->typePtr = NULL; \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
#else /* TCL_MEM_DEBUG */
#define TclNewIntObj(objPtr, w) \
(objPtr) = Tcl_NewWideIntObj(w)
#define TclNewIndexObj(objPtr, w) \
TclNewIntObj(objPtr, w)
#define TclNewDoubleObj(objPtr, d) \
(objPtr) = Tcl_NewDoubleObj(d)
#define TclNewStringObj(objPtr, s, len) \
(objPtr) = Tcl_NewStringObj((s), (len))
#endif /* TCL_MEM_DEBUG */
/*
* The sLiteral argument *must* be a string literal; the incantation with
* sizeof(sLiteral "") will fail to compile otherwise.
*/
#define TclNewLiteralStringObj(objPtr, sLiteral) \
TclNewStringObj((objPtr), (sLiteral), sizeof(sLiteral "") - 1)
/*
*----------------------------------------------------------------
* Convenience macros for DStrings.
* The ANSI C "prototypes" for these macros are:
*
* MODULE_SCOPE char * TclDStringAppendLiteral(Tcl_DString *dsPtr,
* const char *sLiteral);
* MODULE_SCOPE void TclDStringClear(Tcl_DString *dsPtr);
*/
#define TclDStringAppendLiteral(dsPtr, sLiteral) \
Tcl_DStringAppend((dsPtr), (sLiteral), sizeof(sLiteral "") - 1)
#define TclDStringClear(dsPtr) \
Tcl_DStringSetLength((dsPtr), 0)
/*
*----------------------------------------------------------------
* Macros used by the Tcl core to test for some special double values.
* (deprecated) The ANSI C "prototypes" for these macros are:
*
* MODULE_SCOPE int TclIsInfinite(double d);
* MODULE_SCOPE int TclIsNaN(double d);
*/
#if !defined(TCL_NO_DEPRECATED) && !defined(BUILD_tcl)
# define TclIsInfinite(d) isinf(d)
# define TclIsNaN(d) isnan(d)
#endif
/*
* Macro to use to find the offset of a field in astructure.
* Computes number of bytes from beginning of structure to a given field.
*/
|
| ︙ | ︙ | |||
5028 5029 5030 5031 5032 5033 5034 |
#ifndef TCL_MEM_DEBUG
#define TclSmallAllocEx(interp, nbytes, memPtr) \
do { \
Tcl_Obj *_objPtr; \
TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj)); \
TclIncrObjsAllocated(); \
TclAllocObjStorageEx((interp), (_objPtr)); \
| | | | | | 5088 5089 5090 5091 5092 5093 5094 5095 5096 5097 5098 5099 5100 5101 5102 5103 5104 5105 5106 5107 5108 5109 5110 5111 5112 5113 5114 5115 5116 5117 5118 5119 5120 5121 5122 |
#ifndef TCL_MEM_DEBUG
#define TclSmallAllocEx(interp, nbytes, memPtr) \
do { \
Tcl_Obj *_objPtr; \
TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj)); \
TclIncrObjsAllocated(); \
TclAllocObjStorageEx((interp), (_objPtr)); \
*(void **)&(memPtr) = (void *) (_objPtr); \
} while (0)
#define TclSmallFreeEx(interp, memPtr) \
do { \
TclFreeObjStorageEx((interp), (Tcl_Obj *)(memPtr)); \
TclIncrObjsFreed(); \
} while (0)
#else /* TCL_MEM_DEBUG */
#define TclSmallAllocEx(interp, nbytes, memPtr) \
do { \
Tcl_Obj *_objPtr; \
TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj)); \
TclNewObj(_objPtr); \
*(void **)&(memPtr) = (void *)_objPtr; \
} while (0)
#define TclSmallFreeEx(interp, memPtr) \
do { \
Tcl_Obj *_objPtr = (Tcl_Obj *)(memPtr); \
_objPtr->bytes = NULL; \
_objPtr->typePtr = NULL; \
_objPtr->refCount = 1; \
TclDecrRefCount(_objPtr); \
} while (0)
#endif /* TCL_MEM_DEBUG */
|
| ︙ | ︙ | |||
5121 5122 5123 5124 5125 5126 5127 |
#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) \
| | > > > > > > > > > > > > > > > > > > > > > | | | 5181 5182 5183 5184 5185 5186 5187 5188 5189 5190 5191 5192 5193 5194 5195 5196 5197 5198 5199 5200 5201 5202 5203 5204 5205 5206 5207 5208 5209 5210 5211 5212 5213 5214 5215 5216 5217 5218 5219 5220 5221 5222 5223 5224 5225 5226 5227 5228 5229 5230 5231 5232 5233 5234 5235 5236 5237 5238 5239 5240 5241 5242 5243 |
#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) = ((void *)ckalloc(sizeof(NRE_callback))))
#define TCLNR_FREE(interp, ptr) ckfree(ptr)
#endif
#if NRE_ENABLE_ASSERTS
#define NRE_ASSERT(expr) assert((expr))
#else
#define NRE_ASSERT(expr)
#endif
#include "tclIntDecls.h"
#include "tclIntPlatDecls.h"
#if !defined(USE_TCL_STUBS) && !defined(TCL_MEM_DEBUG)
#define Tcl_AttemptAlloc(size) TclpAlloc(size)
#define Tcl_AttemptRealloc(ptr, size) TclpRealloc((ptr), (size))
#define Tcl_Free(ptr) TclpFree(ptr)
#endif
/*
* Special hack for macOS, where the static linker (technically the 'ar'
* command) hates empty object files, and accepts no flags to make it shut up.
*
* These symbols are otherwise completely useless.
*
* They can't be written to or written through. They can't be seen by any
* other code. They use a separate attribute (supported by all macOS
* compilers, which are derivatives of clang or gcc) to stop the compilation
* from moaning. They will be excluded during the final linking stage.
*
* Other platforms get nothing at all. That's good.
*/
#ifdef MAC_OSX_TCL
#define TCL_MAC_EMPTY_FILE(name) \
static __attribute__((used)) const void *const TclUnusedFile_ ## name = NULL;
#else
#define TCL_MAC_EMPTY_FILE(name)
#endif /* MAC_OSX_TCL */
/*
* Other externals.
*/
MODULE_SCOPE size_t TclEnvEpoch; /* Epoch of the tcl environment
* (if changed with tcl-env). */
#endif /* _TCLINT */
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Changes to generic/tclIntDecls.h.
| ︙ | ︙ | |||
149 150 151 152 153 154 155 | EXTERN TclObjCmdProcType TclGetObjInterpProc(void); /* 40 */ EXTERN int TclGetOpenMode(Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 41 */ EXTERN Tcl_Command TclGetOriginalCommand(Tcl_Command command); /* 42 */ | | | 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 | EXTERN TclObjCmdProcType TclGetObjInterpProc(void); /* 40 */ EXTERN int TclGetOpenMode(Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 41 */ EXTERN Tcl_Command TclGetOriginalCommand(Tcl_Command command); /* 42 */ EXTERN const char * TclpGetUserHome(const char *name, Tcl_DString *bufferPtr); /* Slot 43 is reserved */ /* 44 */ EXTERN int TclGuessPackageName(const char *fileName, Tcl_DString *bufPtr); /* 45 */ EXTERN int TclHideUnsafeCommands(Tcl_Interp *interp); |
| ︙ | ︙ | |||
260 261 262 263 264 265 266 | EXTERN void TclResetShadowedCmdRefs(Tcl_Interp *interp, Command *newCmdPtr); /* 98 */ EXTERN int TclServiceIdle(void); /* Slot 99 is reserved */ /* Slot 100 is reserved */ /* 101 */ | | | 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 |
EXTERN void TclResetShadowedCmdRefs(Tcl_Interp *interp,
Command *newCmdPtr);
/* 98 */
EXTERN int TclServiceIdle(void);
/* Slot 99 is reserved */
/* Slot 100 is reserved */
/* 101 */
EXTERN const char * TclSetPreInitScript(const char *string);
/* 102 */
EXTERN void TclSetupEnv(Tcl_Interp *interp);
/* 103 */
EXTERN int TclSockGetPort(Tcl_Interp *interp, const char *str,
const char *proto, int *portPtr);
/* 104 */
TCL_DEPRECATED("")
|
| ︙ | ︙ | |||
647 648 649 650 651 652 653 | Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 256 */ EXTERN int TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 257 */ | | | | < < < | 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 |
Tcl_Var otherPtr, Tcl_Obj *myNamePtr,
int myFlags);
/* 256 */
EXTERN int TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr,
Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, const int flags);
/* 257 */
EXTERN void TclStaticLibrary(Tcl_Interp *interp,
const char *prefix,
Tcl_LibraryInitProc *initProc,
Tcl_LibraryInitProc *safeInitProc);
/* 258 */
EXTERN Tcl_Obj * TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj);
/* 259 */
EXTERN void TclUnusedStubEntry(void);
typedef struct TclIntStubs {
int magic;
void *hooks;
void (*reserved0)(void);
|
| ︙ | ︙ | |||
706 707 708 709 710 711 712 |
void (*reserved35)(void);
void (*reserved36)(void);
int (*tclGetLoadedPackages) (Tcl_Interp *interp, const char *targetName); /* 37 */
int (*tclGetNamespaceForQualName) (Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 38 */
TclObjCmdProcType (*tclGetObjInterpProc) (void); /* 39 */
int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */
Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */
| | | 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 |
void (*reserved35)(void);
void (*reserved36)(void);
int (*tclGetLoadedPackages) (Tcl_Interp *interp, const char *targetName); /* 37 */
int (*tclGetNamespaceForQualName) (Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 38 */
TclObjCmdProcType (*tclGetObjInterpProc) (void); /* 39 */
int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */
Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */
const char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */
void (*reserved43)(void);
int (*tclGuessPackageName) (const char *fileName, Tcl_DString *bufPtr); /* 44 */
int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */
int (*tclInExit) (void); /* 46 */
void (*reserved47)(void);
void (*reserved48)(void);
void (*reserved49)(void);
|
| ︙ | ︙ | |||
765 766 767 768 769 770 771 |
void (*reserved94)(void);
void (*reserved95)(void);
int (*tclRenameCommand) (Tcl_Interp *interp, const char *oldName, const char *newName); /* 96 */
void (*tclResetShadowedCmdRefs) (Tcl_Interp *interp, Command *newCmdPtr); /* 97 */
int (*tclServiceIdle) (void); /* 98 */
void (*reserved99)(void);
void (*reserved100)(void);
| | | 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 |
void (*reserved94)(void);
void (*reserved95)(void);
int (*tclRenameCommand) (Tcl_Interp *interp, const char *oldName, const char *newName); /* 96 */
void (*tclResetShadowedCmdRefs) (Tcl_Interp *interp, Command *newCmdPtr); /* 97 */
int (*tclServiceIdle) (void); /* 98 */
void (*reserved99)(void);
void (*reserved100)(void);
const char * (*tclSetPreInitScript) (const char *string); /* 101 */
void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */
int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */
TCL_DEPRECATED_API("") int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */
void (*reserved105)(void);
void (*reserved106)(void);
void (*reserved107)(void);
void (*tclTeardownNamespace) (Namespace *nsPtr); /* 108 */
|
| ︙ | ︙ | |||
921 922 923 924 925 926 927 |
void (*tclSetChildCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
int (*tclRegisterLiteral) (void *envPtr, const char *bytes, int length, int flags); /* 251 */
Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 252 */
Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, const int flags); /* 253 */
Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const int flags); /* 254 */
int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */
int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 256 */
| | < | | 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 |
void (*tclSetChildCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
int (*tclRegisterLiteral) (void *envPtr, const char *bytes, int length, int flags); /* 251 */
Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 252 */
Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, const int flags); /* 253 */
Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const int flags); /* 254 */
int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */
int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 256 */
void (*tclStaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); /* 257 */
Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */
void (*tclUnusedStubEntry) (void); /* 259 */
} TclIntStubs;
extern const TclIntStubs *tclIntStubsPtr;
#ifdef __cplusplus
}
#endif
|
| ︙ | ︙ | |||
1366 1367 1368 1369 1370 1371 1372 | (tclIntStubsPtr->tclPtrSetVar) /* 253 */ #define TclPtrIncrObjVar \ (tclIntStubsPtr->tclPtrIncrObjVar) /* 254 */ #define TclPtrObjMakeUpvar \ (tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */ #define TclPtrUnsetVar \ (tclIntStubsPtr->tclPtrUnsetVar) /* 256 */ | | | < < | | 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 | (tclIntStubsPtr->tclPtrSetVar) /* 253 */ #define TclPtrIncrObjVar \ (tclIntStubsPtr->tclPtrIncrObjVar) /* 254 */ #define TclPtrObjMakeUpvar \ (tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */ #define TclPtrUnsetVar \ (tclIntStubsPtr->tclPtrUnsetVar) /* 256 */ #define TclStaticLibrary \ (tclIntStubsPtr->tclStaticLibrary) /* 257 */ #define TclpCreateTemporaryDirectory \ (tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */ #define TclUnusedStubEntry \ (tclIntStubsPtr->tclUnusedStubEntry) /* 259 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT |
| ︙ | ︙ | |||
1405 1406 1407 1408 1409 1410 1411 | # undef TclGetGlobalNamespace_ # undef TclFindNamespace # undef TclFindCommand # undef TclGetCommandFromObj # undef TclGetCommandFullName # undef TclCopyChannelOld # undef TclSockMinimumBuffersOld | | | > > | 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 | # undef TclGetGlobalNamespace_ # undef TclFindNamespace # undef TclFindCommand # undef TclGetCommandFromObj # undef TclGetCommandFullName # undef TclCopyChannelOld # undef TclSockMinimumBuffersOld # undef Tcl_StaticLibrary # define Tcl_StaticLibrary (tclIntStubsPtr->tclStaticLibrary) #endif #undef TclGuessPackageName #undef TclUnusedStubEntry #undef TclSetPreInitScript #ifndef TCL_NO_DEPRECATED # define TclSetPreInitScript Tcl_SetPreInitScript # define TclGuessPackageName(fileName, pkgName) ((void)fileName,(void)pkgName,0) #endif #endif /* _TCLINTDECLS */ |
Changes to generic/tclIntPlatDecls.h.
| ︙ | ︙ | |||
566 567 568 569 570 571 572 573 574 575 576 577 578 579 | #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_ #ifndef MAC_OSX_TCL /* not accessable on Win32/UNIX */ #undef TclMacOSXGetFileAttribute /* 15 */ | > > > > > | 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 | #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT #undef TclpLocaltime_unix #undef TclpGmtime_unix #undef TclWinConvertWSAError #define TclWinConvertWSAError TclWinConvertError #if !defined(TCL_USE_STUBS) && !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 # undef TclWinConvertError # define TclWinConvertError Tcl_WinConvertError #endif #undef TclpInetNtoa #define TclpInetNtoa inet_ntoa #undef TclpCreateTempFile_ #undef TclUnixWaitForFile_ #ifndef MAC_OSX_TCL /* not accessable on Win32/UNIX */ #undef TclMacOSXGetFileAttribute /* 15 */ |
| ︙ | ︙ |
Changes to generic/tclInterp.c.
| ︙ | ︙ | |||
277 278 279 280 281 282 283 | static Tcl_ObjCmdProc NRInterpCmd; static Tcl_ObjCmdProc NRChildCmd; /* *---------------------------------------------------------------------- * | | | | | 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 |
static Tcl_ObjCmdProc NRInterpCmd;
static Tcl_ObjCmdProc NRChildCmd;
/*
*----------------------------------------------------------------------
*
* Tcl_SetPreInitScript --
*
* This routine is used to change the value of the internal variable,
* tclPreInitScript.
*
* Results:
* Returns the current value of tclPreInitScript.
*
* Side effects:
* Changes the way Tcl_Init() routine behaves.
*
*----------------------------------------------------------------------
*/
const char *
Tcl_SetPreInitScript(
const char *string) /* Pointer to a script. */
{
const char *prevString = tclPreInitScript;
tclPreInitScript = string;
return prevString;
}
/*
*----------------------------------------------------------------------
*
* Tcl_Init --
*
|
| ︙ | ︙ | |||
2414 2415 2416 2417 2418 2419 2420 |
Child *childPtr;
InterpInfo *parentInfoPtr;
Tcl_HashEntry *hPtr;
const char *path;
int isNew, objc;
Tcl_Obj **objv;
| | | 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 |
Child *childPtr;
InterpInfo *parentInfoPtr;
Tcl_HashEntry *hPtr;
const char *path;
int isNew, objc;
Tcl_Obj **objv;
if (TclListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) {
return NULL;
}
if (objc < 2) {
parentInterp = interp;
path = TclGetString(pathPtr);
} else {
Tcl_Obj *objPtr;
|
| ︙ | ︙ |
Changes to generic/tclLink.c.
| ︙ | ︙ | |||
584 585 586 587 588 589 590 |
Tcl_Obj *objPtr,
double *dblPtr)
{
if (Tcl_GetDoubleFromObj(NULL, objPtr, dblPtr) == TCL_OK) {
return 0;
} else {
#ifdef ACCEPT_NAN
| | | | | | 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 |
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;
}
}
static inline int
EqualDouble(
double a,
double b)
{
return (a == b)
#ifdef ACCEPT_NAN
|| (isnan(a) && isnan(b))
#endif /* ACCEPT_NAN */
;
}
static inline int
IsSpecial(
double a)
{
return isinf(a)
#ifdef ACCEPT_NAN
|| isnan(a)
#endif /* ACCEPT_NAN */
;
}
/*
* Mark an object as holding a weird double.
*/
|
| ︙ | ︙ | |||
652 653 654 655 656 657 658 |
if (*endPtr == '+' || *endPtr == '-') {
++endPtr;
}
if (*endPtr == 0) {
double doubleValue = 0.0;
Tcl_GetDoubleFromObj(NULL, objPtr, &doubleValue);
| | | 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 |
if (*endPtr == '+' || *endPtr == '-') {
++endPtr;
}
if (*endPtr == 0) {
double doubleValue = 0.0;
Tcl_GetDoubleFromObj(NULL, objPtr, &doubleValue);
TclFreeInternalRep(objPtr);
objPtr->typePtr = &invalidRealType;
objPtr->internalRep.doubleValue = doubleValue;
return TCL_OK;
}
}
}
return TCL_ERROR;
|
| ︙ | ︙ | |||
701 702 703 704 705 706 707 |
static int
GetInvalidDoubleFromObj(
Tcl_Obj *objPtr,
double *doublePtr)
{
int intValue;
| | | 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 |
static int
GetInvalidDoubleFromObj(
Tcl_Obj *objPtr,
double *doublePtr)
{
int intValue;
if (TclHasInternalRep(objPtr, &invalidRealType)) {
goto gotdouble;
}
if (GetInvalidIntFromObj(objPtr, &intValue) == TCL_OK) {
*doublePtr = (double) intValue;
return TCL_OK;
}
if (SetInvalidRealFromAny(NULL, objPtr) == TCL_OK) {
|
| ︙ | ︙ | |||
943 944 945 946 947 948 949 |
((value) >= (lowerLimit) && (value) <= (upperLimit))
/*
* If we're working with an array of numbers, extract the Tcl list.
*/
if (linkPtr->flags & LINK_ALLOC_LAST) {
| | | 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 |
((value) >= (lowerLimit) && (value) <= (upperLimit))
/*
* If we're working with an array of numbers, extract the Tcl list.
*/
if (linkPtr->flags & LINK_ALLOC_LAST) {
if (TclListObjGetElements(NULL, (valueObj), &objc, &objv) == TCL_ERROR
|| objc != linkPtr->numElems) {
return (char *) "wrong dimension";
}
}
switch (linkPtr->type) {
case TCL_LINK_INT:
|
| ︙ | ︙ |
Changes to generic/tclListObj.c.
| ︙ | ︙ | |||
16 17 18 19 20 21 22 | /* * Prototypes for functions defined later in this file: */ static List * AttemptNewList(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); | | | 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | /* * Prototypes for functions defined later in this file: */ static List * AttemptNewList(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static List * NewListInternalRep(int objc, Tcl_Obj *const objv[], int p); 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); /* * The structure below defines the list Tcl object type by means of functions |
| ︙ | ︙ | |||
45 46 47 48 49 50 51 |
DupListInternalRep, /* dupIntRepProc */
UpdateStringOfList, /* updateStringProc */
SetListFromAny /* setFromAnyProc */
};
/* Macros to manipulate the List internal rep */
| | | | | | | | | | | | | 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 |
DupListInternalRep, /* dupIntRepProc */
UpdateStringOfList, /* updateStringProc */
SetListFromAny /* setFromAnyProc */
};
/* Macros to manipulate the List internal rep */
#define ListSetInternalRep(objPtr, listRepPtr) \
do { \
Tcl_ObjInternalRep ir; \
ir.twoPtrValue.ptr1 = (listRepPtr); \
ir.twoPtrValue.ptr2 = NULL; \
(listRepPtr)->refCount++; \
Tcl_StoreInternalRep((objPtr), &tclListType, &ir); \
} while (0)
#define ListGetInternalRep(objPtr, listRepPtr) \
do { \
const Tcl_ObjInternalRep *irPtr; \
irPtr = TclFetchInternalRep((objPtr), &tclListType); \
(listRepPtr) = irPtr ? (List *)irPtr->twoPtrValue.ptr1 : NULL; \
} while (0)
#define ListResetInternalRep(objPtr, listRepPtr) \
TclFetchInternalRep((objPtr), &tclListType)->twoPtrValue.ptr1 = (listRepPtr)
#ifndef TCL_MIN_ELEMENT_GROWTH
#define TCL_MIN_ELEMENT_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Obj *)
#endif
/*
*----------------------------------------------------------------------
*
* NewListInternalRep --
*
* Creates a list internal rep with space for objc elements. objc
* must be > 0. If objv!=NULL, initializes with the first objc values
* in that array. If objv==NULL, initalize list internal rep to have
* 0 elements, with space to add objc more. Flag value "p" indicates
* how to behave on failure.
*
* Results:
* A new List struct with refCount 0 is returned. If some failure
* prevents this then if p=0, NULL is returned and otherwise the
* routine panics.
*
* Side effects:
* The ref counts of the elements in objv are incremented since the
* resulting list now refers to them.
*
*----------------------------------------------------------------------
*/
static List *
NewListInternalRep(
int objc,
Tcl_Obj *const objv[],
int p)
{
List *listRepPtr;
if (objc <= 0) {
Tcl_Panic("NewListInternalRep: expects postive element count");
}
/*
* First check to see if we'd overflow and try to allocate an object
* larger than our memory allocator allows. Note that this is actually a
* fairly small value when you're on a serious 64-bit machine, but that
* requires API changes to fix. See [Bug 219196] for a discussion.
|
| ︙ | ︙ | |||
175 176 177 178 179 180 181 |
static List *
AttemptNewList(
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
| | | 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 |
static List *
AttemptNewList(
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
List *listRepPtr = NewListInternalRep(objc, objv, 0);
if (interp != NULL && listRepPtr == NULL) {
if (objc > LIST_MAX) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"max length of a Tcl list (%d elements) exceeded",
LIST_MAX));
} else {
|
| ︙ | ︙ | |||
249 250 251 252 253 254 255 |
return listPtr;
}
/*
* Create the internal rep.
*/
| | | | 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 |
return listPtr;
}
/*
* Create the internal rep.
*/
listRepPtr = NewListInternalRep(objc, objv, 1);
/*
* Now create the object.
*/
TclInvalidateStringRep(listPtr);
ListSetInternalRep(listPtr, listRepPtr);
return listPtr;
}
#endif /* if TCL_MEM_DEBUG */
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
314 315 316 317 318 319 320 |
return listPtr;
}
/*
* Create the internal rep.
*/
| | | | 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 |
return listPtr;
}
/*
* Create the internal rep.
*/
listRepPtr = NewListInternalRep(objc, objv, 1);
/*
* Now create the object.
*/
TclInvalidateStringRep(listPtr);
ListSetInternalRep(listPtr, listRepPtr);
return listPtr;
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
|
| ︙ | ︙ | |||
377 378 379 380 381 382 383 |
Tcl_Panic("%s called with shared object", "Tcl_SetListObj");
}
/*
* Free any old string rep and any internal rep for the old type.
*/
| | | | | 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 |
Tcl_Panic("%s called with shared object", "Tcl_SetListObj");
}
/*
* Free any old string rep and any internal rep for the old type.
*/
TclFreeInternalRep(objPtr);
TclInvalidateStringRep(objPtr);
/*
* Set the object's type to "list" and initialize the internal rep.
* However, if there are no elements to put in the list, just give the
* object an empty string rep and a NULL type.
*/
if (objc > 0) {
listRepPtr = NewListInternalRep(objc, objv, 1);
ListSetInternalRep(objPtr, listRepPtr);
} else {
Tcl_InitStringRep(objPtr, NULL, 0);
}
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
424 425 426 427 428 429 430 |
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_Obj *copyPtr;
List *listRepPtr;
| | | 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 |
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_Obj *copyPtr;
List *listRepPtr;
ListGetInternalRep(listPtr, listRepPtr);
if (NULL == listRepPtr) {
if (SetListFromAny(interp, listPtr) != TCL_OK) {
return NULL;
}
}
TclNewObj(copyPtr);
|
| ︙ | ︙ | |||
562 563 564 565 566 567 568 |
int *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. */
{
List *listRepPtr;
| | | | 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 |
int *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. */
{
List *listRepPtr;
ListGetInternalRep(listPtr, listRepPtr);
if (listRepPtr == NULL) {
int result, length;
(void) Tcl_GetStringFromObj(listPtr, &length);
if (length == 0) {
*objcPtr = 0;
*objvPtr = NULL;
return TCL_OK;
}
result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
return result;
}
ListGetInternalRep(listPtr, listRepPtr);
}
*objcPtr = listRepPtr->elemCount;
*objvPtr = &listRepPtr->elements;
return TCL_OK;
}
/*
|
| ︙ | ︙ | |||
676 677 678 679 680 681 682 |
List *listRepPtr, *newPtr = NULL;
int numElems, numRequired, needGrow, isShared, attempt;
if (Tcl_IsShared(listPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement");
}
| | | | | 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 |
List *listRepPtr, *newPtr = NULL;
int numElems, numRequired, needGrow, isShared, attempt;
if (Tcl_IsShared(listPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement");
}
ListGetInternalRep(listPtr, listRepPtr);
if (listRepPtr == NULL) {
int result, length;
(void) Tcl_GetStringFromObj(listPtr, &length);
if (length == 0) {
Tcl_SetListObj(listPtr, 1, &objPtr);
return TCL_OK;
}
result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
return result;
}
ListGetInternalRep(listPtr, listRepPtr);
}
numElems = listRepPtr->elemCount;
numRequired = numElems + 1 ;
needGrow = (numRequired > listRepPtr->maxElemCount);
isShared = (listRepPtr->refCount > 1);
if (numRequired > LIST_MAX) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"max length of a Tcl list (%d elements) exceeded",
LIST_MAX));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
return TCL_ERROR;
}
if (needGrow && !isShared) {
/*
* Need to grow + unshared internalrep => try to realloc
*/
attempt = 2 * numRequired;
if (attempt <= LIST_MAX) {
newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
}
if (newPtr == NULL) {
|
| ︙ | ︙ | |||
737 738 739 740 741 742 743 |
needGrow = 0;
}
}
if (isShared || needGrow) {
Tcl_Obj **dst, **src = &listRepPtr->elements;
/*
| | | | 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 |
needGrow = 0;
}
}
if (isShared || needGrow) {
Tcl_Obj **dst, **src = &listRepPtr->elements;
/*
* Either we have a shared internalrep and we must copy to write, or we
* need to grow and realloc attempts failed. Attempt internalrep copy.
*/
attempt = 2 * numRequired;
newPtr = AttemptNewList(NULL, attempt, NULL);
if (newPtr == NULL) {
attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH;
if (attempt > LIST_MAX) {
|
| ︙ | ︙ | |||
769 770 771 772 773 774 775 |
dst = &newPtr->elements;
newPtr->refCount++;
newPtr->canonicalFlag = listRepPtr->canonicalFlag;
newPtr->elemCount = listRepPtr->elemCount;
if (isShared) {
/*
| | | | | | | 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 |
dst = &newPtr->elements;
newPtr->refCount++;
newPtr->canonicalFlag = listRepPtr->canonicalFlag;
newPtr->elemCount = listRepPtr->elemCount;
if (isShared) {
/*
* The original internalrep must remain undisturbed. Copy into the new
* one and bump refcounts
*/
while (numElems--) {
*dst = *src++;
Tcl_IncrRefCount(*dst++);
}
listRepPtr->refCount--;
} else {
/*
* Old internalrep to be freed, re-use refCounts.
*/
memcpy(dst, src, numElems * sizeof(Tcl_Obj *));
ckfree(listRepPtr);
}
listRepPtr = newPtr;
}
ListResetInternalRep(listPtr, listRepPtr);
listRepPtr->refCount++;
TclFreeInternalRep(listPtr);
ListSetInternalRep(listPtr, listRepPtr);
listRepPtr->refCount--;
/*
* Add objPtr to the end of listPtr's array of element pointers. Increment
* the ref count for the (now shared) objPtr.
*/
|
| ︙ | ︙ | |||
846 847 848 849 850 851 852 |
Tcl_Interp *interp, /* Used to report errors if not NULL. */
Tcl_Obj *listPtr, /* List object to index into. */
int index, /* Index of element to return. */
Tcl_Obj **objPtrPtr) /* The resulting Tcl_Obj* is stored here. */
{
List *listRepPtr;
| | | | 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 |
Tcl_Interp *interp, /* Used to report errors if not NULL. */
Tcl_Obj *listPtr, /* List object to index into. */
int index, /* Index of element to return. */
Tcl_Obj **objPtrPtr) /* The resulting Tcl_Obj* is stored here. */
{
List *listRepPtr;
ListGetInternalRep(listPtr, listRepPtr);
if (listRepPtr == NULL) {
int result, length;
(void) Tcl_GetStringFromObj(listPtr, &length);
if (length == 0) {
*objPtrPtr = NULL;
return TCL_OK;
}
result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
return result;
}
ListGetInternalRep(listPtr, listRepPtr);
}
if ((index < 0) || (index >= listRepPtr->elemCount)) {
*objPtrPtr = NULL;
} else {
*objPtrPtr = (&listRepPtr->elements)[index];
}
|
| ︙ | ︙ | |||
901 902 903 904 905 906 907 |
Tcl_ListObjLength(
Tcl_Interp *interp, /* Used to report errors if not NULL. */
Tcl_Obj *listPtr, /* List object whose #elements to return. */
int *intPtr) /* The resulting int is stored here. */
{
List *listRepPtr;
| | | | 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 |
Tcl_ListObjLength(
Tcl_Interp *interp, /* Used to report errors if not NULL. */
Tcl_Obj *listPtr, /* List object whose #elements to return. */
int *intPtr) /* The resulting int is stored here. */
{
List *listRepPtr;
ListGetInternalRep(listPtr, listRepPtr);
if (listRepPtr == NULL) {
int result, length;
(void) Tcl_GetStringFromObj(listPtr, &length);
if (length == 0) {
*intPtr = 0;
return TCL_OK;
}
result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
return result;
}
ListGetInternalRep(listPtr, listRepPtr);
}
*intPtr = listRepPtr->elemCount;
return TCL_OK;
}
/*
|
| ︙ | ︙ | |||
977 978 979 980 981 982 983 |
Tcl_Obj **elemPtrs;
int needGrow, numElems, numRequired, numAfterLast, start, i, j, isShared;
if (Tcl_IsShared(listPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
}
| | | | 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 |
Tcl_Obj **elemPtrs;
int needGrow, numElems, numRequired, numAfterLast, start, i, j, isShared;
if (Tcl_IsShared(listPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
}
ListGetInternalRep(listPtr, listRepPtr);
if (listRepPtr == NULL) {
int length;
(void) Tcl_GetStringFromObj(listPtr, &length);
if (length == 0) {
if (objc == 0) {
return TCL_OK;
}
Tcl_SetListObj(listPtr, objc, NULL);
} else {
int result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
return result;
}
}
ListGetInternalRep(listPtr, listRepPtr);
}
/*
* Note that when count == 0 and objc == 0, this routine is logically a
* no-op, removing and adding no elements to the list. However, by flowing
* through this routine anyway, we get the important side effect that the
* resulting listPtr is a list in canoncial form. This is important.
|
| ︙ | ︙ | |||
1058 1059 1060 1061 1062 1063 1064 |
}
if (newPtr == NULL) {
attempt = numRequired;
newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
}
if (newPtr) {
listRepPtr = newPtr;
| | | 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 |
}
if (newPtr == NULL) {
attempt = numRequired;
newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
}
if (newPtr) {
listRepPtr = newPtr;
ListResetInternalRep(listPtr, listRepPtr);
elemPtrs = &listRepPtr->elements;
listRepPtr->maxElemCount = attempt;
needGrow = numRequired > listRepPtr->maxElemCount;
}
}
if (!needGrow && !isShared) {
int shift;
|
| ︙ | ︙ | |||
1131 1132 1133 1134 1135 1136 1137 | #endif } return TCL_ERROR; } } } | | | 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 |
#endif
}
return TCL_ERROR;
}
}
}
ListResetInternalRep(listPtr, listRepPtr);
listRepPtr->refCount++;
elemPtrs = &listRepPtr->elements;
if (isShared) {
/*
* The old struct will remain in place; need new refCounts for the
|
| ︙ | ︙ | |||
1209 1210 1211 1212 1213 1214 1215 |
/*
* Invalidate and free any old representations that may not agree
* with the revised list's internal representation.
*/
listRepPtr->refCount++;
| | | | 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 |
/*
* Invalidate and free any old representations that may not agree
* with the revised list's internal representation.
*/
listRepPtr->refCount++;
TclFreeInternalRep(listPtr);
ListSetInternalRep(listPtr, listRepPtr);
listRepPtr->refCount--;
TclInvalidateStringRep(listPtr);
return TCL_OK;
}
/*
|
| ︙ | ︙ | |||
1236 1237 1238 1239 1240 1241 1242 | * Side effects: * None. * * Notes: * This procedure is implemented entirely as a wrapper around * TclLindexFlat. All it does is reconfigure the argument format into the * form required by TclLindexFlat, while taking care to manage shimmering | | | 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 | * Side effects: * None. * * Notes: * This procedure is implemented entirely as a wrapper around * TclLindexFlat. All it does is reconfigure the argument format into the * form required by TclLindexFlat, while taking care to manage shimmering * in such a way that we tend to keep the most useful internalreps and/or * avoid the most expensive conversions. * *---------------------------------------------------------------------- */ Tcl_Obj * TclLindexList( |
| ︙ | ︙ | |||
1259 1260 1261 1262 1263 1264 1265 |
/*
* 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; see TIP#22 and TIP#33 for the details.
*/
| | | 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 |
/*
* 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; see TIP#22 and TIP#33 for the details.
*/
ListGetInternalRep(argPtr, listRepPtr);
if ((listRepPtr == NULL)
&& TclGetIntForIndexM(NULL , argPtr, INT_MAX - 1, &index) == TCL_OK) {
/*
* argPtr designates a single index.
*/
return TclLindexFlat(interp, listPtr, 1, &argPtr);
|
| ︙ | ︙ | |||
1291 1292 1293 1294 1295 1296 1297 |
* argPtr designates something that is neither an index nor a
* well-formed list. Report the error via TclLindexFlat.
*/
return TclLindexFlat(interp, listPtr, 1, &argPtr);
}
| | | 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 |
* argPtr designates something that is neither an index nor a
* well-formed list. Report the error via TclLindexFlat.
*/
return TclLindexFlat(interp, listPtr, 1, &argPtr);
}
ListGetInternalRep(indexListCopy, listRepPtr);
assert(listRepPtr != NULL);
listPtr = TclLindexFlat(interp, listPtr, listRepPtr->elemCount,
&listRepPtr->elements);
Tcl_DecrRefCount(indexListCopy);
return listPtr;
|
| ︙ | ︙ | |||
1414 1415 1416 1417 1418 1419 1420 | * Side effects: * None. * * Notes: * This procedure is implemented entirely as a wrapper around * TclLsetFlat. All it does is reconfigure the argument format into the * form required by TclLsetFlat, while taking care to manage shimmering | | | 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 | * Side effects: * None. * * Notes: * This procedure is implemented entirely as a wrapper around * TclLsetFlat. All it does is reconfigure the argument format into the * form required by TclLsetFlat, while taking care to manage shimmering * in such a way that we tend to keep the most useful internalreps and/or * avoid the most expensive conversions. * *---------------------------------------------------------------------- */ Tcl_Obj * TclLsetList( |
| ︙ | ︙ | |||
1440 1441 1442 1443 1444 1445 1446 |
/*
* 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.
*/
| | | 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 |
/*
* 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.
*/
ListGetInternalRep(indexArgPtr, listRepPtr);
if (listRepPtr == NULL
&& TclGetIntForIndexM(NULL, indexArgPtr, INT_MAX - 1, &index) == TCL_OK) {
/*
* indexArgPtr designates a single index.
*/
return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr);
|
| ︙ | ︙ | |||
1527 1528 1529 1530 1531 1532 1533 |
int indexCount, /* Number of index args. */
Tcl_Obj *const indexArray[],
/* Index args. */
Tcl_Obj *valuePtr) /* Value arg to 'lset' or NULL to 'lpop'. */
{
int index, result, len;
Tcl_Obj *subListPtr, *retValuePtr, *chainPtr;
| | | 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 |
int indexCount, /* Number of index args. */
Tcl_Obj *const indexArray[],
/* Index args. */
Tcl_Obj *valuePtr) /* Value arg to 'lset' or NULL to 'lpop'. */
{
int index, result, len;
Tcl_Obj *subListPtr, *retValuePtr, *chainPtr;
Tcl_ObjInternalRep *irPtr;
/*
* 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 valuePtr just in case.
*/
|
| ︙ | ︙ | |||
1632 1633 1634 1635 1636 1637 1638 |
if (Tcl_IsShared(subListPtr)) {
subListPtr = Tcl_DuplicateObj(subListPtr);
}
/*
* Replace the original elemPtr[index] in parentList with a copy
* we know to be unshared. This call will also deal with the
| | | | 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 |
if (Tcl_IsShared(subListPtr)) {
subListPtr = Tcl_DuplicateObj(subListPtr);
}
/*
* 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
* subListPtr to become shared again, so detect that case and make
* and store another copy.
*/
if (index == elemCount) {
Tcl_ListObjAppendElement(NULL, parentList, subListPtr);
} else {
|
| ︙ | ︙ | |||
1658 1659 1660 1661 1662 1663 1664 | * far is replace a list element with an unshared copy. The list * value remains the same, so the string rep. is still valid, and * unchanged, which is good because if this whole routine returns * NULL, we'd like to leave no change to the value of the lset * variable. Later on, when we set valuePtr in its proper place, * then all containing lists will have their values changed, and * will need their string reps spoiled. We maintain a list of all | | | | | | | | 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 |
* far is replace a list element with an unshared copy. The list
* value remains the same, so the string rep. is still valid, and
* unchanged, which is good because if this whole routine returns
* NULL, we'd like to leave no change to the value of the lset
* variable. Later on, when we set valuePtr in its proper place,
* then all containing lists will have their values changed, and
* will need their string reps spoiled. We maintain a list of all
* those Tcl_Obj's (via a little internalrep surgery) so we can spoil
* them at that time.
*/
irPtr = TclFetchInternalRep(parentList, &tclListType);
irPtr->twoPtrValue.ptr2 = chainPtr;
chainPtr = parentList;
}
} while (indexCount > 0);
/*
* Either we've detected and error condition, and exited the loop with
* result == TCL_ERROR, or we've successfully reached the last index, and
* we're ready to store valuePtr. In either case, we need to clean up our
* string spoiling list of Tcl_Obj's.
*/
while (chainPtr) {
Tcl_Obj *objPtr = chainPtr;
List *listRepPtr;
/*
* Clear away our internalrep surgery mess.
*/
irPtr = TclFetchInternalRep(objPtr, &tclListType);
listRepPtr = (List *)irPtr->twoPtrValue.ptr1;
chainPtr = (Tcl_Obj *)irPtr->twoPtrValue.ptr2;
if (result == TCL_OK) {
/*
* We're going to store valuePtr, so spoil string reps of all
* containing lists.
*/
listRepPtr->refCount++;
TclFreeInternalRep(objPtr);
ListSetInternalRep(objPtr, listRepPtr);
listRepPtr->refCount--;
TclInvalidateStringRep(objPtr);
} else {
irPtr->twoPtrValue.ptr2 = NULL;
}
}
|
| ︙ | ︙ | |||
1789 1790 1791 1792 1793 1794 1795 |
* Ensure that the listPtr parameter designates an unshared list.
*/
if (Tcl_IsShared(listPtr)) {
Tcl_Panic("%s called with shared object", "TclListObjSetElement");
}
| | | | 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 |
* Ensure that the listPtr parameter designates an unshared list.
*/
if (Tcl_IsShared(listPtr)) {
Tcl_Panic("%s called with shared object", "TclListObjSetElement");
}
ListGetInternalRep(listPtr, listRepPtr);
if (listRepPtr == NULL) {
int result, length;
(void) Tcl_GetStringFromObj(listPtr, &length);
if (length == 0) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"index \"%d\" out of range", index));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX",
"OUTOFRANGE", NULL);
}
return TCL_ERROR;
}
result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
return result;
}
ListGetInternalRep(listPtr, listRepPtr);
}
elemCount = listRepPtr->elemCount;
/*
* Ensure that the index is in bounds.
*/
|
| ︙ | ︙ | |||
1853 1854 1855 1856 1857 1858 1859 | *dst = *src++; Tcl_IncrRefCount(*dst++); } listRepPtr->refCount--; listRepPtr = newPtr; | | | 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 |
*dst = *src++;
Tcl_IncrRefCount(*dst++);
}
listRepPtr->refCount--;
listRepPtr = newPtr;
ListResetInternalRep(listPtr, listRepPtr);
}
elemPtrs = &listRepPtr->elements;
/*
* Add a reference to the new list element.
*/
|
| ︙ | ︙ | |||
1876 1877 1878 1879 1880 1881 1882 |
/*
* Stash the new object in the list.
*/
elemPtrs[index] = valuePtr;
/*
| | | | | | 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 |
/*
* Stash the new object in the list.
*/
elemPtrs[index] = valuePtr;
/*
* Invalidate outdated internalreps.
*/
ListGetInternalRep(listPtr, listRepPtr);
listRepPtr->refCount++;
TclFreeInternalRep(listPtr);
ListSetInternalRep(listPtr, listRepPtr);
listRepPtr->refCount--;
TclInvalidateStringRep(listPtr);
return TCL_OK;
}
|
| ︙ | ︙ | |||
1914 1915 1916 1917 1918 1919 1920 |
static void
FreeListInternalRep(
Tcl_Obj *listPtr) /* List object with internal rep to free. */
{
List *listRepPtr;
| | | 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 |
static void
FreeListInternalRep(
Tcl_Obj *listPtr) /* List object with internal rep to free. */
{
List *listRepPtr;
ListGetInternalRep(listPtr, listRepPtr);
assert(listRepPtr != NULL);
if (listRepPtr->refCount-- <= 1) {
Tcl_Obj **elemPtrs = &listRepPtr->elements;
int i, numElems = listRepPtr->elemCount;
for (i = 0; i < numElems; i++) {
|
| ︙ | ︙ | |||
1952 1953 1954 1955 1956 1957 1958 |
static void
DupListInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
List *listRepPtr;
| | | | 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 |
static void
DupListInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
List *listRepPtr;
ListGetInternalRep(srcPtr, listRepPtr);
assert(listRepPtr != NULL);
ListSetInternalRep(copyPtr, listRepPtr);
}
/*
*----------------------------------------------------------------------
*
* SetListFromAny --
*
|
| ︙ | ︙ | |||
1992 1993 1994 1995 1996 1997 1998 |
* 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).
*/
| | | 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 |
* 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 (!TclHasStringRep(objPtr) && TclHasInternalRep(objPtr, &tclDictType)) {
Tcl_Obj *keyPtr, *valuePtr;
Tcl_DictSearch search;
int done, size;
/*
* Create the new list representation. Note that we do not need to do
* anything with the string representation as the transformation (and
|
| ︙ | ︙ | |||
2095 2096 2097 2098 2099 2100 2101 |
/*
* Store the new internalRep. We do this as late
* as possible to allow the conversion code, in particular
* Tcl_GetStringFromObj, to use the old internalRep.
*/
| | | 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 |
/*
* Store the new internalRep. We do this as late
* as possible to allow the conversion code, in particular
* Tcl_GetStringFromObj, to use the old internalRep.
*/
ListSetInternalRep(objPtr, listRepPtr);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* UpdateStringOfList --
|
| ︙ | ︙ | |||
2132 2133 2134 2135 2136 2137 2138 |
char localFlags[LOCAL_SIZE], *flagPtr = NULL;
int numElems, i, length, bytesNeeded = 0;
const char *elem, *start;
char *dst;
Tcl_Obj **elemPtrs;
List *listRepPtr;
| | | 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 |
char localFlags[LOCAL_SIZE], *flagPtr = NULL;
int numElems, i, length, bytesNeeded = 0;
const char *elem, *start;
char *dst;
Tcl_Obj **elemPtrs;
List *listRepPtr;
ListGetInternalRep(listPtr, listRepPtr);
assert(listRepPtr != NULL);
numElems = listRepPtr->elemCount;
/*
* Mark the list as being canonical; although it will now have a string
|
| ︙ | ︙ |
Changes to generic/tclLiteral.c.
| ︙ | ︙ | |||
1041 1042 1043 1044 1045 1046 1047 | * TclSetCmdNameObj()). * * Results: * None. * * Side effects: * Resets the internal representation of the CmdName Tcl_Obj | | | | | 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 |
* TclSetCmdNameObj()).
*
* Results:
* None.
*
* Side effects:
* Resets the internal representation of the CmdName Tcl_Obj
* using TclFreeInternalRep().
*
*----------------------------------------------------------------------
*/
void
TclInvalidateCmdLiteral(
Tcl_Interp *interp, /* Interpreter for which to invalidate a
* command literal. */
const char *name, /* Points to the start of the cmd literal
* name. */
Namespace *nsPtr) /* The namespace for which to lookup and
* invalidate a cmd literal. */
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *literalObjPtr = TclCreateLiteral(iPtr, name,
strlen(name), -1, NULL, nsPtr, 0, NULL);
if (literalObjPtr != NULL) {
if (TclHasInternalRep(literalObjPtr, &tclCmdNameType)) {
TclFreeInternalRep(literalObjPtr);
}
/* Balance the refcount effects of TclCreateLiteral() above */
Tcl_IncrRefCount(literalObjPtr);
TclReleaseLiteral(interp, literalObjPtr);
}
}
|
| ︙ | ︙ |
Changes to generic/tclLoad.c.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | /* * tclLoad.c -- * * This file provides the generic portion (those that are the same on all * platforms) of Tcl's dynamic loading facilities. * * Copyright © 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #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 | > | | | | | | 1 2 3 4 5 6 7 8 9 10 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 |
/*
* tclLoad.c --
*
* This file provides the generic portion (those that are the same on all
* platforms) of Tcl's dynamic loading facilities.
*
* Copyright © 1995-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
/*
* The following structure describes a library that has been loaded either
* dynamically (with the "load" command) or statically (as indicated by a call
* to Tcl_StaticLibrary). All such libraries are linked together into a
* single list for the process. Library are never unloaded, until the
* application exits, when TclFinalizeLoad is called, and these structures are
* freed.
*/
typedef struct LoadedLibrary {
char *fileName; /* Name of the file from which the library was
* loaded. An empty string means the library
* is loaded statically. Malloc-ed. */
char *prefix; /* Prefix for the library,
* properly capitalized (first letter UC,
* others LC), as in "Net".
* Malloc-ed. */
Tcl_LoadHandle loadHandle; /* Token for the loaded file which should be
* passed to (*unLoadProcPtr)() when the file
* is no longer needed. If fileName is NULL,
* then this field is irrelevant. */
Tcl_LibraryInitProc *initProc;
/* Initialization function to call to
* incorporate this library into a trusted
* interpreter. */
Tcl_LibraryInitProc *safeInitProc;
/* Initialization function to call to
* incorporate this library into a safe
* interpreter (one that will execute
* untrusted scripts). NULL means the library
* can't be used in unsafe interpreters. */
Tcl_LibraryUnloadProc *unloadProc;
/* Finalization function to unload a library
* from a trusted interpreter. NULL means that
* the library cannot be unloaded. */
Tcl_LibraryUnloadProc *safeUnloadProc;
/* Finalization function to unload a library
* from a safe interpreter. NULL means that
* the library cannot be unloaded. */
int interpRefCount; /* How many times the library has been loaded
* in trusted interpreters. */
int safeInterpRefCount; /* How many times the library has been loaded
* in safe interpreters. */
|
| ︙ | ︙ | |||
89 90 91 92 93 94 95 | * for end of list. */ } InterpLibrary; /* * Prototypes for functions that are private to this file: */ | | | > > > > > > > > > > > > | 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 |
* for end of list. */
} InterpLibrary;
/*
* Prototypes for functions that are private to this file:
*/
static void LoadCleanupProc(ClientData clientData,
Tcl_Interp *interp);
static int IsStatic (LoadedLibrary *libraryPtr);
static int UnloadLibrary(Tcl_Interp *interp, Tcl_Interp *target,
LoadedLibrary *library, int keepLibrary,
const char *fullFileName, int interpExiting);
static int
IsStatic (LoadedLibrary *libraryPtr) {
int res;
res = (libraryPtr->fileName[0] == '\0');
return res;
}
/*
*----------------------------------------------------------------------
*
* Tcl_LoadObjCmd --
*
* This function is invoked to process the "load" Tcl command. See the
|
| ︙ | ︙ | |||
123 124 125 126 127 128 129 |
Tcl_Interp *target;
LoadedLibrary *libraryPtr, *defaultPtr;
Tcl_DString pfx, tmp, initName, safeInitName;
Tcl_DString unloadName, safeUnloadName;
InterpLibrary *ipFirstPtr, *ipPtr;
int code, namesMatch, filesMatch, offset;
const char *symbols[2];
| | | 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 |
Tcl_Interp *target;
LoadedLibrary *libraryPtr, *defaultPtr;
Tcl_DString pfx, tmp, initName, safeInitName;
Tcl_DString unloadName, safeUnloadName;
InterpLibrary *ipFirstPtr, *ipPtr;
int code, namesMatch, filesMatch, offset;
const char *symbols[2];
Tcl_LibraryInitProc *initProc;
const char *p, *fullFileName, *prefix;
Tcl_LoadHandle loadHandle;
Tcl_UniChar ch = 0;
unsigned len;
int index, flags = 0;
Tcl_Obj *const *savedobjv = objv;
static const char *const options[] = {
|
| ︙ | ︙ | |||
327 328 329 330 331 332 333 |
}
#ifdef __CYGWIN__
else if ((pkgGuess[0] == 'c') && (pkgGuess[1] == 'y')
&& (pkgGuess[2] == 'g')) {
pkgGuess += 3;
}
#endif /* __CYGWIN__ */
| > > > > | | 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 |
}
#ifdef __CYGWIN__
else if ((pkgGuess[0] == 'c') && (pkgGuess[1] == 'y')
&& (pkgGuess[2] == 'g')) {
pkgGuess += 3;
}
#endif /* __CYGWIN__ */
if (((pkgGuess[0] == 't')
#ifdef MAC_OSX_TCL
|| (pkgGuess[0] == 'T')
#endif
) && (pkgGuess[1] == 'c')
&& (pkgGuess[2] == 'l')) {
pkgGuess += 3;
}
for (p = pkgGuess; *p != 0; p += offset) {
offset = TclUtfToUniChar(p, &ch);
if ((ch > 0x100)
|| !(isalpha(UCHAR(ch)) /* INTL: ISO only */
|
| ︙ | ︙ | |||
405 406 407 408 409 410 411 | libraryPtr->fileName = (char *)ckalloc(len); memcpy(libraryPtr->fileName, fullFileName, len); len = Tcl_DStringLength(&pfx) + 1; libraryPtr->prefix = (char *)ckalloc(len); memcpy(libraryPtr->prefix, Tcl_DStringValue(&pfx), len); libraryPtr->loadHandle = loadHandle; libraryPtr->initProc = initProc; | | | | | 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 | libraryPtr->fileName = (char *)ckalloc(len); memcpy(libraryPtr->fileName, fullFileName, len); len = Tcl_DStringLength(&pfx) + 1; libraryPtr->prefix = (char *)ckalloc(len); memcpy(libraryPtr->prefix, Tcl_DStringValue(&pfx), len); libraryPtr->loadHandle = loadHandle; libraryPtr->initProc = initProc; libraryPtr->safeInitProc = (Tcl_LibraryInitProc *) Tcl_FindSymbol(interp, loadHandle, Tcl_DStringValue(&safeInitName)); libraryPtr->unloadProc = (Tcl_LibraryUnloadProc *) Tcl_FindSymbol(interp, loadHandle, Tcl_DStringValue(&unloadName)); libraryPtr->safeUnloadProc = (Tcl_LibraryUnloadProc *) Tcl_FindSymbol(interp, loadHandle, Tcl_DStringValue(&safeUnloadName)); libraryPtr->interpRefCount = 0; libraryPtr->safeInterpRefCount = 0; Tcl_MutexLock(&libraryMutex); libraryPtr->nextPtr = firstLibraryPtr; |
| ︙ | ︙ | |||
543 544 545 546 547 548 549 |
Tcl_UnloadObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Interp *target; /* Which interpreter to unload from. */
| | < < | 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 |
Tcl_UnloadObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Interp *target; /* Which interpreter to unload from. */
LoadedLibrary *libraryPtr;
Tcl_DString pfx, tmp;
InterpLibrary *ipFirstPtr, *ipPtr;
int i, index, code, complain = 1, keepLibrary = 0;
const char *fullFileName = "";
const char *prefix;
static const char *const options[] = {
"-nocomplain", "-keeplibrary", "--", NULL
};
enum unloadOptionsEnum {
UNLOAD_NOCOMPLAIN, UNLOAD_KEEPLIB, UNLOAD_LAST
|
| ︙ | ︙ | |||
642 643 644 645 646 647 648 |
/*
* Scan through the libraries that are currently loaded to see if the
* library we want is already loaded. We'll use a loaded library if it
* meets any of the following conditions:
* - Its prefix and file match the once we're looking for.
* - Its file matches, and we weren't given a prefix.
* - Its prefix matches, the file name was specified as empty, and there is
| | < | 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 |
/*
* Scan through the libraries that are currently loaded to see if the
* library we want is already loaded. We'll use a loaded library if it
* meets any of the following conditions:
* - Its prefix and file match the once we're looking for.
* - Its file matches, and we weren't given a prefix.
* - Its prefix matches, the file name was specified as empty, and there is
* no statically loaded library with the same prefix.
*/
Tcl_MutexLock(&libraryMutex);
for (libraryPtr = firstLibraryPtr; libraryPtr != NULL; libraryPtr = libraryPtr->nextPtr) {
int namesMatch, filesMatch;
if (prefix == NULL) {
namesMatch = 0;
} else {
TclDStringClear(&pfx);
|
| ︙ | ︙ | |||
673 674 675 676 677 678 679 |
}
TclDStringClear(&pfx);
filesMatch = (strcmp(libraryPtr->fileName, fullFileName) == 0);
if (filesMatch && (namesMatch || (prefix == NULL))) {
break;
}
| < < < | 687 688 689 690 691 692 693 694 695 696 697 698 699 700 |
}
TclDStringClear(&pfx);
filesMatch = (strcmp(libraryPtr->fileName, fullFileName) == 0);
if (filesMatch && (namesMatch || (prefix == NULL))) {
break;
}
if (filesMatch && !namesMatch && (fullFileName[0] != 0)) {
break;
}
}
Tcl_MutexUnlock(&libraryMutex);
if (fullFileName[0] == 0) {
/*
|
| ︙ | ︙ | |||
737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 |
fullFileName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED",
NULL);
code = TCL_ERROR;
goto done;
}
/*
* Ensure that the DLL can be unloaded. If it is a trusted interpreter,
* libraryPtr->unloadProc must not be NULL for the DLL to be unloadable. If
* the interpreter is a safe one, libraryPtr->safeUnloadProc must be non-NULL.
*/
if (Tcl_IsSafe(target)) {
if (libraryPtr->safeUnloadProc == NULL) {
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | | | | | > > | | | | | | | > > > > > > | | | | | | | | | | | | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 |
fullFileName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED",
NULL);
code = TCL_ERROR;
goto done;
}
code = UnloadLibrary(interp, target, libraryPtr, keepLibrary, fullFileName, 0);
done:
Tcl_DStringFree(&pfx);
Tcl_DStringFree(&tmp);
if (!complain && (code != TCL_OK)) {
code = TCL_OK;
Tcl_ResetResult(interp);
}
return code;
}
static int
UnloadLibrary(
Tcl_Interp *interp,
Tcl_Interp *target,
LoadedLibrary *libraryPtr,
int keepLibrary,
const char *fullFileName,
int interpExiting
)
{
int code;
InterpLibrary *ipFirstPtr, *ipPtr;
LoadedLibrary *iterLibraryPtr;
int trustedRefCount = -1, safeRefCount = -1;
Tcl_LibraryUnloadProc *unloadProc = NULL;
/*
* Ensure that the DLL can be unloaded. If it is a trusted interpreter,
* libraryPtr->unloadProc must not be NULL for the DLL to be unloadable. If
* the interpreter is a safe one, libraryPtr->safeUnloadProc must be non-NULL.
*/
if (Tcl_IsSafe(target)) {
if (libraryPtr->safeUnloadProc == NULL) {
if (!interpExiting) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"file \"%s\" cannot be unloaded under a safe interpreter",
fullFileName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
NULL);
code = TCL_ERROR;
goto done;
}
}
unloadProc = libraryPtr->safeUnloadProc;
} else {
if (libraryPtr->unloadProc == NULL) {
if (!interpExiting) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"file \"%s\" cannot be unloaded under a trusted interpreter",
fullFileName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
NULL);
code = TCL_ERROR;
goto done;
}
}
unloadProc = libraryPtr->unloadProc;
}
/*
* We are ready to unload the library. First, evaluate the unload
* function. If this fails, we cannot proceed with unload. Also, we must
* specify the proper flag to pass to the unload callback.
* TCL_UNLOAD_DETACH_FROM_INTERPRETER is defined when the callback should
* only remove itself from the interpreter; the library will be unloaded
* in a future call of unload. In case the library will be unloaded just
* after the callback returns, TCL_UNLOAD_DETACH_FROM_PROCESS is passed.
*/
if (unloadProc == NULL) {
code = TCL_OK;
} else {
code = TCL_UNLOAD_DETACH_FROM_INTERPRETER;
if (!keepLibrary) {
Tcl_MutexLock(&libraryMutex);
trustedRefCount = libraryPtr->interpRefCount;
safeRefCount = libraryPtr->safeInterpRefCount;
Tcl_MutexUnlock(&libraryMutex);
if (Tcl_IsSafe(target)) {
safeRefCount--;
} else {
trustedRefCount--;
}
if (safeRefCount <= 0 && trustedRefCount <= 0) {
code = TCL_UNLOAD_DETACH_FROM_PROCESS;
}
}
code = unloadProc(target, code);
}
if (code != TCL_OK) {
Tcl_TransferResult(target, code, interp);
goto done;
}
/*
* Remove this library from the interpreter's library cache.
*/
ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL);
ipPtr = ipFirstPtr;
if (ipPtr->libraryPtr == libraryPtr) {
ipFirstPtr = ipFirstPtr->nextPtr;
} else {
InterpLibrary *ipPrevPtr;
for (ipPrevPtr = ipPtr; ipPtr != NULL;
ipPrevPtr = ipPtr, ipPtr = ipPtr->nextPtr) {
if (ipPtr->libraryPtr == libraryPtr) {
ipPrevPtr->nextPtr = ipPtr->nextPtr;
break;
}
}
}
ckfree(ipPtr);
Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipFirstPtr);
if (IsStatic(libraryPtr)) {
goto done;
}
/*
* The unload function executed fine. Examine the reference count to see
* if we unload the DLL.
*/
Tcl_MutexLock(&libraryMutex);
if (Tcl_IsSafe(target)) {
libraryPtr->safeInterpRefCount--;
/*
* Do not let counter get negative.
|
| ︙ | ︙ | |||
846 847 848 849 850 851 852 | /* * Some Unix dlls are poorly behaved - registering things like atexit * calls that can't be unregistered. If you unload such dlls, you get * a core on exit because it wants to call a function in the dll after * it's been unloaded. */ | | | | | | < < < < < < < < < < < < < < < < < < < < < | | < | < < < < < < | | | | | 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 |
/*
* Some Unix dlls are poorly behaved - registering things like atexit
* calls that can't be unregistered. If you unload such dlls, you get
* a core on exit because it wants to call a function in the dll after
* it's been unloaded.
*/
if (!IsStatic(libraryPtr)) {
Tcl_MutexLock(&libraryMutex);
if (Tcl_FSUnloadFile(interp, libraryPtr->loadHandle) == TCL_OK) {
/*
* Remove this library from the loaded library cache.
*/
iterLibraryPtr = libraryPtr;
if (iterLibraryPtr == firstLibraryPtr) {
firstLibraryPtr = libraryPtr->nextPtr;
} else {
for (libraryPtr = firstLibraryPtr; libraryPtr != NULL;
libraryPtr = libraryPtr->nextPtr) {
if (libraryPtr->nextPtr == iterLibraryPtr) {
libraryPtr->nextPtr = iterLibraryPtr->nextPtr;
break;
}
}
}
ckfree(iterLibraryPtr->fileName);
ckfree(iterLibraryPtr->prefix);
ckfree(iterLibraryPtr);
Tcl_MutexUnlock(&libraryMutex);
} else {
code = TCL_ERROR;
}
}
#else
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"file \"%s\" cannot be unloaded: unloading disabled",
fullFileName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "DISABLED",
NULL);
code = TCL_ERROR;
#endif
}
done:
return code;
}
/*
*----------------------------------------------------------------------
*
* Tcl_StaticLibrary --
*
* This function is invoked to indicate that a particular library has
* been linked statically with an application.
*
* Results:
* None.
*
* Side effects:
* Once this function completes, the library becomes loadable via the
* "load" command with an empty file name.
*
*----------------------------------------------------------------------
*/
void
Tcl_StaticLibrary(
Tcl_Interp *interp, /* If not NULL, it means that the library has
* already been loaded into the given
* interpreter by calling the appropriate init
* proc. */
const char *prefix, /* Prefix (must be properly
* capitalized: first letter upper case,
* others lower case). */
Tcl_LibraryInitProc *initProc,
/* Function to call to incorporate this
* library into a trusted interpreter. */
Tcl_LibraryInitProc *safeInitProc)
/* Function to call to incorporate this
* library into a safe interpreter (one that
* will execute untrusted scripts). NULL means
* the library can't be used in safe
* interpreters. */
{
LoadedLibrary *libraryPtr;
|
| ︙ | ︙ | |||
985 986 987 988 989 990 991 992 993 994 995 996 997 998 |
libraryPtr->fileName = (char *)ckalloc(1);
libraryPtr->fileName[0] = 0;
libraryPtr->prefix = (char *)ckalloc(strlen(prefix) + 1);
strcpy(libraryPtr->prefix, prefix);
libraryPtr->loadHandle = NULL;
libraryPtr->initProc = initProc;
libraryPtr->safeInitProc = safeInitProc;
Tcl_MutexLock(&libraryMutex);
libraryPtr->nextPtr = firstLibraryPtr;
firstLibraryPtr = libraryPtr;
Tcl_MutexUnlock(&libraryMutex);
}
if (interp != NULL) {
| > > | 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 |
libraryPtr->fileName = (char *)ckalloc(1);
libraryPtr->fileName[0] = 0;
libraryPtr->prefix = (char *)ckalloc(strlen(prefix) + 1);
strcpy(libraryPtr->prefix, prefix);
libraryPtr->loadHandle = NULL;
libraryPtr->initProc = initProc;
libraryPtr->safeInitProc = safeInitProc;
libraryPtr->unloadProc = NULL;
libraryPtr->safeUnloadProc = NULL;
Tcl_MutexLock(&libraryMutex);
libraryPtr->nextPtr = firstLibraryPtr;
firstLibraryPtr = libraryPtr;
Tcl_MutexUnlock(&libraryMutex);
}
if (interp != NULL) {
|
| ︙ | ︙ | |||
1133 1134 1135 1136 1137 1138 1139 | * Storage for all of the InterpLibrary functions for interp get deleted. * *---------------------------------------------------------------------- */ static void LoadCleanupProc( | | | | > > | | > > | < < > | 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 |
* Storage for all of the InterpLibrary functions for interp get deleted.
*
*----------------------------------------------------------------------
*/
static void
LoadCleanupProc(
TCL_UNUSED(ClientData), /* Pointer to first InterpLibrary structure
* for interp. */
Tcl_Interp *interp)
{
InterpLibrary *ipPtr;
LoadedLibrary *libraryPtr;
while (1) {
ipPtr = (InterpLibrary *)Tcl_GetAssocData(interp, "tclLoad", NULL);
if (ipPtr == NULL) {
break;
}
libraryPtr = ipPtr->libraryPtr;
UnloadLibrary(interp, interp, libraryPtr, 0 ,"", 1);
}
}
/*
*----------------------------------------------------------------------
*
* TclFinalizeLoad --
|
| ︙ | ︙ | |||
1188 1189 1190 1191 1192 1193 1194 | /* * Some Unix dlls are poorly behaved - registering things like atexit * calls that can't be unregistered. If you unload such dlls, you get * a core on exit because it wants to call a function in the dll after * it has been unloaded. */ | | | 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 |
/*
* Some Unix dlls are poorly behaved - registering things like atexit
* calls that can't be unregistered. If you unload such dlls, you get
* a core on exit because it wants to call a function in the dll after
* it has been unloaded.
*/
if (!IsStatic(libraryPtr)) {
Tcl_FSUnloadFile(NULL, libraryPtr->loadHandle);
}
#endif
ckfree(libraryPtr->fileName);
ckfree(libraryPtr->prefix);
ckfree(libraryPtr);
|
| ︙ | ︙ |
Changes to generic/tclMain.c.
| ︙ | ︙ | |||
24 25 26 27 28 29 30 | #include "tclInt.h" /* * The default prompt used when the user has not overridden it. */ | | | | 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 |
#include "tclInt.h"
/*
* The default prompt used when the user has not overridden it.
*/
static const char DEFAULT_PRIMARY_PROMPT[] = "% ";
/*
* This file can be compiled on Windows in UNICODE mode, as well as on all
* other platforms using the native encoding. This is done by using the normal
* Windows functions like _tcscmp, but on platforms which don't have <tchar.h>
* we have to translate that to strcmp here.
*/
#ifndef _WIN32
# define TCHAR char
# define TEXT(arg) arg
# define _tcscmp strcmp
#endif
static inline Tcl_Obj *
NewNativeObj(
TCHAR *string)
{
Tcl_DString ds;
#ifdef UNICODE
Tcl_DStringInit(&ds);
|
| ︙ | ︙ | |||
284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 |
TCHAR **argv, /* Array of argument strings. */
Tcl_AppInitProc *appInitProc,
/* Application-specific initialization
* function to call after most initialization
* but before starting to execute commands. */
Tcl_Interp *interp)
{
Tcl_Obj *path, *resultPtr, *argvPtr, *appName;
const char *encodingName = NULL;
int code, exitCode = 0;
Tcl_MainLoopProc *mainLoopProc;
Tcl_Channel chan;
InteractiveState is;
TclpSetInitialEncodings();
| > > > > > | > > | 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 |
TCHAR **argv, /* Array of argument strings. */
Tcl_AppInitProc *appInitProc,
/* Application-specific initialization
* function to call after most initialization
* but before starting to execute commands. */
Tcl_Interp *interp)
{
int i=0; /* argv[i] index */
Tcl_Obj *path, *resultPtr, *argvPtr, *appName;
const char *encodingName = NULL;
int code, exitCode = 0;
Tcl_MainLoopProc *mainLoopProc;
Tcl_Channel chan;
InteractiveState is;
TclpSetInitialEncodings();
if (0 < argc) {
--argc; /* "consume" argv[0] */
++i;
}
TclpFindExecutable ((const char *)argv [0]); /* nb: this could be NULL
* w/ (eg) an empty argv
* supplied to execve() */
Tcl_InitMemory(interp);
is.interp = interp;
is.prompt = PROMPT_START;
TclNewObj(is.commandPtr);
|
| ︙ | ︙ | |||
314 315 316 317 318 319 320 | /* * Check whether first 3 args (argv[1] - argv[3]) look like * -encoding ENCODING FILENAME * or like * FILENAME */ | > | | | | < < | | 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 |
/*
* Check whether first 3 args (argv[1] - argv[3]) look like
* -encoding ENCODING FILENAME
* or like
* FILENAME
*/
/* mind argc is being adjusted as we proceed */
if ((argc >= 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1]))
&& ('-' != argv[3][0])) {
Tcl_Obj *value = NewNativeObj(argv[2]);
Tcl_SetStartupScript(NewNativeObj(argv[3]),
Tcl_GetString(value));
Tcl_DecrRefCount(value);
argc -= 3;
i += 3;
} else if ((argc >= 1) && ('-' != argv[1][0])) {
Tcl_SetStartupScript(NewNativeObj(argv[1]), NULL);
argc--;
i++;
}
}
path = Tcl_GetStartupScript(&encodingName);
if (path == NULL) {
appName = NewNativeObj(argv[0]);
} else {
appName = path;
}
Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY);
Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewWideIntObj(argc), TCL_GLOBAL_ONLY);
argvPtr = Tcl_NewListObj(0, NULL);
while (argc--) {
Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(argv[i++]));
}
Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
/*
* Set the "tcl_interactive" variable.
*/
|
| ︙ | ︙ | |||
507 508 509 510 511 512 513 | is.prompt = PROMPT_START; /* * The final newline is syntactically redundant, and causes some * error messages troubles deeper in, so lop it back off. */ | | | | 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 |
is.prompt = PROMPT_START;
/*
* The final newline is syntactically redundant, and causes some
* error messages troubles deeper in, so lop it back off.
*/
(void)Tcl_GetStringFromObj(is.commandPtr, &length);
Tcl_SetObjLength(is.commandPtr, --length);
code = Tcl_RecordAndEvalObj(interp, is.commandPtr,
TCL_EVAL_GLOBAL);
is.input = Tcl_GetStdChannel(TCL_STDIN);
Tcl_DecrRefCount(is.commandPtr);
TclNewObj(is.commandPtr);
Tcl_IncrRefCount(is.commandPtr);
if (code != TCL_OK) {
chan = Tcl_GetStdChannel(TCL_STDERR);
if (chan) {
Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
Tcl_WriteChars(chan, "\n", 1);
}
} else if (is.tty) {
resultPtr = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(resultPtr);
(void)Tcl_GetStringFromObj(resultPtr, &length);
chan = Tcl_GetStdChannel(TCL_STDOUT);
if ((length > 0) && chan) {
Tcl_WriteObj(chan, resultPtr);
Tcl_WriteChars(chan, "\n", 1);
}
Tcl_DecrRefCount(resultPtr);
}
|
| ︙ | ︙ | |||
727 728 729 730 731 732 733 |
*/
static void
StdinProc(
ClientData clientData, /* The state of interactive cmd line */
TCL_UNUSED(int) /*mask*/)
{
| | > | 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 |
*/
static void
StdinProc(
ClientData clientData, /* The state of interactive cmd line */
TCL_UNUSED(int) /*mask*/)
{
int code;
int length;
InteractiveState *isPtr = (InteractiveState *)clientData;
Tcl_Channel chan = isPtr->input;
Tcl_Obj *commandPtr = isPtr->commandPtr;
Tcl_Interp *interp = isPtr->interp;
if (Tcl_IsShared(commandPtr)) {
Tcl_DecrRefCount(commandPtr);
|
| ︙ | ︙ | |||
767 768 769 770 771 772 773 |
}
Tcl_AppendToObj(commandPtr, "\n", 1);
if (!TclObjCommandComplete(commandPtr)) {
isPtr->prompt = PROMPT_CONTINUE;
goto prompt;
}
isPtr->prompt = PROMPT_START;
| | | 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 |
}
Tcl_AppendToObj(commandPtr, "\n", 1);
if (!TclObjCommandComplete(commandPtr)) {
isPtr->prompt = PROMPT_CONTINUE;
goto prompt;
}
isPtr->prompt = PROMPT_START;
(void)Tcl_GetStringFromObj(commandPtr, &length);
Tcl_SetObjLength(commandPtr, --length);
/*
* Disable the stdin channel handler while evaluating the command;
* otherwise if the command re-enters the event loop we might process
* commands from stdin before the current command is finished. Among other
* things, this will trash the text of the command being evaluated.
|
| ︙ | ︙ | |||
799 800 801 802 803 804 805 |
Tcl_WriteChars(chan, "\n", 1);
}
} else if (isPtr->tty) {
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
chan = Tcl_GetStdChannel(TCL_STDOUT);
Tcl_IncrRefCount(resultPtr);
| | | 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 |
Tcl_WriteChars(chan, "\n", 1);
}
} else if (isPtr->tty) {
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
chan = Tcl_GetStdChannel(TCL_STDOUT);
Tcl_IncrRefCount(resultPtr);
(void)Tcl_GetStringFromObj(resultPtr, &length);
if ((length > 0) && (chan != NULL)) {
Tcl_WriteObj(chan, resultPtr);
Tcl_WriteChars(chan, "\n", 1);
}
Tcl_DecrRefCount(resultPtr);
}
|
| ︙ | ︙ | |||
862 863 864 865 866 867 868 |
}
if (promptCmdPtr == NULL) {
defaultPrompt:
if (isPtr->prompt == PROMPT_START) {
chan = Tcl_GetStdChannel(TCL_STDOUT);
if (chan != NULL) {
Tcl_WriteChars(chan, DEFAULT_PRIMARY_PROMPT,
| | | 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 |
}
if (promptCmdPtr == NULL) {
defaultPrompt:
if (isPtr->prompt == PROMPT_START) {
chan = Tcl_GetStdChannel(TCL_STDOUT);
if (chan != NULL) {
Tcl_WriteChars(chan, DEFAULT_PRIMARY_PROMPT,
sizeof(DEFAULT_PRIMARY_PROMPT) - 1);
}
}
} else {
code = Tcl_EvalObjEx(interp, promptCmdPtr, TCL_EVAL_GLOBAL);
if (code != TCL_OK) {
Tcl_AddErrorInfo(interp,
"\n (script that generates prompt)");
|
| ︙ | ︙ |
Changes to generic/tclNamesp.c.
| ︙ | ︙ | |||
129 130 131 132 133 134 135 |
"nsName", /* the type's name */
FreeNsNameInternalRep, /* freeIntRepProc */
DupNsNameInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
SetNsNameFromAny /* setFromAnyProc */
};
| | | | | | | | 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 |
"nsName", /* the type's name */
FreeNsNameInternalRep, /* freeIntRepProc */
DupNsNameInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
SetNsNameFromAny /* setFromAnyProc */
};
#define NsNameSetInternalRep(objPtr, nnPtr) \
do { \
Tcl_ObjInternalRep ir; \
(nnPtr)->refCount++; \
ir.twoPtrValue.ptr1 = (nnPtr); \
ir.twoPtrValue.ptr2 = NULL; \
Tcl_StoreInternalRep((objPtr), &nsNameType, &ir); \
} while (0)
#define NsNameGetInternalRep(objPtr, nnPtr) \
do { \
const Tcl_ObjInternalRep *irPtr; \
irPtr = TclFetchInternalRep((objPtr), &nsNameType); \
(nnPtr) = irPtr ? (ResolvedNsName *)irPtr->twoPtrValue.ptr1 : NULL; \
} while (0)
/*
* Array of values describing how to implement each standard subcommand of the
* "namespace" command.
*/
|
| ︙ | ︙ | |||
302 303 304 305 306 307 308 |
if (namespacePtr == NULL) {
nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
} else {
nsPtr = (Namespace *) namespacePtr;
/*
* TODO: Examine whether it would be better to guard based on NS_DYING
| | | 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 |
if (namespacePtr == NULL) {
nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
} else {
nsPtr = (Namespace *) namespacePtr;
/*
* TODO: Examine whether it would be better to guard based on NS_DYING
* or NS_TEARDOWN. It appears that these are not tested because they can
* be set in a global interp that has been [namespace delete]d, but
* which never really completely goes away because of lingering global
* things like ::errorInfo and [::unknown] and hidden commands.
* Review of those designs might permit stricter checking here.
*/
if (nsPtr->flags & NS_DEAD) {
|
| ︙ | ︙ | |||
982 983 984 985 986 987 988 |
if (nsPtr->unknownHandlerPtr != NULL) {
Tcl_DecrRefCount(nsPtr->unknownHandlerPtr);
nsPtr->unknownHandlerPtr = NULL;
}
/*
| | | > | | | | | | | | | | | | | | | | 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 |
if (nsPtr->unknownHandlerPtr != NULL) {
Tcl_DecrRefCount(nsPtr->unknownHandlerPtr);
nsPtr->unknownHandlerPtr = NULL;
}
/*
* If the namespace is on the call frame stack, it is marked as "dying"
* (NS_DYING is OR'd into its flags): Contents of the namespace are
* still available and visible until the namespace is later marked as
* NS_DEAD, and its commands and variables are still usable by any
* active call frames referring to th namespace. When all active call
* frames referring to the namespace have been popped from the Tcl
* stack, Tcl_PopCallFrame calls Tcl_DeleteNamespace again. If no
* nsName objects refer to the namespace (i.e., if its refCount is
* zero), its commands and variables are deleted and the storage for
* its namespace structure is freed. Otherwise, if its refCount is
* nonzero, the namespace's commands and variables are deleted but the
* structure isn't freed. Instead, NS_DEAD is OR'd into the structure's
* flags to allow the namespace resolution code to recognize that the
* namespace is "deleted". The structure's storage is freed by
* FreeNsNameInternalRep when its refCount reaches 0.
*/
if (nsPtr->activationCount - (nsPtr == globalNsPtr) > 0) {
nsPtr->flags |= NS_DYING;
if (nsPtr->parentPtr != NULL) {
entryPtr = Tcl_FindHashEntry(
TclGetNamespaceChildTable((Tcl_Namespace *)
nsPtr->parentPtr), nsPtr->name);
if (entryPtr != NULL) {
Tcl_DeleteHashEntry(entryPtr);
}
}
nsPtr->parentPtr = NULL;
} else if (!(nsPtr->flags & NS_TEARDOWN)) {
/*
* Delete the namespace and everything in it. If this is the global
* namespace, then clear it but don't free its storage unless the
* interpreter is being torn down. Set the NS_TEARDOWN flag to avoid
* recursive calls here - if the namespace is really in the process of
* being deleted, ignore any second call.
*/
nsPtr->flags |= (NS_DYING|NS_TEARDOWN);
TclTeardownNamespace(nsPtr);
if ((nsPtr != globalNsPtr) || (iPtr->flags & DELETED)) {
/*
* If this is the global namespace, then it may have residual
* "errorInfo" and "errorCode" variables for errors that occurred
|
| ︙ | ︙ | |||
1056 1057 1058 1059 1060 1061 1062 | EstablishErrorCodeTraces(NULL, nsPtr->interp, NULL, NULL, 0); /* * We didn't really kill it, so remove the KILLED marks, so it can * get killed later, avoiding mem leaks. */ | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 |
EstablishErrorCodeTraces(NULL, nsPtr->interp, NULL, NULL, 0);
/*
* We didn't really kill it, so remove the KILLED marks, so it can
* get killed later, avoiding mem leaks.
*/
nsPtr->flags &= ~(NS_DYING|NS_TEARDOWN);
}
}
TclNsDecrRefCount(nsPtr);
}
int
TclNamespaceDeleted(
Namespace *nsPtr)
{
return (nsPtr->flags & NS_DYING) ? 1 : 0;
}
void
TclDeleteNamespaceChildren(
Namespace *nsPtr /* Namespace whose children to delete */
)
{
Interp *iPtr = (Interp *) nsPtr->interp;
Tcl_HashEntry *entryPtr;
int i, unchecked;
Tcl_HashSearch search;
/*
* Delete all the child namespaces.
*
* BE CAREFUL: When each child is deleted, it divorces itself from its
* parent. The hash table can't be proplery traversed if its elements are
* being deleted. Because of traces (and the desire to avoid the
* quadratic problems of just using Tcl_FirstHashEntry over and over, [Bug
* f97d4ee020]) copy to a temporary array and then delete all those
* namespaces.
*
* Important: leave the hash table itself still live.
*/
#ifndef BREAK_NAMESPACE_COMPAT
unchecked = (nsPtr->childTable.numEntries > 0);
while (nsPtr->childTable.numEntries > 0 && unchecked) {
int length = nsPtr->childTable.numEntries;
Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr,
sizeof(Namespace *) * length);
i = 0;
for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
entryPtr != NULL;
entryPtr = Tcl_NextHashEntry(&search)) {
children[i] = (Namespace *)Tcl_GetHashValue(entryPtr);
children[i]->refCount++;
i++;
}
unchecked = 0;
for (i = 0 ; i < length ; i++) {
if (!(children[i]->flags & NS_DYING)) {
unchecked = 1;
Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
TclNsDecrRefCount(children[i]);
}
}
TclStackFree((Tcl_Interp *) iPtr, children);
}
#else
if (nsPtr->childTablePtr != NULL) {
unchecked = (nsPtr->childTable.numEntries > 0);
while (nsPtr->childTable.numEntries > 0 && unchecked) {
int length = nsPtr->childTablePtr->numEntries;
Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr,
sizeof(Namespace *) * length);
i = 0;
for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
entryPtr != NULL;
entryPtr = Tcl_NextHashEntry(&search)) {
children[i] = (Namespace *)Tcl_GetHashValue(entryPtr);
children[i]->refCount++;
i++;
}
unchecked = 0;
for (i = 0 ; i < length ; i++) {
if (!(children[i]->flags & NS_DYING)) {
unchecked = 1;
Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
TclNsDecrRefCount(children[i]);
}
}
TclStackFree((Tcl_Interp *) iPtr, children);
}
}
#endif
}
/*
*----------------------------------------------------------------------
*
* TclTeardownNamespace --
*
* Used internally to dismantle and unlink a namespace when it is
|
| ︙ | ︙ | |||
1177 1178 1179 1180 1181 1182 1183 |
}
nsPathPtr->nsPtr = NULL;
nsPathPtr = nsPathPtr->nextPtr;
} while (nsPathPtr != NULL);
nsPtr->commandPathSourceList = NULL;
}
| < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 |
}
nsPathPtr->nsPtr = NULL;
nsPathPtr = nsPathPtr->nextPtr;
} while (nsPathPtr != NULL);
nsPtr->commandPathSourceList = NULL;
}
TclDeleteNamespaceChildren(nsPtr);
/*
* Free the namespace's export pattern array.
*/
if (nsPtr->exportArrayPtr != NULL) {
for (i = 0; i < nsPtr->numExportPatterns; i++) {
|
| ︙ | ︙ | |||
2614 2615 2616 2617 2618 2619 2620 |
Namespace *pathNsPtr, *realNsPtr, *dummyNsPtr;
(void) TclGetNamespaceForQualName(interp, name, cxtNsPtr,
TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
&simpleName);
if ((realNsPtr != NULL) && (simpleName != NULL)) {
if ((cxtNsPtr == realNsPtr)
| | | | | | 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 |
Namespace *pathNsPtr, *realNsPtr, *dummyNsPtr;
(void) TclGetNamespaceForQualName(interp, name, cxtNsPtr,
TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
&simpleName);
if ((realNsPtr != NULL) && (simpleName != NULL)) {
if ((cxtNsPtr == realNsPtr)
|| !(realNsPtr->flags & NS_DEAD)) {
entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
if (entryPtr != NULL) {
cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);
}
}
}
/*
* Next, check along the path.
*/
for (i=0 ; (cmdPtr == NULL) && i<cxtNsPtr->commandPathLength ; i++) {
pathNsPtr = cxtNsPtr->commandPathArray[i].nsPtr;
if (pathNsPtr == NULL) {
continue;
}
(void) TclGetNamespaceForQualName(interp, name, pathNsPtr,
TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
&simpleName);
if ((realNsPtr != NULL) && (simpleName != NULL)
&& !(realNsPtr->flags & NS_DEAD)) {
entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
if (entryPtr != NULL) {
cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);
}
}
}
/*
* If we've still not found the command, look in the global namespace
* as a last resort.
*/
if (cmdPtr == NULL) {
(void) TclGetNamespaceForQualName(interp, name, NULL,
TCL_GLOBAL_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
&simpleName);
if ((realNsPtr != NULL) && (simpleName != NULL)
&& !(realNsPtr->flags & NS_DEAD)) {
entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
if (entryPtr != NULL) {
cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);
}
}
}
} else {
|
| ︙ | ︙ | |||
2901 2902 2903 2904 2905 2906 2907 |
Tcl_Interp *interp, /* The current interpreter. */
Tcl_Obj *objPtr, /* The object to be resolved as the name of a
* namespace. */
Tcl_Namespace **nsPtrPtr) /* Result namespace pointer goes here. */
{
ResolvedNsName *resNamePtr;
| | | | | 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 |
Tcl_Interp *interp, /* The current interpreter. */
Tcl_Obj *objPtr, /* The object to be resolved as the name of a
* namespace. */
Tcl_Namespace **nsPtrPtr) /* Result namespace pointer goes here. */
{
ResolvedNsName *resNamePtr;
NsNameGetInternalRep(objPtr, resNamePtr);
if (resNamePtr) {
Namespace *nsPtr, *refNsPtr;
/*
* Check that the ResolvedNsName is still valid; avoid letting the ref
* cross interps.
*/
nsPtr = resNamePtr->nsPtr;
refNsPtr = resNamePtr->refNsPtr;
if (!(nsPtr->flags & NS_DYING) && (interp == nsPtr->interp)
&& (!refNsPtr || (refNsPtr ==
(Namespace *) TclGetCurrentNamespace(interp)))) {
*nsPtrPtr = (Tcl_Namespace *) nsPtr;
return TCL_OK;
}
Tcl_StoreInternalRep(objPtr, &nsNameType, NULL);
}
if (SetNsNameFromAny(interp, objPtr) == TCL_OK) {
NsNameGetInternalRep(objPtr, resNamePtr);
assert(resNamePtr != NULL);
*nsPtrPtr = (Tcl_Namespace *) resNamePtr->nsPtr;
return TCL_OK;
}
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
3273 3274 3275 3276 3277 3278 3279 |
* command line are valid, and report any errors.
*/
for (i = 1; i < objc; i++) {
name = TclGetString(objv[i]);
namespacePtr = Tcl_FindNamespace(interp, name, NULL, /*flags*/ 0);
if ((namespacePtr == NULL)
| | | 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 |
* command line are valid, and report any errors.
*/
for (i = 1; i < objc; i++) {
name = TclGetString(objv[i]);
namespacePtr = Tcl_FindNamespace(interp, name, NULL, /*flags*/ 0);
if ((namespacePtr == NULL)
|| (((Namespace *) namespacePtr)->flags & NS_TEARDOWN)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"unknown namespace \"%s\" in namespace delete command",
TclGetString(objv[i])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE",
TclGetString(objv[i]), NULL);
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
4695 4696 4697 4698 4699 4700 4701 |
static void
FreeNsNameInternalRep(
Tcl_Obj *objPtr) /* nsName object with internal representation
* to free. */
{
ResolvedNsName *resNamePtr;
| | | 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731 4732 |
static void
FreeNsNameInternalRep(
Tcl_Obj *objPtr) /* nsName object with internal representation
* to free. */
{
ResolvedNsName *resNamePtr;
NsNameGetInternalRep(objPtr, resNamePtr);
assert(resNamePtr != NULL);
/*
* Decrement the reference count of the namespace. If there are no more
* references, free it up.
*/
|
| ︙ | ︙ | |||
4741 4742 4743 4744 4745 4746 4747 |
static void
DupNsNameInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
ResolvedNsName *resNamePtr;
| | | | 4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 |
static void
DupNsNameInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
ResolvedNsName *resNamePtr;
NsNameGetInternalRep(srcPtr, resNamePtr);
assert(resNamePtr != NULL);
NsNameSetInternalRep(copyPtr, resNamePtr);
}
/*
*----------------------------------------------------------------------
*
* SetNsNameFromAny --
*
|
| ︙ | ︙ | |||
4806 4807 4808 4809 4810 4811 4812 |
resNamePtr->nsPtr = nsPtr;
if ((name[0] == ':') && (name[1] == ':')) {
resNamePtr->refNsPtr = NULL;
} else {
resNamePtr->refNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
}
resNamePtr->refCount = 0;
| | | 4829 4830 4831 4832 4833 4834 4835 4836 4837 4838 4839 4840 4841 4842 4843 |
resNamePtr->nsPtr = nsPtr;
if ((name[0] == ':') && (name[1] == ':')) {
resNamePtr->refNsPtr = NULL;
} else {
resNamePtr->refNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
}
resNamePtr->refCount = 0;
NsNameSetInternalRep(objPtr, resNamePtr);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclGetNamespaceCommandTable --
|
| ︙ | ︙ | |||
4894 4895 4896 4897 4898 4899 4900 |
void
TclLogCommandInfo(
Tcl_Interp *interp, /* Interpreter in which to log information. */
const char *script, /* First character in script containing
* command (must be <= command). */
const char *command, /* First character in command that generated
* the error. */
| | | > | 4917 4918 4919 4920 4921 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 |
void
TclLogCommandInfo(
Tcl_Interp *interp, /* Interpreter in which to log information. */
const char *script, /* First character in script containing
* command (must be <= command). */
const char *command, /* First character in command that generated
* the error. */
int length, /* Number of bytes in command (TCL_INDEX_NONE
* means use all bytes up to first null byte).
*/
const unsigned char *pc, /* Current pc of bytecode execution context */
Tcl_Obj **tosPtr) /* Current stack of bytecode execution
* context */
{
const char *p;
Interp *iPtr = (Interp *) interp;
int overflow, limit = 150;
|
| ︙ | ︙ | |||
4982 4983 4984 4985 4986 4987 4988 |
Tcl_IncrRefCount(newObj);
iPtr->errorStack = newObj;
}
if (iPtr->resetErrorStack) {
int len;
iPtr->resetErrorStack = 0;
| | | | 5006 5007 5008 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 |
Tcl_IncrRefCount(newObj);
iPtr->errorStack = newObj;
}
if (iPtr->resetErrorStack) {
int len;
iPtr->resetErrorStack = 0;
TclListObjLength(interp, iPtr->errorStack, &len);
/*
* Reset while keeping the list internalrep as much as possible.
*/
Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL);
if (pc != NULL) {
Tcl_Obj *innerContext;
innerContext = TclGetInnerContext(interp, pc, tosPtr);
|
| ︙ | ︙ | |||
5067 5068 5069 5070 5071 5072 5073 |
Tcl_IncrRefCount(newObj);
iPtr->errorStack = newObj;
}
if (iPtr->resetErrorStack) {
int len;
iPtr->resetErrorStack = 0;
| | | | 5091 5092 5093 5094 5095 5096 5097 5098 5099 5100 5101 5102 5103 5104 5105 5106 5107 5108 |
Tcl_IncrRefCount(newObj);
iPtr->errorStack = newObj;
}
if (iPtr->resetErrorStack) {
int len;
iPtr->resetErrorStack = 0;
TclListObjLength(interp, iPtr->errorStack, &len);
/*
* Reset while keeping the list internalrep as much as possible.
*/
Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL);
Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->innerLiteral);
Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
Tcl_NewStringObj(msg, length));
}
|
| ︙ | ︙ |
Changes to generic/tclNotify.c.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | /* * tclNotify.c -- * * This file implements the generic portion of the Tcl notifier. The * notifier is lowest-level part of the event system. It manages an event * queue that holds Tcl_Event structures. The platform specific portion * of the notifier is defined in the tcl*Notify.c files in each platform * directory. * * Copyright © 1995-1997 Sun Microsystems, Inc. * Copyright © 1998 Scriptics Corporation. * Copyright © 2003 Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* | > | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 |
/*
* tclNotify.c --
*
* This file implements the generic portion of the Tcl notifier. The
* notifier is lowest-level part of the event system. It manages an event
* queue that holds Tcl_Event structures. The platform specific portion
* of the notifier is defined in the tcl*Notify.c files in each platform
* directory.
*
* Copyright © 1995-1997 Sun Microsystems, Inc.
* Copyright © 1998 Scriptics Corporation.
* Copyright © 2003 Kevin B. Kenny. All rights reserved.
* Copyright © 2021 Donal K. Fellows
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
/*
* Notifier hooks that are checked in the public wrappers for the default
* notifier functions (for overriding via Tcl_SetNotifier).
*/
static Tcl_NotifierProcs tclNotifierHooks = {
NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL
};
/*
* For each event source (created with Tcl_CreateEventSource) there is a
* structure of the following type:
*/
|
| ︙ | ︙ | |||
170 171 172 173 174 175 176 |
TclFinalizeNotifier(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
ThreadSpecificData **prevPtrPtr;
Tcl_Event *evPtr, *hold;
if (!tsdPtr->initialized) {
| | > | 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 |
TclFinalizeNotifier(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
ThreadSpecificData **prevPtrPtr;
Tcl_Event *evPtr, *hold;
if (!tsdPtr->initialized) {
return; /* Notifier not initialized for the current
* thread. */
}
Tcl_MutexLock(&(tsdPtr->queueMutex));
for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL; ) {
hold = evPtr;
evPtr = evPtr->nextPtr;
ckfree(hold);
|
| ︙ | ︙ | |||
220 221 222 223 224 225 226 | * notifier functions. * *---------------------------------------------------------------------- */ void Tcl_SetNotifier( | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
* notifier functions.
*
*----------------------------------------------------------------------
*/
void
Tcl_SetNotifier(
const Tcl_NotifierProcs *notifierProcPtr)
{
tclNotifierHooks = *notifierProcPtr;
/*
* Don't allow hooks to refer to the hook point functions; avoids infinite
* loop.
*/
if (tclNotifierHooks.setTimerProc == Tcl_SetTimer) {
tclNotifierHooks.setTimerProc = NULL;
}
if (tclNotifierHooks.waitForEventProc == Tcl_WaitForEvent) {
tclNotifierHooks.waitForEventProc = NULL;
}
if (tclNotifierHooks.initNotifierProc == Tcl_InitNotifier) {
tclNotifierHooks.initNotifierProc = NULL;
}
if (tclNotifierHooks.finalizeNotifierProc == Tcl_FinalizeNotifier) {
tclNotifierHooks.finalizeNotifierProc = NULL;
}
if (tclNotifierHooks.alertNotifierProc == Tcl_AlertNotifier) {
tclNotifierHooks.alertNotifierProc = NULL;
}
if (tclNotifierHooks.serviceModeHookProc == Tcl_ServiceModeHook) {
tclNotifierHooks.serviceModeHookProc = NULL;
}
#ifndef _WIN32
if (tclNotifierHooks.createFileHandlerProc == Tcl_CreateFileHandler) {
tclNotifierHooks.createFileHandlerProc = NULL;
}
if (tclNotifierHooks.deleteFileHandlerProc == Tcl_DeleteFileHandler) {
tclNotifierHooks.deleteFileHandlerProc = NULL;
}
#endif /* !_WIN32 */
}
/*
*----------------------------------------------------------------------
*
* Tcl_CreateEventSource --
*
|
| ︙ | ︙ | |||
272 273 274 275 276 277 278 |
Tcl_EventCheckProc *checkProc,
/* Function to call after waiting to see what
* happened. */
ClientData clientData) /* One-word argument to pass to setupProc and
* checkProc. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
| | | 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 |
Tcl_EventCheckProc *checkProc,
/* Function to call after waiting to see what
* happened. */
ClientData clientData) /* One-word argument to pass to setupProc and
* checkProc. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
EventSource *sourcePtr = (EventSource *) ckalloc(sizeof(EventSource));
sourcePtr->setupProc = setupProc;
sourcePtr->checkProc = checkProc;
sourcePtr->clientData = clientData;
sourcePtr->nextPtr = tsdPtr->firstEventSourcePtr;
tsdPtr->firstEventSourcePtr = sourcePtr;
}
|
| ︙ | ︙ | |||
790 791 792 793 794 795 796 | * May reduce the length of the next sleep in the tsdPtr-> * *---------------------------------------------------------------------- */ void Tcl_SetMaxBlockTime( | | | 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 |
* May reduce the length of the next sleep in the tsdPtr->
*
*----------------------------------------------------------------------
*/
void
Tcl_SetMaxBlockTime(
const Tcl_Time *timePtr) /* Specifies a maximum elapsed time for the
* next blocking operation in the event
* tsdPtr-> */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!tsdPtr->blockTimeSet || (timePtr->sec < tsdPtr->blockTime.sec)
|| ((timePtr->sec == tsdPtr->blockTime.sec)
|
| ︙ | ︙ | |||
1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 |
Tcl_AlertNotifier(tsdPtr->clientData);
break;
}
}
Tcl_MutexUnlock(&listLock);
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 |
Tcl_AlertNotifier(tsdPtr->clientData);
break;
}
}
Tcl_MutexUnlock(&listLock);
}
/*
*----------------------------------------------------------------------
*
* Tcl_InitNotifier --
*
* Initializes the platform specific notifier state. Forwards to the
* platform implementation when the hook is not enabled.
*
* Results:
* Returns a handle to the notifier state for this thread..
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
ClientData
Tcl_InitNotifier(void)
{
if (tclNotifierHooks.initNotifierProc) {
return tclNotifierHooks.initNotifierProc();
} else {
return TclpInitNotifier();
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_FinalizeNotifier --
*
* This function is called to cleanup the notifier state before a thread
* is terminated. Forwards to the platform implementation when the hook
* is not enabled.
*
* Results:
* None.
*
* Side effects:
* If no finalizeNotifierProc notifier hook exists, TclpFinalizeNotifier
* is called.
*
*----------------------------------------------------------------------
*/
void
Tcl_FinalizeNotifier(
ClientData clientData)
{
if (tclNotifierHooks.finalizeNotifierProc) {
tclNotifierHooks.finalizeNotifierProc(clientData);
} else {
TclpFinalizeNotifier(clientData);
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_AlertNotifier --
*
* Wake up the specified notifier from any thread. This routine is called
* by the platform independent notifier code whenever the Tcl_ThreadAlert
* routine is called. This routine is guaranteed not to be called by Tcl
* on a given notifier after Tcl_FinalizeNotifier is called for that
* notifier. This routine is typically called from a thread other than
* the notifier's thread. Forwards to the platform implementation when
* the hook is not enabled.
*
* Results:
* None.
*
* Side effects:
* See the platform-specific implementations.
*
*----------------------------------------------------------------------
*/
void
Tcl_AlertNotifier(
ClientData clientData) /* Pointer to thread data. */
{
if (tclNotifierHooks.alertNotifierProc) {
tclNotifierHooks.alertNotifierProc(clientData);
} else {
TclpAlertNotifier(clientData);
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_ServiceModeHook --
*
* This function is invoked whenever the service mode changes. Forwards
* to the platform implementation when the hook is not enabled.
*
* Results:
* None.
*
* Side effects:
* See the platform-specific implementations.
*
*----------------------------------------------------------------------
*/
void
Tcl_ServiceModeHook(
int mode) /* Either TCL_SERVICE_ALL, or
* TCL_SERVICE_NONE. */
{
if (tclNotifierHooks.serviceModeHookProc) {
tclNotifierHooks.serviceModeHookProc(mode);
} else {
TclpServiceModeHook(mode);
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_SetTimer --
*
* This function sets the current notifier timer value. Forwards to the
* platform implementation when the hook is not enabled.
*
* Results:
* None.
*
* Side effects:
* See the platform-specific implementations.
*
*----------------------------------------------------------------------
*/
void
Tcl_SetTimer(
const Tcl_Time *timePtr) /* Timeout value, may be NULL. */
{
if (tclNotifierHooks.setTimerProc) {
tclNotifierHooks.setTimerProc(timePtr);
} else {
TclpSetTimer(timePtr);
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_WaitForEvent --
*
* This function is called by Tcl_DoOneEvent to wait for new events on
* the notifier's message queue. If the block time is 0, then
* Tcl_WaitForEvent just polls without blocking. Forwards to the
* platform implementation when the hook is not enabled.
*
* Results:
* Returns -1 if the wait would block forever, 1 if an out-of-loop source
* was processed (see platform-specific notes) and otherwise returns 0.
*
* Side effects:
* Queues file events that are detected by the notifier.
*
*----------------------------------------------------------------------
*/
int
Tcl_WaitForEvent(
const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
{
if (tclNotifierHooks.waitForEventProc) {
return tclNotifierHooks.waitForEventProc(timePtr);
} else {
return TclpWaitForEvent(timePtr);
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_CreateFileHandler --
*
* This function registers a file descriptor handler with the notifier.
* Forwards to the platform implementation when the hook is not enabled.
*
* This function is not defined on Windows. The OS API there is too
* different.
*
* Results:
* None.
*
* Side effects:
* Creates a new file handler structure.
*
*----------------------------------------------------------------------
*/
#ifndef _WIN32
void
Tcl_CreateFileHandler(
int fd, /* Handle of stream to watch. */
int mask, /* OR'ed combination of TCL_READABLE,
* TCL_WRITABLE, and TCL_EXCEPTION: indicates
* conditions under which proc should be
* called. */
Tcl_FileProc *proc, /* Function to call for each selected
* event. */
ClientData clientData) /* Arbitrary data to pass to proc. */
{
if (tclNotifierHooks.createFileHandlerProc) {
tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData);
} else {
TclpCreateFileHandler(fd, mask, proc, clientData);
}
}
#endif /* !_WIN32 */
/*
*----------------------------------------------------------------------
*
* Tcl_DeleteFileHandler --
*
* Cancel a previously-arranged callback arrangement for a file
* descriptor. Forwards to the platform implementation when the hook is
* not enabled.
*
* This function is not defined on Windows. The OS API there is too
* different.
*
* Results:
* None.
*
* Side effects:
* If a callback was previously registered on the file descriptor, remove
* it.
*
*----------------------------------------------------------------------
*/
#ifndef _WIN32
void
Tcl_DeleteFileHandler(
int fd) /* Stream id for which to remove callback
* function. */
{
if (tclNotifierHooks.deleteFileHandlerProc) {
tclNotifierHooks.deleteFileHandlerProc(fd);
} else {
TclpDeleteFileHandler(fd);
}
}
#endif /* !_WIN32 */
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Changes to generic/tclOO.c.
| ︙ | ︙ | |||
3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 |
void
Tcl_ObjectSetMethodNameMapper(
Tcl_Object object,
Tcl_ObjectMapMethodNameProc *mapMethodNameProc)
{
((Object *) object)->mapMethodNameProc = mapMethodNameProc;
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
| > > > > > > > > > > > > > > > > > > > > | 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 |
void
Tcl_ObjectSetMethodNameMapper(
Tcl_Object object,
Tcl_ObjectMapMethodNameProc *mapMethodNameProc)
{
((Object *) object)->mapMethodNameProc = mapMethodNameProc;
}
Tcl_Class
Tcl_GetClassOfObject(
Tcl_Object object)
{
return (Tcl_Class) ((Object *) object)->selfCls;
}
Tcl_Obj *
Tcl_GetObjectClassName(
Tcl_Interp *interp,
Tcl_Object object)
{
Tcl_Object classObj = (Tcl_Object) (((Object *) object)->selfCls)->thisPtr;
if (classObj == NULL) {
return NULL;
}
return Tcl_GetObjectName(interp, classObj);
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
|
| ︙ | ︙ |
Changes to generic/tclOO.decls.
| ︙ | ︙ | |||
125 126 127 128 129 130 131 132 133 134 135 136 137 138 |
}
declare 28 {
Tcl_Obj *Tcl_GetObjectName(Tcl_Interp *interp, Tcl_Object object)
}
declare 29 {
int Tcl_MethodIsPrivate(Tcl_Method method)
}
######################################################################
# Private API, exposed to support advanced OO systems that plug in on top of
# TclOO; not intended for general use and does not have any commitment to
# long-term support.
#
| > > > > > > | 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 |
}
declare 28 {
Tcl_Obj *Tcl_GetObjectName(Tcl_Interp *interp, Tcl_Object object)
}
declare 29 {
int Tcl_MethodIsPrivate(Tcl_Method method)
}
declare 30 {
Tcl_Class Tcl_GetClassOfObject(Tcl_Object object)
}
declare 31 {
Tcl_Obj *Tcl_GetObjectClassName(Tcl_Interp *interp, Tcl_Object object)
}
######################################################################
# Private API, exposed to support advanced OO systems that plug in on top of
# TclOO; not intended for general use and does not have any commitment to
# long-term support.
#
|
| ︙ | ︙ |
Changes to generic/tclOOCall.c.
| ︙ | ︙ | |||
243 244 245 246 247 248 249 |
*/
static inline void
StashCallChain(
Tcl_Obj *objPtr,
CallChain *callPtr)
{
| | | | 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 |
*/
static inline void
StashCallChain(
Tcl_Obj *objPtr,
CallChain *callPtr)
{
Tcl_ObjInternalRep ir;
callPtr->refCount++;
TclGetString(objPtr);
ir.twoPtrValue.ptr1 = callPtr;
Tcl_StoreInternalRep(objPtr, &methodNameType, &ir);
}
void
TclOOStashContext(
Tcl_Obj *objPtr,
CallContext *contextPtr)
{
|
| ︙ | ︙ | |||
276 277 278 279 280 281 282 |
static void
DupMethodNameRep(
Tcl_Obj *srcPtr,
Tcl_Obj *dstPtr)
{
StashCallChain(dstPtr,
| | | | 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 |
static void
DupMethodNameRep(
Tcl_Obj *srcPtr,
Tcl_Obj *dstPtr)
{
StashCallChain(dstPtr,
(CallChain *)TclFetchInternalRep(srcPtr, &methodNameType)->twoPtrValue.ptr1);
}
static void
FreeMethodNameRep(
Tcl_Obj *objPtr)
{
TclOODeleteChain(
(CallChain *)TclFetchInternalRep(objPtr, &methodNameType)->twoPtrValue.ptr1);
}
/*
* ----------------------------------------------------------------------
*
* TclOOInvokeContext --
*
|
| ︙ | ︙ | |||
1185 1186 1187 1188 1189 1190 1191 | /* * Check if we can get the chain out of the Tcl_Obj method name or out * of the cache. This is made a bit more complex by the fact that * there are multiple different layers of cache (in the Tcl_Obj, in * the object, and in the class). */ | | | | | 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 |
/*
* Check if we can get the chain out of the Tcl_Obj method name or out
* of the cache. This is made a bit more complex by the fact that
* there are multiple different layers of cache (in the Tcl_Obj, in
* the object, and in the class).
*/
const Tcl_ObjInternalRep *irPtr;
const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);
if ((irPtr = TclFetchInternalRep(cacheInThisObj, &methodNameType))) {
callPtr = (CallChain *)irPtr->twoPtrValue.ptr1;
if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
callPtr->refCount++;
goto returnContext;
}
Tcl_StoreInternalRep(cacheInThisObj, &methodNameType, NULL);
}
if (oPtr->flags & USE_CLASS_CACHE) {
if (oPtr->selfCls->classChainCache != NULL) {
hPtr = Tcl_FindHashEntry(oPtr->selfCls->classChainCache,
(char *) methodNameObj);
} else {
|
| ︙ | ︙ |
Changes to generic/tclOODecls.h.
| ︙ | ︙ | |||
114 115 116 117 118 119 120 121 122 123 124 125 126 127 |
TCLAPI void Tcl_ClassSetDestructor(Tcl_Interp *interp,
Tcl_Class clazz, Tcl_Method method);
/* 28 */
TCLAPI Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp,
Tcl_Object object);
/* 29 */
TCLAPI int Tcl_MethodIsPrivate(Tcl_Method method);
typedef struct {
const struct TclOOIntStubs *tclOOIntStubs;
} TclOOStubHooks;
typedef struct TclOOStubs {
int magic;
| > > > > > | 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 |
TCLAPI void Tcl_ClassSetDestructor(Tcl_Interp *interp,
Tcl_Class clazz, Tcl_Method method);
/* 28 */
TCLAPI Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp,
Tcl_Object object);
/* 29 */
TCLAPI int Tcl_MethodIsPrivate(Tcl_Method method);
/* 30 */
TCLAPI Tcl_Class Tcl_GetClassOfObject(Tcl_Object object);
/* 31 */
TCLAPI Tcl_Obj * Tcl_GetObjectClassName(Tcl_Interp *interp,
Tcl_Object object);
typedef struct {
const struct TclOOIntStubs *tclOOIntStubs;
} TclOOStubHooks;
typedef struct TclOOStubs {
int magic;
|
| ︙ | ︙ | |||
153 154 155 156 157 158 159 160 161 162 163 164 165 166 |
int (*tcl_ObjectContextInvokeNext) (Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); /* 23 */
Tcl_ObjectMapMethodNameProc * (*tcl_ObjectGetMethodNameMapper) (Tcl_Object object); /* 24 */
void (*tcl_ObjectSetMethodNameMapper) (Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 25 */
void (*tcl_ClassSetConstructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 26 */
void (*tcl_ClassSetDestructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */
Tcl_Obj * (*tcl_GetObjectName) (Tcl_Interp *interp, Tcl_Object object); /* 28 */
int (*tcl_MethodIsPrivate) (Tcl_Method method); /* 29 */
} TclOOStubs;
extern const TclOOStubs *tclOOStubsPtr;
#ifdef __cplusplus
}
#endif
| > > | 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 |
int (*tcl_ObjectContextInvokeNext) (Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); /* 23 */
Tcl_ObjectMapMethodNameProc * (*tcl_ObjectGetMethodNameMapper) (Tcl_Object object); /* 24 */
void (*tcl_ObjectSetMethodNameMapper) (Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 25 */
void (*tcl_ClassSetConstructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 26 */
void (*tcl_ClassSetDestructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */
Tcl_Obj * (*tcl_GetObjectName) (Tcl_Interp *interp, Tcl_Object object); /* 28 */
int (*tcl_MethodIsPrivate) (Tcl_Method method); /* 29 */
Tcl_Class (*tcl_GetClassOfObject) (Tcl_Object object); /* 30 */
Tcl_Obj * (*tcl_GetObjectClassName) (Tcl_Interp *interp, Tcl_Object object); /* 31 */
} TclOOStubs;
extern const TclOOStubs *tclOOStubsPtr;
#ifdef __cplusplus
}
#endif
|
| ︙ | ︙ | |||
227 228 229 230 231 232 233 234 235 236 237 238 239 | (tclOOStubsPtr->tcl_ClassSetConstructor) /* 26 */ #define Tcl_ClassSetDestructor \ (tclOOStubsPtr->tcl_ClassSetDestructor) /* 27 */ #define Tcl_GetObjectName \ (tclOOStubsPtr->tcl_GetObjectName) /* 28 */ #define Tcl_MethodIsPrivate \ (tclOOStubsPtr->tcl_MethodIsPrivate) /* 29 */ #endif /* defined(USE_TCLOO_STUBS) */ /* !END!: Do not edit above this line. */ #endif /* _TCLOODECLS */ | > > > > | 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 | (tclOOStubsPtr->tcl_ClassSetConstructor) /* 26 */ #define Tcl_ClassSetDestructor \ (tclOOStubsPtr->tcl_ClassSetDestructor) /* 27 */ #define Tcl_GetObjectName \ (tclOOStubsPtr->tcl_GetObjectName) /* 28 */ #define Tcl_MethodIsPrivate \ (tclOOStubsPtr->tcl_MethodIsPrivate) /* 29 */ #define Tcl_GetClassOfObject \ (tclOOStubsPtr->tcl_GetClassOfObject) /* 30 */ #define Tcl_GetObjectClassName \ (tclOOStubsPtr->tcl_GetObjectClassName) /* 31 */ #endif /* defined(USE_TCLOO_STUBS) */ /* !END!: Do not edit above this line. */ #endif /* _TCLOODECLS */ |
Changes to generic/tclOODefineCmds.c.
| ︙ | ︙ | |||
1061 1062 1063 1064 1065 1066 1067 |
Tcl_AppendObjToObj(obj2Ptr, objv[cmdIndex]);
} else {
Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
}
Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
/* TODO: overflow? */
Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc - offset, objv + offset);
| | | 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 |
Tcl_AppendObjToObj(obj2Ptr, objv[cmdIndex]);
} else {
Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
}
Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
/* TODO: overflow? */
Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc - offset, objv + offset);
TclListObjGetElements(NULL, objPtr, &dummy, &objs);
result = Tcl_EvalObjv(interp, objc - cmdIndex, objs, TCL_EVAL_INVOKE);
if (isRoot) {
TclResetRewriteEnsemble(interp, 1);
}
Tcl_DecrRefCount(objPtr);
|
| ︙ | ︙ | |||
1998 1999 2000 2001 2002 2003 2004 |
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
if (objc == 5) {
if (Tcl_GetIndexFromObj(interp, objv[2], exportModes, "export flag",
| | | 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 |
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
if (objc == 5) {
if (Tcl_GetIndexFromObj(interp, objv[2], exportModes, "export flag",
0, &exportMode) != TCL_OK) {
return TCL_ERROR;
}
switch (exportMode) {
case MODE_EXPORT:
isPublic = PUBLIC_METHOD;
break;
case MODE_PRIVATE:
|
| ︙ | ︙ | |||
2368 2369 2370 2371 2372 2373 2374 |
if (oPtr == NULL) {
return TCL_ERROR;
} else if (!oPtr->classPtr) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
| | | 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 |
if (oPtr == NULL) {
return TCL_ERROR;
} else if (!oPtr->classPtr) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
} else if (TclListObjGetElements(interp, objv[0], &filterc,
&filterv) != TCL_OK) {
return TCL_ERROR;
}
TclOOClassSetFilters(interp, oPtr->classPtr, filterc, filterv);
return TCL_OK;
}
|
| ︙ | ︙ | |||
2452 2453 2454 2455 2456 2457 2458 |
if (oPtr == NULL) {
return TCL_ERROR;
} else if (!oPtr->classPtr) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
| | | 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 |
if (oPtr == NULL) {
return TCL_ERROR;
} else if (!oPtr->classPtr) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
} else if (TclListObjGetElements(interp, objv[0], &mixinc,
&mixinv) != TCL_OK) {
return TCL_ERROR;
}
mixins = (Class **)TclStackAlloc(interp, sizeof(Class *) * mixinc);
for (i = 0; i < mixinc; i++) {
|
| ︙ | ︙ | |||
2562 2563 2564 2565 2566 2567 2568 |
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
} else if (oPtr == oPtr->fPtr->objectCls->thisPtr) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"may not modify the superclass of the root object", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
| | | 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 |
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
} else if (oPtr == oPtr->fPtr->objectCls->thisPtr) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"may not modify the superclass of the root object", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
} else if (TclListObjGetElements(interp, objv[0], &superc,
&superv) != TCL_OK) {
return TCL_ERROR;
}
/*
* Allocate some working space.
*/
|
| ︙ | ︙ | |||
2732 2733 2734 2735 2736 2737 2738 |
if (oPtr == NULL) {
return TCL_ERROR;
} else if (!oPtr->classPtr) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
| | | 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 |
if (oPtr == NULL) {
return TCL_ERROR;
} else if (!oPtr->classPtr) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
} else if (TclListObjGetElements(interp, objv[0], &varc,
&varv) != TCL_OK) {
return TCL_ERROR;
}
for (i = 0; i < varc; i++) {
const char *varName = TclGetString(varv[i]);
|
| ︙ | ︙ | |||
2824 2825 2826 2827 2828 2829 2830 |
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
"filterList");
return TCL_ERROR;
} else if (oPtr == NULL) {
return TCL_ERROR;
}
objv += Tcl_ObjectContextSkippedArgs(context);
| | | 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 |
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
"filterList");
return TCL_ERROR;
} else if (oPtr == NULL) {
return TCL_ERROR;
}
objv += Tcl_ObjectContextSkippedArgs(context);
if (TclListObjGetElements(interp, objv[0], &filterc,
&filterv) != TCL_OK) {
return TCL_ERROR;
}
TclOOObjectSetFilters(oPtr, filterc, filterv);
return TCL_OK;
}
|
| ︙ | ︙ | |||
2898 2899 2900 2901 2902 2903 2904 |
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
"mixinList");
return TCL_ERROR;
} else if (oPtr == NULL) {
return TCL_ERROR;
}
objv += Tcl_ObjectContextSkippedArgs(context);
| | | 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 |
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
"mixinList");
return TCL_ERROR;
} else if (oPtr == NULL) {
return TCL_ERROR;
}
objv += Tcl_ObjectContextSkippedArgs(context);
if (TclListObjGetElements(interp, objv[0], &mixinc,
&mixinv) != TCL_OK) {
return TCL_ERROR;
}
mixins = (Class **)TclStackAlloc(interp, sizeof(Class *) * mixinc);
for (i = 0; i < mixinc; i++) {
|
| ︙ | ︙ | |||
2988 2989 2990 2991 2992 2993 2994 |
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
"variableList");
return TCL_ERROR;
} else if (oPtr == NULL) {
return TCL_ERROR;
}
objv += Tcl_ObjectContextSkippedArgs(context);
| | | 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 |
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
"variableList");
return TCL_ERROR;
} else if (oPtr == NULL) {
return TCL_ERROR;
}
objv += Tcl_ObjectContextSkippedArgs(context);
if (TclListObjGetElements(interp, objv[0], &varc,
&varv) != TCL_OK) {
return TCL_ERROR;
}
for (i = 0; i < varc; i++) {
const char *varName = TclGetString(varv[i]);
|
| ︙ | ︙ |
Changes to generic/tclOOInt.h.
| ︙ | ︙ | |||
627 628 629 630 631 632 633 |
* memory management of objects.
* REQUIRES DECLARATION: int i;
*/
#define FOREACH(var,ary) \
for(i=0 ; i<(ary).num; i++) if ((ary).list[i] == NULL) { \
continue; \
| | | 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 |
* memory management of objects.
* REQUIRES DECLARATION: int i;
*/
#define FOREACH(var,ary) \
for(i=0 ; i<(ary).num; i++) if ((ary).list[i] == NULL) { \
continue; \
} else if ((var) = (ary).list[i], 1)
/*
* A variation where the array is an array of structs. There's no issue with
* possible NULLs; every element of the array will be iterated over and the
* varable set to a pointer to each of those elements in turn.
* REQUIRES DECLARATION: int i;
*/
|
| ︙ | ︙ |
Changes to generic/tclOOMethod.c.
| ︙ | ︙ | |||
335 336 337 338 339 340 341 |
* structure's contents. NULL if caller is not
* interested. */
{
int argsLen;
ProcedureMethod *pmPtr;
Tcl_Method method;
| | | 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 |
* structure's contents. NULL if caller is not
* interested. */
{
int argsLen;
ProcedureMethod *pmPtr;
Tcl_Method method;
if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
return NULL;
}
pmPtr = (ProcedureMethod *)ckalloc(sizeof(ProcedureMethod));
memset(pmPtr, 0, sizeof(ProcedureMethod));
pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION;
pmPtr->flags = flags & USE_DECLARER_NS;
pmPtr->refCount = 1;
|
| ︙ | ︙ | |||
393 394 395 396 397 398 399 |
Tcl_Method method;
if (argsObj == NULL) {
argsLen = -1;
TclNewObj(argsObj);
Tcl_IncrRefCount(argsObj);
procName = "<destructor>";
| | | 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 |
Tcl_Method method;
if (argsObj == NULL) {
argsLen = -1;
TclNewObj(argsObj);
Tcl_IncrRefCount(argsObj);
procName = "<destructor>";
} else if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
return NULL;
} else {
procName = (nameObj==NULL ? "<constructor>" : TclGetString(nameObj));
}
pmPtr = (ProcedureMethod *)ckalloc(sizeof(ProcedureMethod));
memset(pmPtr, 0, sizeof(ProcedureMethod));
|
| ︙ | ︙ | |||
855 856 857 858 859 860 861 |
/*
* [Bug 2037727] Always call TclProcCompileProc so that we check not only
* that we have bytecode, but also that it remains valid. Note that we set
* the namespace of the code here directly; this is a hack, but the
* alternative is *so* slow...
*/
| | | 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 |
/*
* [Bug 2037727] Always call TclProcCompileProc so that we check not only
* that we have bytecode, but also that it remains valid. Note that we set
* the namespace of the code here directly; this is a hack, but the
* alternative is *so* slow...
*/
ByteCodeGetInternalRep(pmPtr->procPtr->bodyPtr, &tclByteCodeType, codePtr);
if (codePtr) {
codePtr->nsPtr = nsPtr;
}
result = TclProcCompileProc(interp, pmPtr->procPtr,
pmPtr->procPtr->bodyPtr, nsPtr, "body of method", namePtr);
if (result != TCL_OK) {
goto failureReturn;
|
| ︙ | ︙ | |||
1334 1335 1336 1337 1338 1339 1340 |
/*
* Must strip the internal representation in order to ensure that any
* bound references to instance variables are removed. [Bug 3609693]
*/
bodyObj = Tcl_DuplicateObj(pmPtr->procPtr->bodyPtr);
Tcl_GetString(bodyObj);
| | | 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 |
/*
* Must strip the internal representation in order to ensure that any
* bound references to instance variables are removed. [Bug 3609693]
*/
bodyObj = Tcl_DuplicateObj(pmPtr->procPtr->bodyPtr);
Tcl_GetString(bodyObj);
Tcl_StoreInternalRep(pmPtr->procPtr->bodyPtr, &tclByteCodeType, NULL);
/*
* Create the actual copy of the method record, manufacturing a new proc
* record.
*/
pm2Ptr = (ProcedureMethod *)ckalloc(sizeof(ProcedureMethod));
|
| ︙ | ︙ | |||
1385 1386 1387 1388 1389 1390 1391 |
Tcl_Obj *nameObj, /* The name of the method. */
Tcl_Obj *prefixObj) /* List of arguments that form the command
* prefix to forward to. */
{
int prefixLen;
ForwardMethod *fmPtr;
| | | 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 |
Tcl_Obj *nameObj, /* The name of the method. */
Tcl_Obj *prefixObj) /* List of arguments that form the command
* prefix to forward to. */
{
int prefixLen;
ForwardMethod *fmPtr;
if (TclListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
return NULL;
}
if (prefixLen < 1) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"method forward prefix must be non-empty", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
return NULL;
|
| ︙ | ︙ | |||
1424 1425 1426 1427 1428 1429 1430 |
Tcl_Obj *nameObj, /* The name of the method. */
Tcl_Obj *prefixObj) /* List of arguments that form the command
* prefix to forward to. */
{
int prefixLen;
ForwardMethod *fmPtr;
| | | 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 |
Tcl_Obj *nameObj, /* The name of the method. */
Tcl_Obj *prefixObj) /* List of arguments that form the command
* prefix to forward to. */
{
int prefixLen;
ForwardMethod *fmPtr;
if (TclListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
return NULL;
}
if (prefixLen < 1) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"method forward prefix must be non-empty", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
return NULL;
|
| ︙ | ︙ | |||
1472 1473 1474 1475 1476 1477 1478 |
/*
* Build the real list of arguments to use. Note that we know that the
* prefixObj field of the ForwardMethod structure holds a reference to a
* non-empty list, so there's a whole class of failures ("not a list") we
* can ignore here.
*/
| | | 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 |
/*
* Build the real list of arguments to use. Note that we know that the
* prefixObj field of the ForwardMethod structure holds a reference to a
* non-empty list, so there's a whole class of failures ("not a list") we
* can ignore here.
*/
TclListObjGetElements(NULL, fmPtr->prefixObj, &numPrefixes, &prefixObjs);
argObjs = InitEnsembleRewrite(interp, objc, objv, skip,
numPrefixes, prefixObjs, &len);
Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL);
/*
* NOTE: The combination of direct set of iPtr->lookupNsPtr and the use
* of the TCL_EVAL_NOERR flag results in an evaluation configuration
* very much like TCL_EVAL_INVOKE.
|
| ︙ | ︙ |
Changes to generic/tclOOStubInit.c.
| ︙ | ︙ | |||
70 71 72 73 74 75 76 77 78 79 |
Tcl_ObjectContextInvokeNext, /* 23 */
Tcl_ObjectGetMethodNameMapper, /* 24 */
Tcl_ObjectSetMethodNameMapper, /* 25 */
Tcl_ClassSetConstructor, /* 26 */
Tcl_ClassSetDestructor, /* 27 */
Tcl_GetObjectName, /* 28 */
Tcl_MethodIsPrivate, /* 29 */
};
/* !END!: Do not edit above this line. */
| > > | 70 71 72 73 74 75 76 77 78 79 80 81 |
Tcl_ObjectContextInvokeNext, /* 23 */
Tcl_ObjectGetMethodNameMapper, /* 24 */
Tcl_ObjectSetMethodNameMapper, /* 25 */
Tcl_ClassSetConstructor, /* 26 */
Tcl_ClassSetDestructor, /* 27 */
Tcl_GetObjectName, /* 28 */
Tcl_MethodIsPrivate, /* 29 */
Tcl_GetClassOfObject, /* 30 */
Tcl_GetObjectClassName, /* 31 */
};
/* !END!: Do not edit above this line. */
|
Changes to generic/tclObj.c.
| ︙ | ︙ | |||
563 564 565 566 567 568 569 |
int num,
int *loc)
{
int newEntry;
ThreadSpecificData *tsdPtr = TclGetContLineTable();
Tcl_HashEntry *hPtr =
Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
| | | 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 |
int num,
int *loc)
{
int newEntry;
ThreadSpecificData *tsdPtr = TclGetContLineTable();
Tcl_HashEntry *hPtr =
Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
ContLineLoc *clLocPtr = (ContLineLoc *)ckalloc(offsetof(ContLineLoc, loc) + (num + 1U) *sizeof(int));
if (!newEntry) {
/*
* We're entering ContLineLoc data for the same value more than one
* time. Taking care not to leak the old entry.
*
* This can happen when literals in a proc body are shared. See for
|
| ︙ | ︙ | |||
1369 1370 1371 1372 1373 1374 1375 |
TclIncrObjsFreed();
ObjDeletionLock(context);
while (ObjOnStack(context)) {
Tcl_Obj *objToFree;
PopObjToDelete(context, objToFree);
TCL_DTRACE_OBJ_FREE(objToFree);
| | | 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 |
TclIncrObjsFreed();
ObjDeletionLock(context);
while (ObjOnStack(context)) {
Tcl_Obj *objToFree;
PopObjToDelete(context, objToFree);
TCL_DTRACE_OBJ_FREE(objToFree);
TclFreeInternalRep(objToFree);
Tcl_MutexLock(&tclObjMutex);
ckfree(objToFree);
Tcl_MutexUnlock(&tclObjMutex);
TclIncrObjsFreed();
}
ObjDeletionUnlock(context);
|
| ︙ | ︙ | |||
1588 1589 1590 1591 1592 1593 1594 |
Tcl_Obj *dupPtr,
Tcl_Obj *objPtr)
{
if (Tcl_IsShared(dupPtr)) {
Tcl_Panic("%s called with shared object", "TclSetDuplicateObj");
}
TclInvalidateStringRep(dupPtr);
| | | 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 |
Tcl_Obj *dupPtr,
Tcl_Obj *objPtr)
{
if (Tcl_IsShared(dupPtr)) {
Tcl_Panic("%s called with shared object", "TclSetDuplicateObj");
}
TclInvalidateStringRep(dupPtr);
TclFreeInternalRep(dupPtr);
SetDuplicateObj(dupPtr, objPtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetString --
|
| ︙ | ︙ | |||
1811 1812 1813 1814 1815 1816 1817 |
{
assert(objPtr->bytes == NULL || bytes == NULL);
if (numBytes > INT_MAX) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
| < < < > | > > > | < < > | < | > > > > > > > > > > > > > | > > > < > | | | > | > | | < < > | 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 |
{
assert(objPtr->bytes == NULL || bytes == NULL);
if (numBytes > INT_MAX) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
if (objPtr->bytes == NULL) {
/* Start with no string rep */
if (numBytes == 0) {
TclInitStringRep(objPtr, NULL, 0);
return objPtr->bytes;
} else {
objPtr->bytes = (char *)attemptckalloc(numBytes + 1);
if (objPtr->bytes) {
objPtr->length = (int) numBytes;
if (bytes) {
memcpy(objPtr->bytes, bytes, numBytes);
}
objPtr->bytes[objPtr->length] = '\0';
}
}
} else if (objPtr->bytes == &tclEmptyString) {
/* Start with empty string rep (not allocated) */
if (numBytes == 0) {
return objPtr->bytes;
} else {
objPtr->bytes = (char *)attemptckalloc(numBytes + 1);
if (objPtr->bytes) {
objPtr->length = (int) numBytes;
objPtr->bytes[objPtr->length] = '\0';
}
}
} else {
/* Start with non-empty string rep (allocated) */
if (numBytes == 0) {
ckfree(objPtr->bytes);
TclInitStringRep(objPtr, NULL, 0);
return objPtr->bytes;
} else {
objPtr->bytes = (char *)attemptckrealloc(objPtr->bytes,
numBytes + 1);
if (objPtr->bytes) {
objPtr->length = (int) numBytes;
objPtr->bytes[objPtr->length] = '\0';
}
}
}
return objPtr->bytes;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
1888 1889 1890 1891 1892 1893 1894 |
{
return TclHasStringRep(objPtr);
}
/*
*----------------------------------------------------------------------
*
| | | | | | | | | | | | | | | | | | 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 |
{
return TclHasStringRep(objPtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_StoreInternalRep --
*
* This function is called to set the object's internal
* representation to match a particular type.
*
* It is the caller's responsibility to guarantee that
* the value of the submitted internalrep is in agreement with
* the value of any existing string rep.
*
* Results:
* None.
*
* Side effects:
* Calls the freeIntRepProc of the current Tcl_ObjType, if any.
* Sets the internalRep and typePtr fields to the submitted values.
*
*----------------------------------------------------------------------
*/
void
Tcl_StoreInternalRep(
Tcl_Obj *objPtr, /* Object whose internal rep should be set. */
const Tcl_ObjType *typePtr, /* New type for the object */
const Tcl_ObjInternalRep *irPtr) /* New internalrep for the object */
{
/* Clear out any existing internalrep ( "shimmer" ) */
TclFreeInternalRep(objPtr);
/* When irPtr == NULL, just leave objPtr with no internalrep for typePtr */
if (irPtr) {
/* Copy the new internalrep into place */
objPtr->internalRep = *irPtr;
/* Set the type to match */
objPtr->typePtr = typePtr;
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_FetchInternalRep --
*
* This function is called to retrieve the object's internal
* representation matching a requested type, if any.
*
* Results:
* A read-only pointer to the associated Tcl_ObjInternalRep, or
* NULL if no such internal representation exists.
*
* Side effects:
* Calls the freeIntRepProc of the current Tcl_ObjType, if any.
* Sets the internalRep and typePtr fields to the submitted values.
*
*----------------------------------------------------------------------
*/
Tcl_ObjInternalRep *
Tcl_FetchInternalRep(
Tcl_Obj *objPtr, /* Object to fetch from. */
const Tcl_ObjType *typePtr) /* Requested type */
{
return TclFetchInternalRep(objPtr, typePtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_FreeInternalRep --
*
* This function is called to free an object's internal representation.
*
* Results:
* None.
*
* Side effects:
* Calls the freeIntRepProc of the current Tcl_ObjType, if any.
* Sets typePtr field to NULL.
*
*----------------------------------------------------------------------
*/
void
Tcl_FreeInternalRep(
Tcl_Obj *objPtr) /* Object whose internal rep should be freed. */
{
TclFreeInternalRep(objPtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_NewBooleanObj --
*
|
| ︙ | ︙ | |||
2130 2131 2132 2133 2134 2135 2136 | * * Results: * The return value is a standard Tcl object result. If an error occurs * during conversion, an error message is left in the interpreter's * result unless "interp" is NULL. * * Side effects: | | | 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 |
*
* Results:
* The return value is a standard Tcl object result. If an error occurs
* during conversion, an error message is left in the interpreter's
* result unless "interp" is NULL.
*
* Side effects:
* The internalrep of *objPtr may be changed.
*
*----------------------------------------------------------------------
*/
int
Tcl_GetBooleanFromObj(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
|
| ︙ | ︙ | |||
2153 2154 2155 2156 2157 2158 2159 |
if (objPtr->typePtr == &tclBooleanType) {
*boolPtr = objPtr->internalRep.longValue != 0;
return TCL_OK;
}
if (objPtr->typePtr == &tclDoubleType) {
/*
* Caution: Don't be tempted to check directly for the "double"
| | | 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 |
if (objPtr->typePtr == &tclBooleanType) {
*boolPtr = objPtr->internalRep.longValue != 0;
return TCL_OK;
}
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;
|
| ︙ | ︙ | |||
2353 2354 2355 2356 2357 2358 2359 |
/*
* Free the old internalRep before setting the new one. We do this as late
* as possible to allow the conversion code, in particular
* Tcl_GetStringFromObj, to use that old internalRep.
*/
goodBoolean:
| | | | 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 |
/*
* Free the old internalRep before setting the new one. We do this as late
* as possible to allow the conversion code, in particular
* Tcl_GetStringFromObj, to use that old internalRep.
*/
goodBoolean:
TclFreeInternalRep(objPtr);
objPtr->internalRep.longValue = newBool;
objPtr->typePtr = &tclBooleanType;
return TCL_OK;
numericBoolean:
TclFreeInternalRep(objPtr);
objPtr->internalRep.wideValue = newBool;
objPtr->typePtr = &tclIntType;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
2527 2528 2529 2530 2531 2532 2533 |
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) {
| | | 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 |
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",
NULL);
}
return TCL_ERROR;
|
| ︙ | ︙ | |||
3034 3035 3036 3037 3038 3039 3040 |
* the internal rep.
*/
Tcl_WideInt w = objPtr->internalRep.wideValue;
if (w >= (Tcl_WideInt)(LONG_MIN)
&& w <= (Tcl_WideInt)(ULONG_MAX)) {
| | | 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 |
* 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) {
|
| ︙ | ︙ | |||
3070 3071 3072 3073 3074 3075 3076 |
TclUnpackBignum(objPtr, big);
if (mp_to_ubin(&big, bytes, sizeof(long), &numBytes) == MP_OKAY) {
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
}
if (big.sign) {
if (value <= 1 + (unsigned long)LONG_MAX) {
| | | | 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 |
TclUnpackBignum(objPtr, big);
if (mp_to_ubin(&big, bytes, sizeof(long), &numBytes) == MP_OKAY) {
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
}
if (big.sign) {
if (value <= 1 + (unsigned long)LONG_MAX) {
*longPtr = (long)(-value);
return TCL_OK;
}
} else {
if (value <= (unsigned long)ULONG_MAX) {
*longPtr = (long)value;
return TCL_OK;
}
}
}
}
#ifndef TCL_WIDE_INT_IS_LONG
tooLarge:
|
| ︙ | ︙ | |||
3309 3310 3311 3312 3313 3314 3315 |
TclUnpackBignum(objPtr, big);
if (mp_to_ubin(&big, bytes, sizeof(Tcl_WideInt), &numBytes) == MP_OKAY) {
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
}
if (big.sign) {
if (value <= 1 + ~(Tcl_WideUInt)WIDE_MIN) {
| | | | 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 |
TclUnpackBignum(objPtr, big);
if (mp_to_ubin(&big, bytes, sizeof(Tcl_WideInt), &numBytes) == MP_OKAY) {
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
}
if (big.sign) {
if (value <= 1 + ~(Tcl_WideUInt)WIDE_MIN) {
*wideIntPtr = (Tcl_WideInt)(-value);
return TCL_OK;
}
} else {
if (value <= (Tcl_WideUInt)WIDE_MAX) {
*wideIntPtr = (Tcl_WideInt)value;
return TCL_OK;
}
}
}
if (interp != NULL) {
const char *s = "integer value too large to represent";
Tcl_Obj *msg = Tcl_NewStringObj(s, -1);
|
| ︙ | ︙ | |||
3513 3514 3515 3516 3517 3518 3519 |
stringVal = Tcl_InitStringRep(objPtr, NULL, size - 1);
TclOOM(stringVal, size);
if (MP_OKAY != mp_to_radix(&bignumVal, stringVal, size, NULL, 10)) {
Tcl_Panic("conversion failure in UpdateStringOfBignum");
}
| < | 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 |
stringVal = Tcl_InitStringRep(objPtr, NULL, size - 1);
TclOOM(stringVal, size);
if (MP_OKAY != mp_to_radix(&bignumVal, stringVal, size, NULL, 10)) {
Tcl_Panic("conversion failure in UpdateStringOfBignum");
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_NewBignumObj --
*
|
| ︙ | ︙ | |||
3635 3636 3637 3638 3639 3640 3641 |
TclUnpackBignum(objPtr, temp);
if (mp_init_copy(bignumValue, &temp) != MP_OKAY) {
return TCL_ERROR;
}
} else {
TclUnpackBignum(objPtr, *bignumValue);
| | | 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 |
TclUnpackBignum(objPtr, temp);
if (mp_init_copy(bignumValue, &temp) != MP_OKAY) {
return TCL_ERROR;
}
} else {
TclUnpackBignum(objPtr, *bignumValue);
/* Optimized TclFreeInternalRep */
objPtr->internalRep.twoPtrValue.ptr1 = NULL;
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = NULL;
/*
* TODO: If objPtr has a string rep, this leaves
* it undisturbed. Not clear that's proper. Pure
* bignum values are converted to empty string.
|
| ︙ | ︙ | |||
3781 3782 3783 3784 3785 3786 3787 |
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
}
if (value > ((Tcl_WideUInt)WIDE_MAX + bignumValue->sign)) {
goto tooLargeForWide;
}
if (bignumValue->sign) {
| | | | | | | 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 |
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
}
if (value > ((Tcl_WideUInt)WIDE_MAX + bignumValue->sign)) {
goto tooLargeForWide;
}
if (bignumValue->sign) {
TclSetIntObj(objPtr, (Tcl_WideInt)(-value));
} else {
TclSetIntObj(objPtr, (Tcl_WideInt)value);
}
mp_clear(bignumValue);
return;
tooLargeForWide:
TclInvalidateStringRep(objPtr);
TclFreeInternalRep(objPtr);
TclSetBignumInternalRep(objPtr, bignumValue);
}
/*
*----------------------------------------------------------------------
*
* TclSetBignumInternalRep --
*
* Install a bignum into the internal representation of an object.
*
* Results:
* None.
*
* Side effects:
* Object internal representation is updated and object type is set. The
* bignum value is cleared, since ownership has transferred to the
* object.
*
*----------------------------------------------------------------------
*/
void
TclSetBignumInternalRep(
Tcl_Obj *objPtr,
void *big)
{
mp_int *bignumValue = (mp_int *)big;
objPtr->typePtr = &tclBignumType;
PACK_BIGNUM(*bignumValue, objPtr);
|
| ︙ | ︙ | |||
3861 3862 3863 3864 3865 3866 3867 |
Tcl_Interp *interp,
Tcl_Obj *objPtr,
ClientData *clientDataPtr,
int *typePtr)
{
do {
if (objPtr->typePtr == &tclDoubleType) {
| | | 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 |
Tcl_Interp *interp,
Tcl_Obj *objPtr,
ClientData *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;
}
|
| ︙ | ︙ | |||
4550 4551 4552 4553 4554 4555 4556 |
fillPtr->refNsPtr = currNsPtr;
fillPtr->refNsId = currNsPtr->nsId;
fillPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
}
if (resPtr == NULL) {
| | | 4565 4566 4567 4568 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 |
fillPtr->refNsPtr = currNsPtr;
fillPtr->refNsId = currNsPtr->nsId;
fillPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
}
if (resPtr == NULL) {
TclFreeInternalRep(objPtr);
objPtr->internalRep.twoPtrValue.ptr1 = fillPtr;
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = &tclCmdNameType;
}
}
|
| ︙ | ︙ |
Changes to generic/tclPanic.c.
| ︙ | ︙ | |||
41 42 43 44 45 46 47 | * * Side effects: * Sets the panicProc variable. * *---------------------------------------------------------------------- */ | > | | | 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 |
*
* Side effects:
* Sets the panicProc variable.
*
*----------------------------------------------------------------------
*/
#undef Tcl_SetPanicProc
const char *
Tcl_SetPanicProc(
TCL_NORETURN1 Tcl_PanicProc *proc)
{
#if defined(_WIN32)
/* tclWinDebugPanic only installs if there is no panicProc yet. */
if (((Tcl_PanicProc *)proc != tclWinDebugPanic) || (panicProc == NULL))
#elif defined(__CYGWIN__)
if (proc == NULL)
panicProc = tclWinDebugPanic;
else
#endif
panicProc = proc;
return Tcl_InitSubsystems();
}
/*
*----------------------------------------------------------------------
*
* Tcl_PanicVA --
*
|
| ︙ | ︙ |
Changes to generic/tclPathObj.c.
| ︙ | ︙ | |||
81 82 83 84 85 86 87 | #define TCLPATH_NEEDNORM 4 /* * Define some macros to give us convenient access to path-object specific * fields. */ | | | | | 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 |
#define TCLPATH_NEEDNORM 4
/*
* Define some macros to give us convenient access to path-object specific
* fields.
*/
#define PATHOBJ(pathPtr) ((FsPath *) (TclFetchInternalRep((pathPtr), &fsPathType)->twoPtrValue.ptr1))
#define SETPATHOBJ(pathPtr,fsPathPtr) \
do { \
Tcl_ObjInternalRep ir; \
ir.twoPtrValue.ptr1 = (void *) (fsPathPtr); \
ir.twoPtrValue.ptr2 = NULL; \
Tcl_StoreInternalRep((pathPtr), &fsPathType, &ir); \
} while (0)
#define PATHFLAGS(pathPtr) (PATHOBJ(pathPtr)->flags)
/*
*---------------------------------------------------------------------------
*
* TclFSNormalizeAbsolutePath --
|
| ︙ | ︙ | |||
540 541 542 543 544 545 546 |
Tcl_Obj *
TclPathPart(
Tcl_Interp *interp, /* Used for error reporting */
Tcl_Obj *pathPtr, /* Path to take dirname of */
Tcl_PathPart portion) /* Requested portion of name */
{
| | | 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 |
Tcl_Obj *
TclPathPart(
Tcl_Interp *interp, /* Used for error reporting */
Tcl_Obj *pathPtr, /* Path to take dirname of */
Tcl_PathPart portion) /* Requested portion of name */
{
if (TclHasInternalRep(pathPtr, &fsPathType)) {
FsPath *fsPathPtr = PATHOBJ(pathPtr);
if (PATHFLAGS(pathPtr) != 0) {
switch (portion) {
case TCL_PATH_DIRNAME: {
/*
* Check if the joined-on bit has any directory delimiters in
|
| ︙ | ︙ | |||
808 809 810 811 812 813 814 |
* reference count. */
int elements) /* Number of elements to use (-1 = all) */
{
Tcl_Obj *res;
int objc;
Tcl_Obj **objv;
| | | > | | | 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 |
* reference count. */
int elements) /* Number of elements to use (-1 = all) */
{
Tcl_Obj *res;
int objc;
Tcl_Obj **objv;
if (TclListObjLength(NULL, listObj, &objc) != TCL_OK) {
return NULL;
}
elements = ((elements >= 0) && (elements <= objc)) ? elements : objc;
TclListObjGetElements(NULL, listObj, &objc, &objv);
res = TclJoinPath(elements, objv, 0);
return res;
}
Tcl_Obj *
TclJoinPath(
int elements, /* Number of elements to use (-1 = all) */
Tcl_Obj * const objv[], /* Path elements to join */
int forceRelative) /* If non-zero, assume all more paths are
* relative (e. g. simple normalization) */
{
Tcl_Obj *res = NULL;
int i;
const Tcl_Filesystem *fsPtr = NULL;
assert ( elements >= 0 );
if (elements == 0) {
TclNewObj(res);
return res;
}
assert ( elements > 0 );
if (elements == 2) {
Tcl_Obj *elt = objv[0];
Tcl_ObjInternalRep *eltIr = TclFetchInternalRep(elt, &fsPathType);
/*
* This is a special case where we can be much more efficient, where
* we are joining a single relative path onto an object that is
* already of path type. The 'TclNewFSPathObj' call below creates an
* object which can be normalized more efficiently. Currently we only
* use the special case when we have exactly two elements, but we
|
| ︙ | ︙ | |||
1145 1146 1147 1148 1149 1150 1151 |
* converting this object to FsPath type for the first time, we don't need
* to worry whether the 'cwd' has changed. On the other hand, if this
* object is already of FsPath type, and is a relative path, we do have to
* worry about the cwd. If the cwd has changed, we must recompute the
* path.
*/
| | | | 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 |
* converting this object to FsPath type for the first time, we don't need
* to worry whether the 'cwd' has changed. On the other hand, if this
* object is already of FsPath type, and is a relative path, we do have to
* worry about the cwd. If the cwd has changed, we must recompute the
* path.
*/
if (TclHasInternalRep(pathPtr, &fsPathType)) {
if (TclFSEpochOk(PATHOBJ(pathPtr)->filesystemEpoch)) {
return TCL_OK;
}
TclGetString(pathPtr);
Tcl_StoreInternalRep(pathPtr, &fsPathType, NULL);
}
return SetFsPathFromAny(interp, pathPtr);
}
/*
* Helper function for normalization.
|
| ︙ | ︙ | |||
1345 1346 1347 1348 1349 1350 1351 |
Tcl_Obj *copy = Tcl_DuplicateObj(head);
/*
* This is likely buggy when dealing with virtual filesystem drivers
* that use some character other than "/" as a path separator. I know
* of no evidence that such a foolish thing exists. This solution was
* chosen so that "JoinPath" operations that pass through either path
| | | 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 |
Tcl_Obj *copy = Tcl_DuplicateObj(head);
/*
* This is likely buggy when dealing with virtual filesystem drivers
* that use some character other than "/" as a path separator. I know
* of no evidence that such a foolish thing exists. This solution was
* chosen so that "JoinPath" operations that pass through either path
* internalrep produce the same results; that is, bugward compatibility. If
* we need to fix that bug here, it needs fixing in TclJoinPath() too.
*/
bytes = TclGetStringFromObj(tail, &numBytes);
if (numBytes == 0) {
Tcl_AppendToObj(copy, "/", 1);
} else {
TclpNativeJoinPath(copy, bytes);
|
| ︙ | ︙ | |||
1387 1388 1389 1390 1391 1392 1393 |
TclFSMakePathRelative(
TCL_UNUSED(Tcl_Interp *),
Tcl_Obj *pathPtr, /* The path we have. */
Tcl_Obj *cwdPtr) /* Make it relative to this. */
{
int cwdLen, len;
const char *tempStr;
| | | 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 |
TclFSMakePathRelative(
TCL_UNUSED(Tcl_Interp *),
Tcl_Obj *pathPtr, /* The path we have. */
Tcl_Obj *cwdPtr) /* Make it relative to this. */
{
int cwdLen, len;
const char *tempStr;
Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(pathPtr, &fsPathType);
if (irPtr) {
FsPath *fsPathPtr = PATHOBJ(pathPtr);
if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) {
return fsPathPtr->normPathPtr;
}
|
| ︙ | ︙ | |||
1457 1458 1459 1460 1461 1462 1463 |
static int
MakePathFromNormalized(
TCL_UNUSED(Tcl_Interp *),
Tcl_Obj *pathPtr) /* The object to convert. */
{
FsPath *fsPathPtr;
| | | 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 |
static int
MakePathFromNormalized(
TCL_UNUSED(Tcl_Interp *),
Tcl_Obj *pathPtr) /* The object to convert. */
{
FsPath *fsPathPtr;
if (TclHasInternalRep(pathPtr, &fsPathType)) {
return TCL_OK;
}
fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath));
/*
* It's a pure normalized absolute path.
|
| ︙ | ︙ | |||
1528 1529 1530 1531 1532 1533 1534 |
}
/*
* Free old representation; shouldn't normally be any, but best to be
* safe.
*/
| | | 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 |
}
/*
* Free old representation; shouldn't normally be any, but best to be
* safe.
*/
Tcl_StoreInternalRep(pathPtr, &fsPathType, NULL);
fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath));
fsPathPtr->translatedPathPtr = NULL;
Tcl_IncrRefCount(fsPathPtr->normPathPtr = Tcl_DuplicateObj(pathPtr));
fsPathPtr->cwdPtr = NULL;
fsPathPtr->nativePathPtr = clientData;
|
| ︙ | ︙ | |||
1594 1595 1596 1597 1598 1599 1600 | * (cwdPtr) and a tail (normPathPtr), and if we join the * translated version of cwdPtr to normPathPtr, we'll get the * translated result we need, and can store it for future use. */ Tcl_Obj *translatedCwdPtr = Tcl_FSGetTranslatedPath(interp, srcFsPathPtr->cwdPtr); | | | | 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 |
* (cwdPtr) and a tail (normPathPtr), and if we join the
* translated version of cwdPtr to normPathPtr, we'll get the
* translated result we need, and can store it for future use.
*/
Tcl_Obj *translatedCwdPtr = Tcl_FSGetTranslatedPath(interp,
srcFsPathPtr->cwdPtr);
Tcl_ObjInternalRep *translatedCwdIrPtr;
if (translatedCwdPtr == NULL) {
return NULL;
}
retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1,
&srcFsPathPtr->normPathPtr);
Tcl_IncrRefCount(srcFsPathPtr->translatedPathPtr = retObj);
translatedCwdIrPtr = TclFetchInternalRep(translatedCwdPtr, &fsPathType);
if (translatedCwdIrPtr) {
srcFsPathPtr->filesystemEpoch
= PATHOBJ(translatedCwdPtr)->filesystemEpoch;
} else {
srcFsPathPtr->filesystemEpoch = 0;
}
Tcl_DecrRefCount(translatedCwdPtr);
|
| ︙ | ︙ | |||
1798 1799 1800 1801 1802 1803 1804 |
/*
* Ensure cwd hasn't changed.
*/
if (fsPathPtr->cwdPtr != NULL) {
if (!TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) {
TclGetString(pathPtr);
| | | 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 |
/*
* Ensure cwd hasn't changed.
*/
if (fsPathPtr->cwdPtr != NULL) {
if (!TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) {
TclGetString(pathPtr);
Tcl_StoreInternalRep(pathPtr, &fsPathType, NULL);
if (SetFsPathFromAny(interp, pathPtr) != TCL_OK) {
return NULL;
}
fsPathPtr = PATHOBJ(pathPtr);
} else if (fsPathPtr->normPathPtr == NULL) {
int cwdLen;
Tcl_Obj *copy;
|
| ︙ | ︙ | |||
2044 2045 2046 2047 2048 2049 2050 |
int
TclFSEnsureEpochOk(
Tcl_Obj *pathPtr,
const Tcl_Filesystem **fsPtrPtr)
{
FsPath *srcFsPathPtr;
| | | | 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 |
int
TclFSEnsureEpochOk(
Tcl_Obj *pathPtr,
const Tcl_Filesystem **fsPtrPtr)
{
FsPath *srcFsPathPtr;
if (!TclHasInternalRep(pathPtr, &fsPathType)) {
return TCL_OK;
}
srcFsPathPtr = PATHOBJ(pathPtr);
if (!TclFSEpochOk(srcFsPathPtr->filesystemEpoch)) {
/*
* The filesystem has changed in some way since the internal
* representation for this object was calculated. Discard the stale
* representation and recalculate it.
*/
TclGetString(pathPtr);
Tcl_StoreInternalRep(pathPtr, &fsPathType, NULL);
if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) {
return TCL_ERROR;
}
srcFsPathPtr = PATHOBJ(pathPtr);
}
if (srcFsPathPtr->fsPtr != NULL) {
|
| ︙ | ︙ | |||
2102 2103 2104 2105 2106 2107 2108 |
{
FsPath *srcFsPathPtr;
/*
* Make sure pathPtr is of the correct type.
*/
| | | 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 |
{
FsPath *srcFsPathPtr;
/*
* Make sure pathPtr is of the correct type.
*/
if (!TclHasInternalRep(pathPtr, &fsPathType)) {
if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) {
return;
}
}
srcFsPathPtr = PATHOBJ(pathPtr);
srcFsPathPtr->fsPtr = fsPtr;
|
| ︙ | ︙ | |||
2202 2203 2204 2205 2206 2207 2208 |
Tcl_Obj *pathPtr) /* The object to convert. */
{
int len;
FsPath *fsPathPtr;
Tcl_Obj *transPtr;
const char *name;
| | | 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 |
Tcl_Obj *pathPtr) /* The object to convert. */
{
int len;
FsPath *fsPathPtr;
Tcl_Obj *transPtr;
const char *name;
if (TclHasInternalRep(pathPtr, &fsPathType)) {
return TCL_OK;
}
/*
* First step is to translate the filename. This is similar to
* Tcl_TranslateFilename, but shouldn't convert everything to windows
* backslashes on that platform. The current implementation of this piece
|
| ︙ | ︙ | |||
2308 2309 2310 2311 2312 2313 2314 | * beginning with ~ are part of the native filesystem. */ int objc; Tcl_Obj **objv; Tcl_Obj *parts = TclpNativeSplitPath(pathPtr, NULL); | | | 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 |
* beginning with ~ are part of the native filesystem.
*/
int objc;
Tcl_Obj **objv;
Tcl_Obj *parts = TclpNativeSplitPath(pathPtr, NULL);
TclListObjGetElements(NULL, parts, &objc, &objv);
/*
* Skip '~'. It's replaced by its expansion.
*/
objc--; objv++;
while (objc--) {
|
| ︙ | ︙ | |||
2515 2516 2517 2518 2519 2520 2521 |
/*
* A special case is required to handle the empty path "". This is a valid
* path (i.e. the user should be able to do 'file exists ""' without
* throwing an error), but equally the path doesn't exist. Those are the
* semantics of Tcl (at present anyway), so we have to abide by them here.
*/
| | | 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 |
/*
* A special case is required to handle the empty path "". This is a valid
* path (i.e. the user should be able to do 'file exists ""' without
* throwing an error), but equally the path doesn't exist. Those are the
* semantics of Tcl (at present anyway), so we have to abide by them here.
*/
if (TclHasInternalRep(pathPtr, &fsPathType)) {
if (pathPtr->bytes != NULL && pathPtr->bytes[0] == '\0') {
/*
* We reject the empty path "".
*/
return -1;
}
|
| ︙ | ︙ |
Changes to generic/tclPkg.c.
| ︙ | ︙ | |||
1355 1356 1357 1358 1359 1360 1361 | version = NULL; argv3 = TclGetString(objv[3]); Tcl_IncrRefCount(objv[3]); objvListPtr = Tcl_NewListObj(0, NULL); Tcl_IncrRefCount(objvListPtr); Tcl_ListObjAppendElement(interp, objvListPtr, ov); | | | 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 | version = NULL; argv3 = TclGetString(objv[3]); Tcl_IncrRefCount(objv[3]); objvListPtr = Tcl_NewListObj(0, NULL); Tcl_IncrRefCount(objvListPtr); Tcl_ListObjAppendElement(interp, objvListPtr, ov); TclListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr); Tcl_NRAddCallback(interp, TclNRPackageObjCmdCleanup, objv[3], objvListPtr, NULL,NULL); Tcl_NRAddCallback(interp, PkgRequireCore, (void *) argv3, INT2PTR(newobjc), newObjvPtr, NULL); return TCL_OK; |
| ︙ | ︙ | |||
1382 1383 1384 1385 1386 1387 1388 | * Tcl_Obj structures may have come from another interpreter, * so duplicate them. */ Tcl_ListObjAppendElement(interp, objvListPtr, Tcl_DuplicateObj(newobjv[i])); } | | | 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 | * Tcl_Obj structures may have come from another interpreter, * so duplicate them. */ Tcl_ListObjAppendElement(interp, objvListPtr, Tcl_DuplicateObj(newobjv[i])); } TclListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr); Tcl_NRAddCallback(interp, TclNRPackageObjCmdCleanup, objv[2], objvListPtr, NULL,NULL); Tcl_NRAddCallback(interp, PkgRequireCore, (void *) argv2, INT2PTR(newobjc), newObjvPtr, NULL); return TCL_OK; } |
| ︙ | ︙ | |||
1692 1693 1694 1695 1696 1697 1698 |
if (!isdigit(UCHAR(*p))) { /* INTL: digit */
goto error;
}
*ip++ = *p;
| | | 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 |
if (!isdigit(UCHAR(*p))) { /* INTL: digit */
goto error;
}
*ip++ = *p;
for (prevChar = *p, p++; (*p != 0) && (*p != '+'); p++) {
if (!isdigit(UCHAR(*p)) && /* INTL: digit */
((*p!='.' && *p!='a' && *p!='b') ||
((hasunstable && (*p=='a' || *p=='b')) ||
((prevChar=='a' || prevChar=='b' || prevChar=='.')
&& (*p=='.')) ||
((*p=='a' || *p=='b' || *p=='.') && prevChar=='.')))) {
goto error;
|
| ︙ | ︙ | |||
1996 1997 1998 1999 2000 2001 2002 |
* Syntax of requirement = version
* = version-version
* = version-
*/
char *dash = NULL, *buf;
| | | | 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 |
* Syntax of requirement = version
* = version-version
* = version-
*/
char *dash = NULL, *buf;
dash = strchr(string, '+') ? NULL : (char *)strchr(string, '-');
if (dash == NULL) {
/*
* '+' found or no dash found: has to be a simple version.
*/
return CheckVersionAndConvert(interp, string, NULL, NULL);
}
if (strchr(dash+1, '-') != NULL) {
/*
|
| ︙ | ︙ |
Changes to generic/tclPkgConfig.c.
| ︙ | ︙ | |||
89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 |
#ifdef TCL_CFG_PROFILED
# define CFG_PROFILED "1"
#else
# define CFG_PROFILED "0"
#endif
static Tcl_Config const cfg[] = {
{"debug", CFG_DEBUG},
{"threaded", CFG_THREADED},
{"profiled", CFG_PROFILED},
{"64bit", CFG_64},
{"optimized", CFG_OPTIMIZED},
{"mem_debug", CFG_MEMDEBUG},
{"compile_debug", CFG_COMPILE_DEBUG},
{"compile_stats", CFG_COMPILE_STATS},
/* Runtime paths to various stuff */
{"libdir,runtime", CFG_RUNTIME_LIBDIR},
{"bindir,runtime", CFG_RUNTIME_BINDIR},
{"scriptdir,runtime", CFG_RUNTIME_SCRDIR},
{"includedir,runtime", CFG_RUNTIME_INCDIR},
| > > | 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 |
#ifdef TCL_CFG_PROFILED
# define CFG_PROFILED "1"
#else
# define CFG_PROFILED "0"
#endif
static Tcl_Config const cfg[] = {
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
{"debug", CFG_DEBUG},
{"threaded", CFG_THREADED},
{"profiled", CFG_PROFILED},
{"64bit", CFG_64},
{"optimized", CFG_OPTIMIZED},
{"mem_debug", CFG_MEMDEBUG},
{"compile_debug", CFG_COMPILE_DEBUG},
{"compile_stats", CFG_COMPILE_STATS},
#endif
/* Runtime paths to various stuff */
{"libdir,runtime", CFG_RUNTIME_LIBDIR},
{"bindir,runtime", CFG_RUNTIME_BINDIR},
{"scriptdir,runtime", CFG_RUNTIME_SCRDIR},
{"includedir,runtime", CFG_RUNTIME_INCDIR},
|
| ︙ | ︙ |
Changes to generic/tclPlatDecls.h.
| ︙ | ︙ | |||
61 62 63 64 65 66 67 68 69 70 71 72 73 74 | #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ /* 0 */ EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, int len, Tcl_DString *dsPtr); /* 1 */ EXTERN char * Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 0 */ EXTERN int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */ | > > > | 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 | #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ /* 0 */ EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, int len, Tcl_DString *dsPtr); /* 1 */ EXTERN char * Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr); /* Slot 2 is reserved */ /* 3 */ EXTERN void Tcl_WinConvertError(unsigned errCode); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 0 */ EXTERN int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */ |
| ︙ | ︙ | |||
85 86 87 88 89 90 91 92 93 94 95 96 97 98 |
typedef struct TclPlatStubs {
int magic;
void *hooks;
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */
char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */
int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */
void (*tcl_MacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 2 */
#endif /* MACOSX */
} TclPlatStubs;
| > > | 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 |
typedef struct TclPlatStubs {
int magic;
void *hooks;
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */
char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */
void (*reserved2)(void);
void (*tcl_WinConvertError) (unsigned errCode); /* 3 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */
int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */
void (*tcl_MacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 2 */
#endif /* MACOSX */
} TclPlatStubs;
|
| ︙ | ︙ | |||
110 111 112 113 114 115 116 117 118 119 120 121 122 123 | */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ #define Tcl_WinUtfToTChar \ (tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */ #define Tcl_WinTCharToUtf \ (tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ #define Tcl_MacOSXOpenBundleResources \ (tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */ #define Tcl_MacOSXOpenVersionedBundleResources \ (tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */ #define Tcl_MacOSXNotifierAddRunLoopMode \ | > > > | 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 | */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ #define Tcl_WinUtfToTChar \ (tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */ #define Tcl_WinTCharToUtf \ (tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */ /* Slot 2 is reserved */ #define Tcl_WinConvertError \ (tclPlatStubsPtr->tcl_WinConvertError) /* 3 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ #define Tcl_MacOSXOpenBundleResources \ (tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */ #define Tcl_MacOSXOpenVersionedBundleResources \ (tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */ #define Tcl_MacOSXNotifierAddRunLoopMode \ |
| ︙ | ︙ |
Changes to generic/tclPosixStr.c.
| ︙ | ︙ | |||
154 155 156 157 158 159 160 161 162 163 164 165 166 167 |
#endif
#if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS))
case EIDRM: return "EIDRM";
#endif
#ifdef EINIT
case EINIT: return "EINIT";
#endif
#ifdef EINPROGRESS
case EINPROGRESS: return "EINPROGRESS";
#endif
#ifdef EINTR
case EINTR: return "EINTR";
#endif
#ifdef EINVAL
| > > > | 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 |
#endif
#if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS))
case EIDRM: return "EIDRM";
#endif
#ifdef EINIT
case EINIT: return "EINIT";
#endif
#ifdef EILSEQ
case EILSEQ: return "EILSEQ";
#endif
#ifdef EINPROGRESS
case EINPROGRESS: return "EINPROGRESS";
#endif
#ifdef EINTR
case EINTR: return "EINTR";
#endif
#ifdef EINVAL
|
| ︙ | ︙ | |||
613 614 615 616 617 618 619 620 621 622 623 624 625 626 |
#endif
#if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS))
case EIDRM: return "identifier removed";
#endif
#ifdef EINIT
case EINIT: return "initialization error";
#endif
#ifdef EINPROGRESS
case EINPROGRESS: return "operation now in progress";
#endif
#ifdef EINTR
case EINTR: return "interrupted system call";
#endif
#ifdef EINVAL
| > > > | 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 |
#endif
#if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS))
case EIDRM: return "identifier removed";
#endif
#ifdef EINIT
case EINIT: return "initialization error";
#endif
#ifdef EILSEQ
case EILSEQ: return "illegal byte sequence";
#endif
#ifdef EINPROGRESS
case EINPROGRESS: return "operation now in progress";
#endif
#ifdef EINTR
case EINTR: return "interrupted system call";
#endif
#ifdef EINVAL
|
| ︙ | ︙ |
Changes to generic/tclProc.c.
| ︙ | ︙ | |||
63 64 65 66 67 68 69 |
NULL, /* UpdateString function; Tcl_GetString and
* Tcl_GetStringFromObj should panic
* instead. */
NULL /* SetFromAny function; Tcl_ConvertToType
* should panic instead. */
};
| | | | | | | | 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 |
NULL, /* UpdateString function; Tcl_GetString and
* Tcl_GetStringFromObj should panic
* instead. */
NULL /* SetFromAny function; Tcl_ConvertToType
* should panic instead. */
};
#define ProcSetInternalRep(objPtr, procPtr) \
do { \
Tcl_ObjInternalRep ir; \
(procPtr)->refCount++; \
ir.twoPtrValue.ptr1 = (procPtr); \
ir.twoPtrValue.ptr2 = NULL; \
Tcl_StoreInternalRep((objPtr), &tclProcBodyType, &ir); \
} while (0)
#define ProcGetInternalRep(objPtr, procPtr) \
do { \
const Tcl_ObjInternalRep *irPtr; \
irPtr = TclFetchInternalRep((objPtr), &tclProcBodyType); \
(procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \
} while (0)
/*
* The [upvar]/[uplevel] level reference type. Uses the longValue field
* to remember the integer value of a parsed #<integer> format.
*
|
| ︙ | ︙ | |||
109 110 111 112 113 114 115 |
"lambdaExpr", /* name */
FreeLambdaInternalRep, /* freeIntRepProc */
DupLambdaInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
SetLambdaFromAny /* setFromAnyProc */
};
| | | | | | | | 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 |
"lambdaExpr", /* name */
FreeLambdaInternalRep, /* freeIntRepProc */
DupLambdaInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
SetLambdaFromAny /* setFromAnyProc */
};
#define LambdaSetInternalRep(objPtr, procPtr, nsObjPtr) \
do { \
Tcl_ObjInternalRep ir; \
ir.twoPtrValue.ptr1 = (procPtr); \
ir.twoPtrValue.ptr2 = (nsObjPtr); \
Tcl_IncrRefCount((nsObjPtr)); \
Tcl_StoreInternalRep((objPtr), &lambdaType, &ir); \
} while (0)
#define LambdaGetInternalRep(objPtr, procPtr, nsObjPtr) \
do { \
const Tcl_ObjInternalRep *irPtr; \
irPtr = TclFetchInternalRep((objPtr), &lambdaType); \
(procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \
(nsObjPtr) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL; \
} while (0)
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
323 324 325 326 327 328 329 |
* seem to make a lot of sense to verify the number of arguments we
* are about to ignore ...
* - could be enhanced to handle also non-empty bodies that contain only
* comments; however, parsing the body will slow down the compilation
* of all procs whose argument list is just _args_
*/
| | | 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 |
* seem to make a lot of sense to verify the number of arguments we
* are about to ignore ...
* - could be enhanced to handle also non-empty bodies that contain only
* comments; however, parsing the body will slow down the compilation
* of all procs whose argument list is just _args_
*/
if (TclHasInternalRep(objv[3], &tclProcBodyType)) {
goto done;
}
procArgs = TclGetString(objv[2]);
while (*procArgs == ' ') {
procArgs++;
|
| ︙ | ︙ | |||
405 406 407 408 409 410 411 |
Proc *procPtr = NULL;
int i, result, numArgs;
CompiledLocal *localPtr = NULL;
Tcl_Obj **argArray;
int precompiled = 0;
| | | 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 |
Proc *procPtr = NULL;
int i, result, numArgs;
CompiledLocal *localPtr = NULL;
Tcl_Obj **argArray;
int precompiled = 0;
ProcGetInternalRep(bodyPtr, procPtr);
if (procPtr != NULL) {
/*
* Because the body is a TclProProcBody, the actual body is already
* compiled, and it is not shared with anyone else, so it's OK not to
* unshare it (as a matter of fact, it is bad to unshare it, because
* there may be no source code).
*
|
| ︙ | ︙ | |||
480 481 482 483 484 485 486 |
/*
* Break up the argument list into argument specifiers, then process each
* argument specifier. If the body is precompiled, processing is limited
* to checking that the parsed argument is consistent with the one stored
* in the Proc.
*/
| | | 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 |
/*
* Break up the argument list into argument specifiers, then process each
* argument specifier. If the body is precompiled, processing is limited
* to checking that the parsed argument is consistent with the one stored
* in the Proc.
*/
result = TclListObjGetElements(interp , argsPtr ,&numArgs ,&argArray);
if (result != TCL_OK) {
goto procError;
}
if (precompiled) {
if (numArgs > procPtr->numArgs) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
| ︙ | ︙ | |||
510 511 512 513 514 515 516 | int fieldCount, nameLength; Tcl_Obj **fieldValues; /* * Now divide the specifier up into name and default. */ | | | | 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 |
int fieldCount, nameLength;
Tcl_Obj **fieldValues;
/*
* Now divide the specifier up into name and default.
*/
result = TclListObjGetElements(interp, argArray[i], &fieldCount,
&fieldValues);
if (result != TCL_OK) {
goto procError;
}
if (fieldCount > 2) {
Tcl_Obj *errorObj = Tcl_NewStringObj(
"too many fields in argument specifier \"", -1);
Tcl_AppendObjToObj(errorObj, argArray[i]);
Tcl_AppendToObj(errorObj, "\"", -1);
Tcl_SetObjResult(interp, errorObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"FORMALARGUMENTFORMAT", NULL);
goto procError;
}
if ((fieldCount == 0) || (Tcl_GetCharLength(fieldValues[0]) == 0)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"argument with no name", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"FORMALARGUMENTFORMAT", NULL);
goto procError;
}
|
| ︙ | ︙ | |||
629 630 631 632 633 634 635 |
} else {
/*
* Allocate an entry in the runtime procedure frame's array of
* local variables for the argument.
*/
localPtr = (CompiledLocal *)ckalloc(
| | | 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 |
} else {
/*
* Allocate an entry in the runtime procedure frame's array of
* local variables for the argument.
*/
localPtr = (CompiledLocal *)ckalloc(
offsetof(CompiledLocal, name) + 1U + fieldValues[0]->length);
if (procPtr->firstLocalPtr == NULL) {
procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
} else {
procPtr->lastLocalPtr->nextPtr = localPtr;
procPtr->lastLocalPtr = localPtr;
}
localPtr->nextPtr = NULL;
|
| ︙ | ︙ | |||
720 721 722 723 724 725 726 | int result; Tcl_Obj obj; obj.bytes = (char *) name; obj.length = strlen(name); obj.typePtr = NULL; result = TclObjGetFrame(interp, &obj, framePtrPtr); | | | 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 | int result; Tcl_Obj obj; obj.bytes = (char *) name; obj.length = strlen(name); obj.typePtr = NULL; result = TclObjGetFrame(interp, &obj, framePtrPtr); TclFreeInternalRep(&obj); return result; } /* *---------------------------------------------------------------------- * * TclObjGetFrame -- |
| ︙ | ︙ | |||
758 759 760 761 762 763 764 |
Tcl_Interp *interp, /* Interpreter in which to find frame. */
Tcl_Obj *objPtr, /* Object describing frame. */
CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if
* global frame indicated). */
{
Interp *iPtr = (Interp *) interp;
int curLevel, level, result;
| | | 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 |
Tcl_Interp *interp, /* Interpreter in which to find frame. */
Tcl_Obj *objPtr, /* Object describing frame. */
CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if
* global frame indicated). */
{
Interp *iPtr = (Interp *) interp;
int curLevel, level, result;
const Tcl_ObjInternalRep *irPtr;
const char *name = NULL;
Tcl_WideInt w;
/*
* Parse object to figure out which level number to go to.
*/
|
| ︙ | ︙ | |||
784 785 786 787 788 789 790 |
Tcl_GetWideIntFromObj(NULL, objPtr, &w);
if (w < 0 || w > INT_MAX || curLevel > w + INT_MAX) {
result = -1;
} else {
level = curLevel - level;
result = 1;
}
| | | | | 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 |
Tcl_GetWideIntFromObj(NULL, objPtr, &w);
if (w < 0 || w > INT_MAX || curLevel > w + INT_MAX) {
result = -1;
} else {
level = curLevel - level;
result = 1;
}
} else if ((irPtr = TclFetchInternalRep(objPtr, &levelReferenceType))) {
level = irPtr->wideValue;
result = 1;
} else {
name = TclGetString(objPtr);
if (name[0] == '#') {
if (TCL_OK == Tcl_GetInt(NULL, name+1, &level)) {
if (level < 0 || (level > 0 && name[1] == '-')) {
result = -1;
} else {
Tcl_ObjInternalRep ir;
ir.wideValue = level;
Tcl_StoreInternalRep(objPtr, &levelReferenceType, &ir);
result = 1;
}
} else {
result = -1;
}
} else if (TclGetWideBitsFromObj(NULL, objPtr, &w) == TCL_OK) {
/*
|
| ︙ | ︙ | |||
916 917 918 919 920 921 922 |
* argument is interpreted as a level indicator if possible.
*/
uplevelSyntax:
Tcl_WrongNumArgs(interp, 1, objv, "?level? command ?arg ...?");
return TCL_ERROR;
} else if (!TclHasStringRep(objv[1]) && objc == 2) {
int status ,llength;
| | | 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 |
* argument is interpreted as a level indicator if possible.
*/
uplevelSyntax:
Tcl_WrongNumArgs(interp, 1, objv, "?level? command ?arg ...?");
return TCL_ERROR;
} else if (!TclHasStringRep(objv[1]) && objc == 2) {
int status ,llength;
status = TclListObjLength(interp, objv[1], &llength);
if (status == TCL_OK && llength > 1) {
/* the first argument can't interpreted as a level. Avoid
* generating a string representation of the script. */
result = TclGetFrame(interp, "1", &framePtr);
if (result == -1) {
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
1147 1148 1149 1150 1151 1152 1153 |
Namespace *nsPtr) /* Pointer to current namespace. */
{
Var *varPtr = framePtr->compiledLocals;
Tcl_Obj *bodyPtr;
ByteCode *codePtr;
bodyPtr = framePtr->procPtr->bodyPtr;
| | | 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 |
Namespace *nsPtr) /* Pointer to current namespace. */
{
Var *varPtr = framePtr->compiledLocals;
Tcl_Obj *bodyPtr;
ByteCode *codePtr;
bodyPtr = framePtr->procPtr->bodyPtr;
ByteCodeGetInternalRep(bodyPtr, &tclByteCodeType, codePtr);
if (codePtr == NULL) {
Tcl_Panic("body object for proc attached to frame is not a byte code type");
}
if (framePtr->numCompiledLocals) {
if (!codePtr->localCachePtr) {
InitLocalCache(framePtr->procPtr) ;
|
| ︙ | ︙ | |||
1323 1324 1325 1326 1327 1328 1329 |
Tcl_Obj **namePtr;
Var *varPtr;
LocalCache *localCachePtr;
CompiledLocal *localPtr;
int isNew;
| | | 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 |
Tcl_Obj **namePtr;
Var *varPtr;
LocalCache *localCachePtr;
CompiledLocal *localPtr;
int isNew;
ByteCodeGetInternalRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
/*
* Cache the names and initial values of local variables; store the
* cache in both the framePtr for this execution and in the codePtr
* for future calls.
*/
|
| ︙ | ︙ | |||
1396 1397 1398 1399 1400 1401 1402 |
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
Proc *procPtr = framePtr->procPtr;
ByteCode *codePtr;
Var *varPtr, *defPtr;
int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
Tcl_Obj *const *argObjs;
| | | 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 |
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
Proc *procPtr = framePtr->procPtr;
ByteCode *codePtr;
Var *varPtr, *defPtr;
int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
Tcl_Obj *const *argObjs;
ByteCodeGetInternalRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
/*
* Make sure that the local cache of variable names and initial values has
* been initialised properly .
*/
if (localCt) {
|
| ︙ | ︙ | |||
1434 1435 1436 1437 1438 1439 1440 |
* entries in both the Proc structure's local variable list and the call
* frame's local variable array.
*/
numArgs = procPtr->numArgs;
argCt = framePtr->objc - skip; /* Set it to the number of args to the
* procedure. */
| < > | 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 |
* entries in both the Proc structure's local variable list and the call
* frame's local variable array.
*/
numArgs = procPtr->numArgs;
argCt = framePtr->objc - skip; /* Set it to the number of args to the
* procedure. */
if (numArgs == 0) {
if (argCt) {
goto incorrectArgs;
} else {
goto correctArgs;
}
}
argObjs = framePtr->objv + skip;
imax = ((argCt < numArgs-1) ? argCt : numArgs-1);
for (i = 0; i < imax; i++, varPtr++, defPtr ? defPtr++ : defPtr) {
/*
* "Normal" arguments; last formal is special, depends on it being
* 'args'.
*/
|
| ︙ | ︙ | |||
1572 1573 1574 1575 1576 1577 1578 |
* If necessary (i.e. if we haven't got a suitable compilation already
* cached) compile the procedure's body. The compiler will allocate frame
* slots for the procedure's non-argument local variables. Note that
* compiling the body might increase procPtr->numCompiledLocals if new
* local variables are found while compiling.
*/
| | | 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 |
* If necessary (i.e. if we haven't got a suitable compilation already
* cached) compile the procedure's body. The compiler will allocate frame
* slots for the procedure's non-argument local variables. Note that
* compiling the body might increase procPtr->numCompiledLocals if new
* local variables are found while compiling.
*/
ByteCodeGetInternalRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
if (codePtr != NULL) {
Interp *iPtr = (Interp *) interp;
/*
* When we've got bytecode, this is the check for validity. That is,
* the bytecode must be for the right interpreter (no cross-leaks!),
* the code must be from the current epoch (so subcommand compilation
|
| ︙ | ︙ | |||
1782 1783 1784 1785 1786 1787 1788 |
#endif /* USE_DTRACE */
/*
* Invoke the commands in the procedure's body.
*/
procPtr->refCount++;
| | | 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 |
#endif /* USE_DTRACE */
/*
* Invoke the commands in the procedure's body.
*/
procPtr->refCount++;
ByteCodeGetInternalRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
TclNRAddCallback(interp, InterpProcNR2, procNameObj, errorProc,
NULL, NULL);
return TclNRExecuteByteCode(interp, codePtr);
}
static int
|
| ︙ | ︙ | |||
1916 1917 1918 1919 1920 1921 1922 |
const char *description, /* string describing this body of code. */
const char *procName) /* Name of this procedure. */
{
Interp *iPtr = (Interp *) interp;
Tcl_CallFrame *framePtr;
ByteCode *codePtr;
| | | 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 |
const char *description, /* string describing this body of code. */
const char *procName) /* Name of this procedure. */
{
Interp *iPtr = (Interp *) interp;
Tcl_CallFrame *framePtr;
ByteCode *codePtr;
ByteCodeGetInternalRep(bodyPtr, &tclByteCodeType, codePtr);
/*
* If necessary, compile the procedure's body. The compiler will allocate
* frame slots for the procedure's non-argument local variables. If the
* ByteCode already exists, make sure it hasn't been invalidated by
* someone redefining a core command (this might make the compiled code
* wrong). Also, if the code was compiled in/for a different interpreter,
|
| ︙ | ︙ | |||
1951 1952 1953 1954 1955 1956 1957 |
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"CROSSINTERPBYTECODE", NULL);
return TCL_ERROR;
}
codePtr->compileEpoch = iPtr->compileEpoch;
codePtr->nsPtr = nsPtr;
} else {
| | | 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 |
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"CROSSINTERPBYTECODE", NULL);
return TCL_ERROR;
}
codePtr->compileEpoch = iPtr->compileEpoch;
codePtr->nsPtr = nsPtr;
} else {
Tcl_StoreInternalRep(bodyPtr, &tclByteCodeType, NULL);
codePtr = NULL;
}
}
if (codePtr == NULL) {
Tcl_HashEntry *hePtr;
|
| ︙ | ︙ | |||
2308 2309 2310 2311 2312 2313 2314 |
if (!procPtr) {
return NULL;
}
TclNewObj(objPtr);
if (objPtr) {
| | | 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 |
if (!procPtr) {
return NULL;
}
TclNewObj(objPtr);
if (objPtr) {
ProcSetInternalRep(objPtr, procPtr);
}
return objPtr;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
2337 2338 2339 2340 2341 2342 2343 |
static void
ProcBodyDup(
Tcl_Obj *srcPtr, /* Object to copy. */
Tcl_Obj *dupPtr) /* Target object for the duplication. */
{
Proc *procPtr;
| | | | 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 |
static void
ProcBodyDup(
Tcl_Obj *srcPtr, /* Object to copy. */
Tcl_Obj *dupPtr) /* Target object for the duplication. */
{
Proc *procPtr;
ProcGetInternalRep(srcPtr, procPtr);
ProcSetInternalRep(dupPtr, procPtr);
}
/*
*----------------------------------------------------------------------
*
* ProcBodyFree --
*
|
| ︙ | ︙ | |||
2367 2368 2369 2370 2371 2372 2373 |
static void
ProcBodyFree(
Tcl_Obj *objPtr) /* The object to clean up. */
{
Proc *procPtr;
| | | 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 |
static void
ProcBodyFree(
Tcl_Obj *objPtr) /* The object to clean up. */
{
Proc *procPtr;
ProcGetInternalRep(objPtr, procPtr);
if (procPtr->refCount-- <= 1) {
TclProcCleanupProc(procPtr);
}
}
/*
|
| ︙ | ︙ | |||
2396 2397 2398 2399 2400 2401 2402 |
DupLambdaInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
Proc *procPtr;
Tcl_Obj *nsObjPtr;
| | | | | 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 |
DupLambdaInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
Proc *procPtr;
Tcl_Obj *nsObjPtr;
LambdaGetInternalRep(srcPtr, procPtr, nsObjPtr);
assert(procPtr != NULL);
procPtr->refCount++;
LambdaSetInternalRep(copyPtr, procPtr, nsObjPtr);
}
static void
FreeLambdaInternalRep(
Tcl_Obj *objPtr) /* CmdName object with internal representation
* to free. */
{
Proc *procPtr;
Tcl_Obj *nsObjPtr;
LambdaGetInternalRep(objPtr, procPtr, nsObjPtr);
assert(procPtr != NULL);
if (procPtr->refCount-- <= 1) {
TclProcCleanupProc(procPtr);
}
TclDecrRefCount(nsObjPtr);
}
|
| ︙ | ︙ | |||
2586 2587 2588 2589 2590 2591 2592 |
/*
* Free the list internalrep of objPtr - this will free argsPtr, but
* bodyPtr retains a reference from the Proc structure. Then finish the
* conversion to lambdaType.
*/
| | | | | 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 |
/*
* Free the list internalrep of objPtr - this will free argsPtr, but
* bodyPtr retains a reference from the Proc structure. Then finish the
* conversion to lambdaType.
*/
LambdaSetInternalRep(objPtr, procPtr, nsObjPtr);
return TCL_OK;
}
Proc *
TclGetLambdaFromObj(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
Tcl_Obj **nsObjPtrPtr)
{
Proc *procPtr;
Tcl_Obj *nsObjPtr;
LambdaGetInternalRep(objPtr, procPtr, nsObjPtr);
if (procPtr == NULL) {
if (SetLambdaFromAny(interp, objPtr) != TCL_OK) {
return NULL;
}
LambdaGetInternalRep(objPtr, procPtr, nsObjPtr);
}
assert(procPtr != NULL);
if (procPtr->iPtr != (Interp *)interp) {
return NULL;
}
|
| ︙ | ︙ |
Changes to generic/tclProcess.c.
| ︙ | ︙ | |||
529 530 531 532 533 534 535 |
}
Tcl_MutexUnlock(&infoTablesMutex);
} else {
/*
* Only return statuses of provided processes.
*/
| | | 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 |
}
Tcl_MutexUnlock(&infoTablesMutex);
} else {
/*
* Only return statuses of provided processes.
*/
result = TclListObjGetElements(interp, objv[1], &numPids, &pidObjs);
if (result != TCL_OK) {
return result;
}
dict = Tcl_NewDictObj();
Tcl_MutexLock(&infoTablesMutex);
for (i = 0; i < numPids; i++) {
result = Tcl_GetIntFromObj(interp, pidObjs[i], &pid);
|
| ︙ | ︙ | |||
644 645 646 647 648 649 650 |
}
Tcl_MutexUnlock(&infoTablesMutex);
} else {
/*
* Purge only provided processes.
*/
| | | 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 |
}
Tcl_MutexUnlock(&infoTablesMutex);
} else {
/*
* Purge only provided processes.
*/
result = TclListObjGetElements(interp, objv[1], &numPids, &pidObjs);
if (result != TCL_OK) {
return result;
}
Tcl_MutexLock(&infoTablesMutex);
for (i = 0; i < numPids; i++) {
result = Tcl_GetIntFromObj(interp, pidObjs[i], &pid);
if (result != TCL_OK) {
|
| ︙ | ︙ |
Changes to generic/tclRegexp.c.
| ︙ | ︙ | |||
105 106 107 108 109 110 111 |
"regexp", /* name */
FreeRegexpInternalRep, /* freeIntRepProc */
DupRegexpInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
SetRegexpFromAny /* setFromAnyProc */
};
| | | | | | | | 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 |
"regexp", /* name */
FreeRegexpInternalRep, /* freeIntRepProc */
DupRegexpInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
SetRegexpFromAny /* setFromAnyProc */
};
#define RegexpSetInternalRep(objPtr, rePtr) \
do { \
Tcl_ObjInternalRep ir; \
(rePtr)->refCount++; \
ir.twoPtrValue.ptr1 = (rePtr); \
ir.twoPtrValue.ptr2 = NULL; \
Tcl_StoreInternalRep((objPtr), &tclRegexpType, &ir); \
} while (0)
#define RegexpGetInternalRep(objPtr, rePtr) \
do { \
const Tcl_ObjInternalRep *irPtr; \
irPtr = TclFetchInternalRep((objPtr), &tclRegexpType); \
(rePtr) = irPtr ? (TclRegexp *)irPtr->twoPtrValue.ptr1 : NULL; \
} while (0)
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
594 595 596 597 598 599 600 |
* expression. */
int flags) /* Regular expression compilation flags. */
{
int length;
TclRegexp *regexpPtr;
const char *pattern;
| | | | 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 |
* expression. */
int flags) /* Regular expression compilation flags. */
{
int length;
TclRegexp *regexpPtr;
const char *pattern;
RegexpGetInternalRep(objPtr, regexpPtr);
if ((regexpPtr == NULL) || (regexpPtr->flags != flags)) {
pattern = TclGetStringFromObj(objPtr, &length);
regexpPtr = CompileRegexp(interp, pattern, length, flags);
if (regexpPtr == NULL) {
return NULL;
}
RegexpSetInternalRep(objPtr, regexpPtr);
}
return (Tcl_RegExp) regexpPtr;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
673 674 675 676 677 678 679 |
/*
* Assume that there will never be more than INT_MAX subexpressions. This
* is a pretty reasonable assumption; the RE engine doesn't scale _that_
* well and Tcl has other limits that constrain things as well...
*/
TclNewObj(resultObj);
| | | 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 |
/*
* Assume that there will never be more than INT_MAX subexpressions. This
* is a pretty reasonable assumption; the RE engine doesn't scale _that_
* well and Tcl has other limits that constrain things as well...
*/
TclNewObj(resultObj);
TclNewIndexObj(infoObj, regexpPtr->re.re_nsub);
Tcl_ListObjAppendElement(NULL, resultObj, infoObj);
/*
* Now append a list of all the bit-flags set for the RE.
*/
TclNewObj(infoObj);
|
| ︙ | ︙ | |||
753 754 755 756 757 758 759 |
static void
FreeRegexpInternalRep(
Tcl_Obj *objPtr) /* Regexp object with internal rep to free. */
{
TclRegexp *regexpRepPtr;
| | | 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 |
static void
FreeRegexpInternalRep(
Tcl_Obj *objPtr) /* Regexp object with internal rep to free. */
{
TclRegexp *regexpRepPtr;
RegexpGetInternalRep(objPtr, regexpRepPtr);
assert(regexpRepPtr != NULL);
/*
* If this is the last reference to the regexp, free it.
*/
|
| ︙ | ︙ | |||
790 791 792 793 794 795 796 |
static void
DupRegexpInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
TclRegexp *regexpPtr;
| | | | 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 |
static void
DupRegexpInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
TclRegexp *regexpPtr;
RegexpGetInternalRep(srcPtr, regexpPtr);
assert(regexpPtr != NULL);
RegexpSetInternalRep(copyPtr, regexpPtr);
}
/*
*----------------------------------------------------------------------
*
* SetRegexpFromAny --
*
|
| ︙ | ︙ |
Changes to generic/tclResult.c.
| ︙ | ︙ | |||
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 |
/*
* Reset the object result since we just set the string result.
*/
ResetObjResult(iPtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetStringResult --
*
* Returns an interpreter's result value as a string.
*
* Results:
* The interpreter's result as a string.
*
* Side effects:
* If the string result is empty, the object result is moved to the
* string result, then the object result is reset.
*
*----------------------------------------------------------------------
*/
const char *
Tcl_GetStringResult(
Tcl_Interp *interp)/* Interpreter whose result to return. */
{
Interp *iPtr = (Interp *) interp;
/*
* If the string result is empty, move the object result to the string
* result, then reset the object result.
*/
if (*(iPtr->result) == 0) {
Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
TCL_VOLATILE);
}
return iPtr->result;
}
| > > > > > > < | 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 |
/*
* Reset the object result since we just set the string result.
*/
ResetObjResult(iPtr);
}
#endif /* !TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
*
* Tcl_GetStringResult --
*
* Returns an interpreter's result value as a string.
*
* Results:
* The interpreter's result as a string.
*
* Side effects:
* If the string result is empty, the object result is moved to the
* string result, then the object result is reset.
*
*----------------------------------------------------------------------
*/
#undef Tcl_GetStringResult
const char *
Tcl_GetStringResult(
Tcl_Interp *interp)/* Interpreter whose result to return. */
{
#ifndef TCL_NO_DEPRECATED
Interp *iPtr = (Interp *) interp;
/*
* If the string result is empty, move the object result to the string
* result, then reset the object result.
*/
if (*(iPtr->result) == 0) {
Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
TCL_VOLATILE);
}
return iPtr->result;
#else
return TclGetString(Tcl_GetObjResult(interp));
#endif
}
/*
*----------------------------------------------------------------------
*
* Tcl_SetObjResult --
*
* Arrange for objPtr to be an interpreter's result value.
|
| ︙ | ︙ | |||
1004 1005 1006 1007 1008 1009 1010 |
if (objResultPtr->bytes != &tclEmptyString) {
if (objResultPtr->bytes) {
ckfree(objResultPtr->bytes);
}
objResultPtr->bytes = &tclEmptyString;
objResultPtr->length = 0;
}
| | | 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 |
if (objResultPtr->bytes != &tclEmptyString) {
if (objResultPtr->bytes) {
ckfree(objResultPtr->bytes);
}
objResultPtr->bytes = &tclEmptyString;
objResultPtr->length = 0;
}
TclFreeInternalRep(objResultPtr);
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_SetErrorCodeVA --
|
| ︙ | ︙ | |||
1319 1320 1321 1322 1323 1324 1325 |
}
/*
* List extraction done after duplication to avoid moving the rug
* if someone does [return -errorstack [info errorstack]]
*/
| | | | | 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 |
}
/*
* List extraction done after duplication to avoid moving the rug
* if someone does [return -errorstack [info errorstack]]
*/
if (TclListObjGetElements(interp, valuePtr, &valueObjc,
&valueObjv) == TCL_ERROR) {
return TCL_ERROR;
}
iPtr->resetErrorStack = 0;
TclListObjLength(interp, iPtr->errorStack, &len);
/*
* Reset while keeping the list internalrep as much as possible.
*/
Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, valueObjc,
valueObjv);
}
Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORCODE],
&valuePtr);
|
| ︙ | ︙ | |||
1481 1482 1483 1484 1485 1486 1487 |
* Check for bogus -errorcode value.
*/
Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORCODE], &valuePtr);
if (valuePtr != NULL) {
int length;
| | | 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 |
* Check for bogus -errorcode value.
*/
Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORCODE], &valuePtr);
if (valuePtr != NULL) {
int length;
if (TCL_ERROR == TclListObjLength(NULL, valuePtr, &length )) {
/*
* Value is not a list, which is illegal for -errorcode.
*/
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad -errorcode value: expected a list but got \"%s\"",
TclGetString(valuePtr)));
|
| ︙ | ︙ | |||
1503 1504 1505 1506 1507 1508 1509 |
* Check for bogus -errorstack value.
*/
Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORSTACK], &valuePtr);
if (valuePtr != NULL) {
int length;
| | | 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 |
* Check for bogus -errorstack value.
*/
Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORSTACK], &valuePtr);
if (valuePtr != NULL) {
int length;
if (TCL_ERROR == TclListObjLength(NULL, valuePtr, &length )) {
/*
* Value is not a list, which is illegal for -errorstack.
*/
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad -errorstack value: expected a list but got \"%s\"",
TclGetString(valuePtr)));
|
| ︙ | ︙ |
Changes to generic/tclScan.c.
| ︙ | ︙ | |||
30 31 32 33 34 35 36 |
*/
typedef struct {
Tcl_UniChar start;
Tcl_UniChar end;
} Range;
| | | 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 |
*/
typedef struct {
Tcl_UniChar start;
Tcl_UniChar end;
} Range;
typedef struct {
int exclude; /* 1 if this is an exclusion set. */
int nchars;
Tcl_UniChar *chars;
int nranges;
Range *ranges;
} CharSet;
|
| ︙ | ︙ | |||
912 913 914 915 916 917 918 |
string = end;
if (flags & SCAN_SUPPRESS) {
Tcl_DecrRefCount(objPtr);
break;
}
if (flags & SCAN_LONGER) {
if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) {
| < > > | 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 |
string = end;
if (flags & SCAN_SUPPRESS) {
Tcl_DecrRefCount(objPtr);
break;
}
if (flags & SCAN_LONGER) {
if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) {
if (TclGetString(objPtr)[0] == '-') {
wideValue = WIDE_MIN;
} else {
wideValue = WIDE_MAX;
}
}
if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {
mp_int big;
if (mp_init_u64(&big, (Tcl_WideUInt)wideValue) != MP_OKAY) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"insufficient memory to create bignum", -1));
|
| ︙ | ︙ | |||
1013 1014 1015 1016 1017 1018 1019 |
} else if (flags & SCAN_SUPPRESS) {
Tcl_DecrRefCount(objPtr);
string = end;
} else {
double dvalue;
if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) {
#ifdef ACCEPT_NAN
| | | | 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 |
} else if (flags & SCAN_SUPPRESS) {
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;
|
| ︙ | ︙ | |||
1085 1086 1087 1088 1089 1090 1091 |
}
if (objs != NULL) {
ckfree(objs);
}
if (code == TCL_OK) {
if (underflow && (nconversions == 0)) {
if (numVars) {
| | | 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 |
}
if (objs != NULL) {
ckfree(objs);
}
if (code == TCL_OK) {
if (underflow && (nconversions == 0)) {
if (numVars) {
TclNewIndexObj(objPtr, TCL_INDEX_NONE);
} else {
if (objPtr) {
Tcl_SetListObj(objPtr, 0, NULL);
} else {
TclNewObj(objPtr);
}
}
|
| ︙ | ︙ |
Changes to generic/tclStrToD.c.
| ︙ | ︙ | |||
539 540 541 542 543 544 545 |
* to avoid a compiler warning. */
int shift = 0; /* Amount to shift when accumulating binary */
int explicitOctal = 0;
mp_err err = MP_OKAY;
int under = 0; /* Flag trailing '_' as error if true once
* number is accepted. */
| < | | | | 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 |
* to avoid a compiler warning. */
int shift = 0; /* Amount to shift when accumulating binary */
int explicitOctal = 0;
mp_err err = MP_OKAY;
int under = 0; /* Flag trailing '_' as error if true once
* number is accepted. */
#define MOST_BITS (UWIDE_MAX >> 1)
/*
* Initialize bytes to start of the object's string rep if the caller
* didn't pass anything else.
*/
if (bytes == NULL) {
if (interp == NULL && endPtrPtr == NULL) {
if (TclHasInternalRep(objPtr, &tclDictType)) {
/* A dict can never be a (single) number */
return TCL_ERROR;
}
if (TclHasInternalRep(objPtr, &tclListType)) {
int length;
/* A list can only be a (single) number if its length == 1 */
TclListObjLength(NULL, objPtr, &length);
if (length != 1) {
return TCL_ERROR;
}
}
|
| ︙ | ︙ | |||
717 718 719 720 721 722 723 |
significandOverflow = AccumulateDecimalDigit(
(unsigned)(c-'0'), numTrailZeros,
&significandWide, &significandBig,
significandOverflow);
if (!octalSignificandOverflow) {
/*
| | | | > > > > > > > > | > | | 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 |
significandOverflow = AccumulateDecimalDigit(
(unsigned)(c-'0'), numTrailZeros,
&significandWide, &significandBig,
significandOverflow);
if (!octalSignificandOverflow) {
/*
* Shifting by as many or more bits than are in the
* value being shifted is undefined behavior. Check
* for too large shifts first.
*/
if ((octalSignificandWide != 0)
&& (((size_t)shift >=
CHAR_BIT*sizeof(Tcl_WideUInt))
|| (octalSignificandWide >
(UWIDE_MAX >> shift)))) {
octalSignificandOverflow = 1;
err = mp_init_u64(&octalSignificandBig,
octalSignificandWide);
}
}
if (!octalSignificandOverflow) {
/*
* When the significand is 0, it is possible for the
* amount to be shifted to equal or exceed the width
* of the significand. Do not shift when the
* significand is 0 to avoid undefined behavior.
*/
if (octalSignificandWide != 0) {
octalSignificandWide <<= shift;
}
octalSignificandWide += c - '0';
} else {
if (err == MP_OKAY) {
err = mp_mul_2d(&octalSignificandBig, shift,
&octalSignificandBig);
}
if (err == MP_OKAY) {
err = mp_add_d(&octalSignificandBig, (mp_digit)(c - '0'),
|
| ︙ | ︙ | |||
859 860 861 862 863 864 865 |
} else {
goto endgame;
}
if (objPtr != NULL) {
shift = 4 * (numTrailZeros + 1);
if (!significandOverflow) {
/*
| | | | > > > > > > > > > > | | | | | > > > > > > > > > > | | 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 |
} else {
goto endgame;
}
if (objPtr != NULL) {
shift = 4 * (numTrailZeros + 1);
if (!significandOverflow) {
/*
* Shifting by as many or more bits than are in the
* value being shifted is undefined behavior. Check
* for too large shifts first.
*/
if (significandWide != 0 &&
((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
significandWide > (UWIDE_MAX >> shift))) {
significandOverflow = 1;
err = mp_init_u64(&significandBig,
significandWide);
}
}
if (!significandOverflow) {
/*
* When the significand is 0, it is possible for the
* amount to be shifted to equal or exceed the width
* of the significand. Do not shift when the
* significand is 0 to avoid undefined behavior.
*/
if (significandWide != 0) {
significandWide <<= shift;
}
significandWide += d;
} else if (err == MP_OKAY) {
err = mp_mul_2d(&significandBig, shift, &significandBig);
if (err == MP_OKAY) {
err = mp_add_d(&significandBig, (mp_digit) d, &significandBig);
}
}
}
if (err != MP_OKAY) {
return TCL_ERROR;
}
numTrailZeros = 0;
state = HEXADECIMAL;
break;
case BINARY:
acceptState = state;
acceptPoint = p;
acceptLen = len;
/* FALLTHRU */
case ZERO_B:
zerob:
if (c == '0') {
numTrailZeros++;
under = 0;
state = BINARY;
break;
} else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
/* Ignore numeric "white space" */
under = 1;
break;
} else if (c != '1') {
goto endgame;
} else {
under = 0;
}
if (objPtr != NULL) {
shift = numTrailZeros + 1;
if (!significandOverflow) {
/*
* Shifting by as many or more bits than are in the
* value being shifted is undefined behavior. Check
* for too large shifts first.
*/
if (significandWide != 0 &&
((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
significandWide > (UWIDE_MAX >> shift))) {
significandOverflow = 1;
err = mp_init_u64(&significandBig,
significandWide);
}
}
if (!significandOverflow) {
/*
* When the significand is 0, it is possible for the
* amount to be shifted to equal or exceed the width
* of the significand. Do not shift when the
* significand is 0 to avoid undefined behavior.
*/
if (significandWide != 0) {
significandWide <<= shift;
}
significandWide += 1;
} else if (err == MP_OKAY) {
err = mp_mul_2d(&significandBig, shift, &significandBig);
if (err == MP_OKAY) {
err = mp_add_d(&significandBig, (mp_digit) 1, &significandBig);
}
}
}
|
| ︙ | ︙ | |||
1291 1292 1293 1294 1295 1296 1297 |
}
/*
* Generate and store the appropriate internal rep.
*/
if (status == TCL_OK && objPtr != NULL) {
| | | 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 |
}
/*
* Generate and store the appropriate internal rep.
*/
if (status == TCL_OK && objPtr != NULL) {
TclFreeInternalRep(objPtr);
switch (acceptState) {
case SIGNUM:
case BAD_OCTAL:
case ZERO_X:
case ZERO_O:
case ZERO_B:
case ZERO_D:
|
| ︙ | ︙ | |||
1326 1327 1328 1329 1330 1331 1332 |
((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
significandWide > (MOST_BITS + signum) >> shift)) {
significandOverflow = 1;
err = mp_init_u64(&significandBig, significandWide);
}
if (shift) {
if (!significandOverflow) {
| > > > > > > > | > | 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 |
((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
significandWide > (MOST_BITS + signum) >> shift)) {
significandOverflow = 1;
err = mp_init_u64(&significandBig, significandWide);
}
if (shift) {
if (!significandOverflow) {
/*
* When the significand is 0, it is possible for the
* amount to be shifted to equal or exceed the width
* of the significand. Do not shift when the
* significand is 0 to avoid undefined behavior.
*/
if (significandWide != 0) {
significandWide <<= shift;
}
} else if (err == MP_OKAY) {
err = mp_mul_2d(&significandBig, shift, &significandBig);
}
}
if (err != MP_OKAY) {
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
1350 1351 1352 1353 1354 1355 1356 |
((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
significandWide > (MOST_BITS + signum) >> shift)) {
significandOverflow = 1;
err = mp_init_u64(&significandBig, significandWide);
}
if (shift) {
if (!significandOverflow) {
| > > > > > > > | > | 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 |
((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
significandWide > (MOST_BITS + signum) >> shift)) {
significandOverflow = 1;
err = mp_init_u64(&significandBig, significandWide);
}
if (shift) {
if (!significandOverflow) {
/*
* When the significand is 0, it is possible for the
* amount to be shifted to equal or exceed the width
* of the significand. Do not shift when the
* significand is 0 to avoid undefined behavior.
*/
if (significandWide != 0) {
significandWide <<= shift;
}
} else if (err == MP_OKAY) {
err = mp_mul_2d(&significandBig, shift, &significandBig);
}
}
if (err != MP_OKAY) {
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
1375 1376 1377 1378 1379 1380 1381 |
octalSignificandWide > (MOST_BITS + signum) >> shift)) {
octalSignificandOverflow = 1;
err = mp_init_u64(&octalSignificandBig,
octalSignificandWide);
}
if (shift) {
if (!octalSignificandOverflow) {
| > > > > > > > | > | | | | 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 |
octalSignificandWide > (MOST_BITS + signum) >> shift)) {
octalSignificandOverflow = 1;
err = mp_init_u64(&octalSignificandBig,
octalSignificandWide);
}
if (shift) {
if (!octalSignificandOverflow) {
/*
* When the significand is 0, it is possible for the
* amount to be shifted to equal or exceed the width
* of the significand. Do not shift when the
* significand is 0 to avoid undefined behavior.
*/
if (octalSignificandWide != 0) {
octalSignificandWide <<= shift;
}
} else if (err == MP_OKAY) {
err = mp_mul_2d(&octalSignificandBig, shift,
&octalSignificandBig);
}
}
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;
}
}
}
if ((err == MP_OKAY) && octalSignificandOverflow) {
if (signum) {
err = mp_neg(&octalSignificandBig, &octalSignificandBig);
}
TclSetBignumInternalRep(objPtr, &octalSignificandBig);
}
if (err != MP_OKAY) {
return TCL_ERROR;
}
break;
case ZERO:
|
| ︙ | ︙ | |||
1426 1427 1428 1429 1430 1431 1432 |
err = mp_init_u64(&significandBig,
significandWide);
significandOverflow = 1;
} else {
objPtr->typePtr = &tclIntType;
if (signum) {
objPtr->internalRep.wideValue =
| | | | | 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 |
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;
}
}
}
if ((err == MP_OKAY) && significandOverflow) {
if (signum) {
err = mp_neg(&significandBig, &significandBig);
}
TclSetBignumInternalRep(objPtr, &significandBig);
}
if (err != MP_OKAY) {
return TCL_ERROR;
}
break;
case FRACTION:
|
| ︙ | ︙ | |||
2132 2133 2134 2135 2136 2137 2138 |
/*
* If we're in the 'round to even' case, and the significand is already
* even, we're done. Return the approximate result.
*/
if (roundToEven) {
rteSignificand = frexp(approxResult, &rteExponent);
| | | 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 |
/*
* If we're in the 'round to even' case, and the significand is already
* even, we're done. Return the approximate result.
*/
if (roundToEven) {
rteSignificand = frexp(approxResult, &rteExponent);
rteSigWide = (Tcl_WideInt)ldexp(rteSignificand, FP_PRECISION);
if ((rteSigWide & 1) == 0) {
mp_clear(&twoMd);
mp_clear(&twoMv);
return approxResult;
}
}
|
| ︙ | ︙ | |||
3795 3796 3797 3798 3799 3800 3801 |
* produced the last digit. */
mp_int *S, /* Denominator. */
int isodd) /* Flag == 1 if the last digit is odd. */
{
int r = mp_cmp_mag(twor, S);
switch (r) {
| < < < < > | > | 3847 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 |
* produced the last digit. */
mp_int *S, /* Denominator. */
int isodd) /* Flag == 1 if the last digit is odd. */
{
int r = mp_cmp_mag(twor, S);
switch (r) {
case MP_EQ:
return isodd;
case MP_GT:
return 1;
default:
return 0;
}
}
/*
*----------------------------------------------------------------------
*
* ShouldBankerRoundUpToNext --
*
|
| ︙ | ︙ | |||
3841 3842 3843 3844 3845 3846 3847 |
if ((mp_init(&temp) != MP_OKAY) || (mp_add(b, m, &temp) != MP_OKAY)) {
return 0;
}
r = mp_cmp_mag(&temp, S);
mp_clear(&temp);
switch(r) {
| < < < < > | > | 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 |
if ((mp_init(&temp) != MP_OKAY) || (mp_add(b, m, &temp) != MP_OKAY)) {
return 0;
}
r = mp_cmp_mag(&temp, S);
mp_clear(&temp);
switch(r) {
case MP_EQ:
return isodd;
case MP_GT:
return 1;
default:
return 0;
}
}
/*
*----------------------------------------------------------------------
*
* ShorteningBignumConversion --
*
|
| ︙ | ︙ | |||
4780 4781 4782 4783 4784 4785 4786 |
mp_err err;
mp_int *b = (mp_int *)big;
/*
* Infinite values can't convert to bignum.
*/
| | | | 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 |
mp_err err;
mp_int *b = (mp_int *)big;
/*
* Infinite values can't convert to bignum.
*/
if (isinf(d)) {
if (interp != NULL) {
const char *s = "integer value too large to represent";
Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
}
return TCL_ERROR;
}
fract = frexp(d, &expt);
if (expt <= 0) {
err = mp_init(b);
mp_zero(b);
} else {
Tcl_WideInt w = (Tcl_WideInt)ldexp(fract, mantBits);
int shift = expt - mantBits;
err = mp_init_i64(b, w);
if (err != MP_OKAY) {
/* just skip */
} else if (shift < 0) {
err = mp_div_2d(b, -shift, b, NULL);
|
| ︙ | ︙ |
Changes to generic/tclStringObj.c.
| ︙ | ︙ | |||
65 66 67 68 69 70 71 72 73 74 75 76 77 78 |
static void GrowStringBuffer(Tcl_Obj *objPtr, int needed, int flag);
static void GrowUnicodeBuffer(Tcl_Obj *objPtr, int needed);
static int SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void SetUnicodeObj(Tcl_Obj *objPtr,
const Tcl_UniChar *unicode, int numChars);
static int 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 = {
| > > > > > | 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 |
static void GrowStringBuffer(Tcl_Obj *objPtr, int needed, int flag);
static void GrowUnicodeBuffer(Tcl_Obj *objPtr, int needed);
static int SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void SetUnicodeObj(Tcl_Obj *objPtr,
const Tcl_UniChar *unicode, int numChars);
static int UnicodeLength(const Tcl_UniChar *unicode);
static void UpdateStringOfString(Tcl_Obj *objPtr);
#define ISCONTINUATION(bytes) (\
((((bytes)[0] & 0xC0) == 0x80) || (((bytes)[0] == '\xED') \
&& (((bytes)[1] & 0xF0) == 0xB0) && (((bytes)[2] & 0xC0) == 0x80))))
/*
* The structure below defines the string Tcl object type by means of
* functions that can be invoked by generic object code.
*/
const Tcl_ObjType tclStringType = {
|
| ︙ | ︙ | |||
139 140 141 142 143 144 145 |
if (objPtr->bytes == &tclEmptyString) {
objPtr->bytes = NULL;
}
if (flag == 0 || stringPtr->allocated > 0) {
if (needed <= INT_MAX / 2) {
attempt = 2 * needed;
| | | | | 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 |
if (objPtr->bytes == &tclEmptyString) {
objPtr->bytes = NULL;
}
if (flag == 0 || stringPtr->allocated > 0) {
if (needed <= INT_MAX / 2) {
attempt = 2 * needed;
ptr = (char *)attemptckrealloc(objPtr->bytes, attempt + 1U);
}
if (ptr == NULL) {
/*
* Take care computing the amount of modest growth to avoid
* overflow into invalid argument values for attempt.
*/
unsigned int limit = INT_MAX - needed;
unsigned int extra = needed - objPtr->length + TCL_MIN_GROWTH;
int growth = (int) ((extra > limit) ? limit : extra);
attempt = needed + growth;
ptr = (char *)attemptckrealloc(objPtr->bytes, attempt + 1U);
}
}
if (ptr == NULL) {
/*
* First allocation - just big enough; or last chance fallback.
*/
attempt = needed;
ptr = (char *)ckrealloc(objPtr->bytes, attempt + 1U);
}
objPtr->bytes = ptr;
stringPtr->allocated = attempt;
}
static void
GrowUnicodeBuffer(
|
| ︙ | ︙ | |||
476 477 478 479 480 481 482 |
int length = -1;
if (objPtr->bytes == &tclEmptyString) {
return TCL_EMPTYSTRING_YES;
}
if (TclListObjIsCanonical(objPtr)) {
| | | 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 |
int length = -1;
if (objPtr->bytes == &tclEmptyString) {
return TCL_EMPTYSTRING_YES;
}
if (TclListObjIsCanonical(objPtr)) {
TclListObjLength(NULL, objPtr, &length);
return length == 0;
}
if (TclIsPureDict(objPtr)) {
Tcl_DictObjSize(NULL, objPtr, &length);
return length == 0;
}
|
| ︙ | ︙ | |||
552 553 554 555 556 557 558 |
* If numChars is unknown, compute it.
*/
if (stringPtr->numChars == -1) {
TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
}
if (stringPtr->numChars == objPtr->length) {
| | | | 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 |
* If numChars is unknown, compute it.
*/
if (stringPtr->numChars == -1) {
TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
}
if (stringPtr->numChars == objPtr->length) {
return (unsigned char) objPtr->bytes[index];
}
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
}
if (index >= stringPtr->numChars) {
return -1;
}
ch = stringPtr->unicode[index];
#if TCL_UTF_MAX < 4
/* See: bug [11ae2be95dac9417] */
if ((ch & 0xF800) == 0xD800) {
if (ch & 0x400) {
if ((index > 0)
&& ((stringPtr->unicode[index-1] & 0xFC00) == 0xD800)) {
ch = -1; /* low surrogate preceded by high surrogate */
}
|
| ︙ | ︙ | |||
689 690 691 692 693 694 695 | /* *---------------------------------------------------------------------- * * Tcl_GetRange -- * * Create a Tcl Object that contains the chars between first and last of * the object indicated by "objPtr". If the object is not already a | | < | 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 | /* *---------------------------------------------------------------------- * * Tcl_GetRange -- * * Create a Tcl Object that contains the chars between first and last of * the object indicated by "objPtr". If the object is not already a * String object, convert it to one. * * Results: * Returns a new Tcl Object of the String type. * * Side effects: * Changes the internal rep of "objPtr" to the String type. * |
| ︙ | ︙ | |||
723 724 725 726 727 728 729 |
* Optimize the case where we're really dealing with a bytearray object
* we don't need to convert to a string to perform the substring operation.
*/
if (TclIsPureByteArray(objPtr)) {
unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
| | > | | > | | | | > | | | 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 |
* Optimize the case where we're really dealing with a bytearray object
* we don't need to convert to a string to perform the substring operation.
*/
if (TclIsPureByteArray(objPtr)) {
unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
if (last < 0 || last >= length) {
last = length - 1;
}
if (last < first) {
TclNewObj(newObjPtr);
return newObjPtr;
}
return Tcl_NewByteArrayObj(bytes + first, last - first + 1);
}
/*
* 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 == -1) {
TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
}
if (stringPtr->numChars == objPtr->length) {
if (last < 0 || last >= stringPtr->numChars) {
last = stringPtr->numChars - 1;
}
if (last < first) {
TclNewObj(newObjPtr);
return newObjPtr;
}
newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last - first + 1);
/*
* Since we know the char length of the result, store it.
*/
SetStringFromAny(NULL, newObjPtr);
stringPtr = GET_STRING(newObjPtr);
stringPtr->numChars = newObjPtr->length;
return newObjPtr;
}
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
}
if (last < 0 || last >= stringPtr->numChars) {
last = stringPtr->numChars - 1;
}
if (last < first) {
TclNewObj(newObjPtr);
return newObjPtr;
}
#if TCL_UTF_MAX < 4
/* See: bug [11ae2be95dac9417] */
if ((first > 0) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00)
&& ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) {
++first;
}
if ((last + 1 < stringPtr->numChars)
&& ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00)
|
| ︙ | ︙ | |||
827 828 829 830 831 832 833 |
Tcl_Panic("%s called with shared object", "Tcl_SetStringObj");
}
/*
* Set the type to NULL and free any internal rep for the old type.
*/
| | | 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 |
Tcl_Panic("%s called with shared object", "Tcl_SetStringObj");
}
/*
* Set the type to NULL and free any internal rep for the old type.
*/
TclFreeInternalRep(objPtr);
/*
* Free any old string rep, then set the string rep to a copy of the
* length bytes starting at "bytes".
*/
TclInvalidateStringRep(objPtr);
|
| ︙ | ︙ | |||
903 904 905 906 907 908 909 |
* Change length of an existing string rep.
*/
if (length > stringPtr->allocated) {
/*
* Need to enlarge the buffer.
*/
if (objPtr->bytes == &tclEmptyString) {
| | | | 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 |
* Change length of an existing string rep.
*/
if (length > stringPtr->allocated) {
/*
* Need to enlarge the buffer.
*/
if (objPtr->bytes == &tclEmptyString) {
objPtr->bytes = (char *)ckalloc((unsigned int)length + 1U);
} else {
objPtr->bytes = (char *)ckrealloc(objPtr->bytes, (unsigned int)length + 1U);
}
stringPtr->allocated = length;
}
objPtr->length = length;
objPtr->bytes[length] = 0;
|
| ︙ | ︙ | |||
1009 1010 1011 1012 1013 1014 1015 |
/*
* Need to enlarge the buffer.
*/
char *newBytes;
if (objPtr->bytes == &tclEmptyString) {
| | | | 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 |
/*
* Need to enlarge the buffer.
*/
char *newBytes;
if (objPtr->bytes == &tclEmptyString) {
newBytes = (char *)attemptckalloc((unsigned int)length + 1U);
} else {
newBytes = (char *)attemptckrealloc(objPtr->bytes, (unsigned int)length + 1U);
}
if (newBytes == NULL) {
return 0;
}
objPtr->bytes = newBytes;
stringPtr->allocated = length;
}
|
| ︙ | ︙ | |||
1089 1090 1091 1092 1093 1094 1095 |
* object. */
int numChars) /* Number of characters in the unicode
* string. */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj");
}
| | | 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 |
* object. */
int numChars) /* Number of characters in the unicode
* string. */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj");
}
TclFreeInternalRep(objPtr);
SetUnicodeObj(objPtr, unicode, numChars);
}
static int
UnicodeLength(
const Tcl_UniChar *unicode)
{
|
| ︙ | ︙ | |||
1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 |
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) {
| > > > > > > | 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 |
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_AppendLimitedToObj");
}
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
/* If appended string starts with a continuation byte or a lower surrogate,
* force objPtr to unicode representation. See [7f1162a867] */
if (bytes && ISCONTINUATION(bytes)) {
Tcl_GetUnicode(objPtr);
stringPtr = GET_STRING(objPtr);
}
if (stringPtr->hasUnicode && stringPtr->numChars > 0) {
AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
} else {
AppendUtfToUtfRep(objPtr, bytes, toCopy);
}
if (length <= limit) {
|
| ︙ | ︙ | |||
1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 |
/*
* 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) {
/*
* If appendObjPtr is not of the "String" type, don't convert it.
*/
| > > > > > > > | | | 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 |
/*
* Must append as strings.
*/
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
/* If appended string starts with a continuation byte or a lower surrogate,
* force objPtr to unicode representation. See [7f1162a867]
* This fixes append-3.4, append-3.7 and utf-1.18 testcases. */
if (ISCONTINUATION(TclGetString(appendObjPtr))) {
Tcl_GetUnicode(objPtr);
stringPtr = GET_STRING(objPtr);
}
/*
* If objPtr has a valid Unicode rep, then get a Unicode string from
* appendObjPtr and append it.
*/
if (stringPtr->hasUnicode) {
/*
* If appendObjPtr is not of the "String" type, don't convert it.
*/
if (TclHasInternalRep(appendObjPtr, &tclStringType)) {
Tcl_UniChar *unicode =
Tcl_GetUnicodeFromObj(appendObjPtr, &numChars);
AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
} else {
bytes = TclGetStringFromObj(appendObjPtr, &length);
AppendUtfToUnicodeRep(objPtr, bytes, length);
}
return;
}
/*
* Append to objPtr's UTF string rep. If we know the number of characters
* in both objects before appending, then set the combined number of
* characters in the final (appended-to) object.
*/
bytes = TclGetStringFromObj(appendObjPtr, &length);
numChars = stringPtr->numChars;
if ((numChars >= 0) && TclHasInternalRep(appendObjPtr, &tclStringType)) {
String *appendStringPtr = GET_STRING(appendObjPtr);
appendNumChars = appendStringPtr->numChars;
}
AppendUtfToUtfRep(objPtr, bytes, length);
|
| ︙ | ︙ | |||
1652 1653 1654 1655 1656 1657 1658 |
* trailing null.
*/
if (objPtr->bytes == NULL) {
objPtr->length = 0;
}
oldLength = objPtr->length;
| | < > | | | 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 |
* trailing null.
*/
if (objPtr->bytes == NULL) {
objPtr->length = 0;
}
oldLength = objPtr->length;
if (numBytes > INT_MAX - oldLength) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
newLength = numBytes + oldLength;
stringPtr = GET_STRING(objPtr);
if (newLength > stringPtr->allocated) {
int offset = -1;
/*
* Protect against case where unicode points into the existing
* stringPtr->unicode array. Force it to follow any relocations due to
* the reallocs below.
*/
if (bytes && objPtr->bytes && (bytes >= objPtr->bytes)
&& (bytes <= objPtr->bytes + objPtr->length)) {
offset = bytes - objPtr->bytes;
}
/*
* TODO: consider passing flag=1: no overalloc on first append. This
* would make test stringObj-8.1 fail.
*/
|
| ︙ | ︙ | |||
2063 2064 2065 2066 2067 2068 2069 |
msg = "format string ended in middle of field specifier";
errCode = "INCOMPLETE";
goto errorMsg;
case 's':
if (gotPrecision) {
numChars = Tcl_GetCharLength(segment);
if (precision < numChars) {
| > > > | > | 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 |
msg = "format string ended in middle of field specifier";
errCode = "INCOMPLETE";
goto errorMsg;
case 's':
if (gotPrecision) {
numChars = Tcl_GetCharLength(segment);
if (precision < numChars) {
if (precision < 1) {
TclNewObj(segment);
} else {
segment = Tcl_GetRange(segment, 0, precision - 1);
}
numChars = precision;
Tcl_IncrRefCount(segment);
allocSegment = 1;
}
}
break;
case 'c': {
|
| ︙ | ︙ | |||
2847 2848 2849 2850 2851 2852 2853 |
char *
TclGetStringStorage(
Tcl_Obj *objPtr,
unsigned int *sizePtr)
{
String *stringPtr;
| | | 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 |
char *
TclGetStringStorage(
Tcl_Obj *objPtr,
unsigned int *sizePtr)
{
String *stringPtr;
if (!TclHasInternalRep(objPtr, &tclStringType) || objPtr->bytes == NULL) {
return TclGetStringFromObj(objPtr, (int *)sizePtr);
}
stringPtr = GET_STRING(objPtr);
*sizePtr = stringPtr->allocated;
return objPtr->bytes;
}
|
| ︙ | ︙ | |||
2895 2896 2897 2898 2899 2900 2901 |
* Analyze to determine what representation result should be.
* GOALS: Avoid shimmering & string rep generation.
* Produce pure bytearray when possible.
* Error on overflow.
*/
if (!binary) {
| | | 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 |
* Analyze to determine what representation result should be.
* GOALS: Avoid shimmering & string rep generation.
* Produce pure bytearray when possible.
* Error on overflow.
*/
if (!binary) {
if (TclHasInternalRep(objPtr, &tclStringType)) {
String *stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode) {
unichar = 1;
}
}
}
|
| ︙ | ︙ | |||
2979 2980 2981 2982 2983 2984 2985 |
/*
* Efficiently concatenate string reps.
*/
if (!inPlace || Tcl_IsShared(objPtr)) {
objResultPtr = Tcl_NewStringObj(Tcl_GetString(objPtr), length);
} else {
| | | 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 |
/*
* Efficiently concatenate string reps.
*/
if (!inPlace || Tcl_IsShared(objPtr)) {
objResultPtr = Tcl_NewStringObj(Tcl_GetString(objPtr), length);
} else {
TclFreeInternalRep(objPtr);
objResultPtr = objPtr;
}
if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) {
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"string size overflow: unable to alloc %u bytes",
count*length));
|
| ︙ | ︙ | |||
3028 3029 3030 3031 3032 3033 3034 |
Tcl_Interp *interp,
int objc,
Tcl_Obj * const objv[],
int flags)
{
Tcl_Obj *objResultPtr, * const *ov;
int oc, length = 0, binary = 1;
| | | 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 |
Tcl_Interp *interp,
int objc,
Tcl_Obj * const objv[],
int flags)
{
Tcl_Obj *objResultPtr, * const *ov;
int oc, length = 0, binary = 1;
int allowUniChar = 1, requestUniChar = 0, forceUniChar = 0;
int first = objc - 1; /* Index of first value possibly not empty */
int last = 0; /* Index of last value possibly not empty */
int inPlace = flags & TCL_STRING_IN_PLACE;
/* assert ( objc >= 0 ) */
if (objc <= 1) {
|
| ︙ | ︙ | |||
3064 3065 3066 3067 3068 3069 3070 |
if (objPtr->length) {
/*
* Non-empty string rep. Not a pure bytearray, so we won't
* create a pure bytearray.
*/
binary = 0;
| > > | | | 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 |
if (objPtr->length) {
/*
* Non-empty string rep. Not a pure bytearray, so we won't
* create a pure bytearray.
*/
binary = 0;
if (ov > objv+1 && ISCONTINUATION(TclGetString(objPtr))) {
forceUniChar = 1;
} else if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
/* Prevent shimmer of non-string types. */
allowUniChar = 0;
}
}
} else {
/* assert (objPtr->typePtr != NULL) -- stork! */
binary = 0;
if (TclHasInternalRep(objPtr, &tclStringType)) {
/* Have a pure Unicode value; ask to preserve it */
requestUniChar = 1;
} else {
/* Have another type; prevent shimmer */
allowUniChar = 0;
}
}
|
| ︙ | ︙ | |||
3113 3114 3115 3116 3117 3118 3119 |
} else if (numBytes > INT_MAX - length) {
goto overflow;
}
length += numBytes;
}
}
} while (--oc);
| | | 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 |
} else if (numBytes > INT_MAX - length) {
goto overflow;
}
length += numBytes;
}
}
} while (--oc);
} else if ((allowUniChar && requestUniChar) || forceUniChar) {
/*
* Result will be pure Tcl_UniChar array. Pre-size it.
*/
ov = objv;
oc = objc;
do {
|
| ︙ | ︙ | |||
3266 3267 3268 3269 3270 3271 3272 |
if (TclIsPureByteArray(objPtr)) {
int more;
unsigned char *src = Tcl_GetByteArrayFromObj(objPtr, &more);
memcpy(dst, src, more);
dst += more;
}
}
| | | 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 |
if (TclIsPureByteArray(objPtr)) {
int more;
unsigned char *src = Tcl_GetByteArrayFromObj(objPtr, &more);
memcpy(dst, src, more);
dst += more;
}
}
} else if ((allowUniChar && requestUniChar) || forceUniChar) {
/* Efficiently produce a pure Tcl_UniChar array result */
Tcl_UniChar *dst;
if (inPlace && !Tcl_IsShared(*objv)) {
int start;
objResultPtr = *objv++; objc--;
|
| ︙ | ︙ | |||
3339 3340 3341 3342 3343 3344 3345 | Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return NULL; } dst = Tcl_GetString(objResultPtr) + start; /* assert ( length > start ) */ | | | 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 |
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
return NULL;
}
dst = Tcl_GetString(objResultPtr) + start;
/* assert ( length > start ) */
TclFreeInternalRep(objResultPtr);
} else {
TclNewObj(objResultPtr); /* PANIC? */
if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
Tcl_DecrRefCount(objResultPtr);
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"concatenation failed: unable to alloc %u bytes",
|
| ︙ | ︙ | |||
3425 3426 3427 3428 3429 3430 3431 | * case-sensitive (which is all that really makes sense with byte * arrays anyway, and we have no memcasecmp() for some reason... :^) */ s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len); s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len); memCmpFn = memcmp; | | | | 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 |
* case-sensitive (which is all that really makes sense with byte
* arrays anyway, and we have no memcasecmp() for some reason... :^)
*/
s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len);
s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
memCmpFn = memcmp;
} else if (TclHasInternalRep(value1Ptr, &tclStringType)
&& TclHasInternalRep(value2Ptr, &tclStringType)) {
/*
* Do a unicode-specific comparison if both of the args are of
* String type. If the char length == byte length, we can do a
* memcmp. In benchmark testing this proved the most efficient
* check between the unicode and string comparison operations.
*/
|
| ︙ | ︙ | |||
3664 3665 3666 3667 3668 3669 3670 |
if ((*checkStr == *un) && (0 ==
memcmp(checkStr + 1, un + 1, (ln-1) * sizeof(Tcl_UniChar)))) {
value = (checkStr - uh);
goto firstEnd;
}
}
firstEnd:
| | | 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 |
if ((*checkStr == *un) && (0 ==
memcmp(checkStr + 1, un + 1, (ln-1) * sizeof(Tcl_UniChar)))) {
value = (checkStr - uh);
goto firstEnd;
}
}
firstEnd:
TclNewIndexObj(result, value);
return result;
}
/*
*---------------------------------------------------------------------------
*
* TclStringLast --
|
| ︙ | ︙ | |||
3751 3752 3753 3754 3755 3756 3757 |
&& (0 == memcmp(checkStr+1, un+1, (ln-1)*sizeof(Tcl_UniChar)))) {
value = (checkStr - uh);
goto lastEnd;
}
checkStr--;
}
lastEnd:
| | | 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 |
&& (0 == memcmp(checkStr+1, un+1, (ln-1)*sizeof(Tcl_UniChar)))) {
value = (checkStr - uh);
goto lastEnd;
}
checkStr--;
}
lastEnd:
TclNewIndexObj(result, value);
return result;
}
/*
*---------------------------------------------------------------------------
*
* TclStringReverse --
|
| ︙ | ︙ | |||
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 |
}
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode) {
Tcl_UniChar *from = Tcl_GetUnicode(objPtr);
Tcl_UniChar *src = from + stringPtr->numChars;
Tcl_UniChar *to;
if (!inPlace || Tcl_IsShared(objPtr)) {
/*
* Create a non-empty, pure unicode value, so we can coax
* Tcl_SetObjLength into growing the unicode rep buffer.
*/
objPtr = Tcl_NewUnicodeObj(&ch, 1);
Tcl_SetObjLength(objPtr, stringPtr->numChars);
to = Tcl_GetUnicode(objPtr);
while (--src >= from) {
#if TCL_UTF_MAX < 4
ch = *src;
if ((ch & 0xF800) == 0xD800) {
needFlip = 1;
}
*to++ = ch;
| > > | 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 |
}
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode) {
Tcl_UniChar *from = Tcl_GetUnicode(objPtr);
stringPtr = GET_STRING(objPtr);
Tcl_UniChar *src = from + stringPtr->numChars;
Tcl_UniChar *to;
if (!inPlace || Tcl_IsShared(objPtr)) {
/*
* Create a non-empty, pure unicode value, so we can coax
* Tcl_SetObjLength into growing the unicode rep buffer.
*/
objPtr = Tcl_NewUnicodeObj(&ch, 1);
Tcl_SetObjLength(objPtr, stringPtr->numChars);
to = Tcl_GetUnicode(objPtr);
stringPtr = GET_STRING(objPtr);
while (--src >= from) {
#if TCL_UTF_MAX < 4
ch = *src;
if ((ch & 0xF800) == 0xD800) {
needFlip = 1;
}
*to++ = ch;
|
| ︙ | ︙ | |||
4141 4142 4143 4144 4145 4146 4147 |
stringPtr->hasUnicode = 1;
if (bytes) {
stringPtr->numChars = needed;
} else {
numAppendChars = 0;
}
| | > > > > > > > > > | > > > > | 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 |
stringPtr->hasUnicode = 1;
if (bytes) {
stringPtr->numChars = needed;
} else {
numAppendChars = 0;
}
dst = stringPtr->unicode + numOrigChars;
if (numAppendChars-- > 0) {
bytes += TclUtfToUniChar(bytes, &unichar);
#if TCL_UTF_MAX > 3
/* join upper/lower surrogate */
if (bytes && (stringPtr->unicode[numOrigChars - 1] | 0x3FF) == 0xDBFF && (unichar | 0x3FF) == 0xDFFF) {
stringPtr->numChars--;
unichar = ((stringPtr->unicode[numOrigChars - 1] & 0x3FF) << 10) + (unichar & 0x3FF) + 0x10000;
dst--;
}
#endif
*dst++ = unichar;
while (numAppendChars-- > 0) {
bytes += TclUtfToUniChar(bytes, &unichar);
*dst++ = unichar;
}
}
*dst = 0;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
4245 4246 4247 4248 4249 4250 4251 |
*/
static int
SetStringFromAny(
TCL_UNUSED(Tcl_Interp *),
Tcl_Obj *objPtr) /* The object to convert. */
{
| | | | | 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 |
*/
static int
SetStringFromAny(
TCL_UNUSED(Tcl_Interp *),
Tcl_Obj *objPtr) /* The object to convert. */
{
if (!TclHasInternalRep(objPtr, &tclStringType)) {
String *stringPtr = stringAlloc(0);
/*
* Convert whatever we have into an untyped value. Just A String.
*/
(void) TclGetString(objPtr);
TclFreeInternalRep(objPtr);
/*
* Create a basic String internalrep that just points to the UTF-8 string
* already in place at objPtr->bytes.
*/
stringPtr->numChars = -1;
stringPtr->allocated = objPtr->length;
stringPtr->maxChars = 0;
stringPtr->hasUnicode = 0;
|
| ︙ | ︙ |
Changes to generic/tclStringRep.h.
| ︙ | ︙ | |||
63 64 65 66 67 68 69 |
* of this field depends on the 'maxChars'
* field above. */
} String;
#define STRING_MAXCHARS \
(int)(((size_t)UINT_MAX - 1 - offsetof(String, unicode))/sizeof(Tcl_UniChar))
#define STRING_SIZE(numChars) \
| | | 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 |
* of this field depends on the 'maxChars'
* field above. */
} String;
#define STRING_MAXCHARS \
(int)(((size_t)UINT_MAX - 1 - offsetof(String, unicode))/sizeof(Tcl_UniChar))
#define STRING_SIZE(numChars) \
(offsetof(String, unicode) + (((numChars) + 1U) * sizeof(Tcl_UniChar)))
#define stringCheckLimits(numChars) \
do { \
if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \
Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
(int)STRING_MAXCHARS); \
} \
} while (0)
|
| ︙ | ︙ |
Changes to generic/tclStubInit.c.
| ︙ | ︙ | |||
61 62 63 64 65 66 67 | #undef Tcl_SetIntObj #undef Tcl_SetLongObj #undef TclpInetNtoa #undef TclWinGetServByName #undef TclWinGetSockOpt #undef TclWinSetSockOpt #undef TclWinNToHS | | | > > > > > > > | 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 |
#undef Tcl_SetIntObj
#undef Tcl_SetLongObj
#undef TclpInetNtoa
#undef TclWinGetServByName
#undef TclWinGetSockOpt
#undef TclWinSetSockOpt
#undef TclWinNToHS
#undef TclStaticLibrary
#undef Tcl_BackgroundError
#undef TclGuessPackageName
#undef TclGetLoadedPackages
#define TclStaticLibrary Tcl_StaticLibrary
#undef Tcl_UniCharToUtfDString
#undef Tcl_UtfToUniCharDString
#undef Tcl_UtfToUniChar
#undef Tcl_MacOSXOpenBundleResources
#undef TclWinConvertWSAError
#undef TclWinConvertError
#if defined(_WIN32) || defined(__CYGWIN__)
#define TclWinConvertWSAError (void (*)(DWORD))(void *)Tcl_WinConvertError
#define TclWinConvertError (void (*)(DWORD))(void *)Tcl_WinConvertError
#endif
#if TCL_UTF_MAX > 3
static void uniCodePanic(void) {
Tcl_Panic("This extension uses a deprecated function, not available now: Tcl is compiled with -DTCL_UTF_MAX==%d", TCL_UTF_MAX);
}
# define Tcl_GetUnicode (int *(*)(Tcl_Obj *))(void *)uniCodePanic
# define Tcl_GetUnicodeFromObj (int *(*)(Tcl_Obj *, Tcl_UniChar *))(void *)uniCodePanic
|
| ︙ | ︙ | |||
175 176 177 178 179 180 181 | #define TclBN_s_mp_mul_digs_fast s_mp_mul_digs_fast #define TclBN_s_mp_reverse s_mp_reverse #define TclBN_s_mp_sqr s_mp_sqr #define TclBN_s_mp_sqr_fast s_mp_sqr_fast #define TclBN_s_mp_sub s_mp_sub #define TclBN_mp_toom_mul s_mp_toom_mul #define TclBN_mp_toom_sqr s_mp_toom_sqr | | | 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 | #define TclBN_s_mp_mul_digs_fast s_mp_mul_digs_fast #define TclBN_s_mp_reverse s_mp_reverse #define TclBN_s_mp_sqr s_mp_sqr #define TclBN_s_mp_sqr_fast s_mp_sqr_fast #define TclBN_s_mp_sub s_mp_sub #define TclBN_mp_toom_mul s_mp_toom_mul #define TclBN_mp_toom_sqr s_mp_toom_sqr #define TclUnusedStubEntry 0 /* See bug 510001: TclSockMinimumBuffers needs plat imp */ #if defined(_WIN64) || defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 # define TclSockMinimumBuffersOld 0 #else #define TclSockMinimumBuffersOld sockMinimumBuffersOld static int TclSockMinimumBuffersOld(int sock, int size) |
| ︙ | ︙ | |||
288 289 290 291 292 293 294 295 296 297 298 299 300 301 |
# define Tcl_FreeResult 0
# define Tcl_ChannelSeekProc 0
# define Tcl_ChannelCloseProc 0
# define Tcl_Close 0
# define Tcl_MacOSXOpenBundleResources 0
# define TclGuessPackageName 0
# define TclGetLoadedPackages 0
#else
#define TclGuessPackageName guessPackageName
static int TclGuessPackageName(
TCL_UNUSED(const char *),
TCL_UNUSED(Tcl_DString *)) {
return 0;
| > > | 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 |
# define Tcl_FreeResult 0
# define Tcl_ChannelSeekProc 0
# define Tcl_ChannelCloseProc 0
# define Tcl_Close 0
# define Tcl_MacOSXOpenBundleResources 0
# define TclGuessPackageName 0
# define TclGetLoadedPackages 0
# undef TclSetPreInitScript
# define TclSetPreInitScript 0
#else
#define TclGuessPackageName guessPackageName
static int TclGuessPackageName(
TCL_UNUSED(const char *),
TCL_UNUSED(Tcl_DString *)) {
return 0;
|
| ︙ | ︙ | |||
624 625 626 627 628 629 630 | # define Tcl_AddErrorInfo 0 # undef Tcl_AddObjErrorInfo # define Tcl_AddObjErrorInfo 0 # undef Tcl_Eval # define Tcl_Eval 0 # undef Tcl_GlobalEval # define Tcl_GlobalEval 0 | < < | 633 634 635 636 637 638 639 640 641 642 643 644 645 646 | # define Tcl_AddErrorInfo 0 # undef Tcl_AddObjErrorInfo # define Tcl_AddObjErrorInfo 0 # undef Tcl_Eval # define Tcl_Eval 0 # undef Tcl_GlobalEval # define Tcl_GlobalEval 0 # undef Tcl_SaveResult # define Tcl_SaveResult 0 # undef Tcl_RestoreResult # define Tcl_RestoreResult 0 # undef Tcl_DiscardResult # define Tcl_DiscardResult 0 # undef Tcl_SetResult |
| ︙ | ︙ | |||
1028 1029 1030 1031 1032 1033 1034 |
TclSetChildCancelFlags, /* 250 */
TclRegisterLiteral, /* 251 */
TclPtrGetVar, /* 252 */
TclPtrSetVar, /* 253 */
TclPtrIncrObjVar, /* 254 */
TclPtrObjMakeUpvar, /* 255 */
TclPtrUnsetVar, /* 256 */
| | < | | 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 |
TclSetChildCancelFlags, /* 250 */
TclRegisterLiteral, /* 251 */
TclPtrGetVar, /* 252 */
TclPtrSetVar, /* 253 */
TclPtrIncrObjVar, /* 254 */
TclPtrObjMakeUpvar, /* 255 */
TclPtrUnsetVar, /* 256 */
TclStaticLibrary, /* 257 */
TclpCreateTemporaryDirectory, /* 258 */
TclUnusedStubEntry, /* 259 */
};
static const TclIntPlatStubs tclIntPlatStubs = {
TCL_STUB_MAGIC,
0,
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
TclGetAndDetachPids, /* 0 */
|
| ︙ | ︙ | |||
1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 |
static const TclPlatStubs tclPlatStubs = {
TCL_STUB_MAGIC,
0,
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
Tcl_WinUtfToTChar, /* 0 */
Tcl_WinTCharToUtf, /* 1 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
Tcl_MacOSXOpenBundleResources, /* 0 */
Tcl_MacOSXOpenVersionedBundleResources, /* 1 */
Tcl_MacOSXNotifierAddRunLoopMode, /* 2 */
#endif /* MACOSX */
};
| > > | 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 |
static const TclPlatStubs tclPlatStubs = {
TCL_STUB_MAGIC,
0,
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
Tcl_WinUtfToTChar, /* 0 */
Tcl_WinTCharToUtf, /* 1 */
0, /* 2 */
Tcl_WinConvertError, /* 3 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
Tcl_MacOSXOpenBundleResources, /* 0 */
Tcl_MacOSXOpenVersionedBundleResources, /* 1 */
Tcl_MacOSXNotifierAddRunLoopMode, /* 2 */
#endif /* MACOSX */
};
|
| ︙ | ︙ | |||
1515 1516 1517 1518 1519 1520 1521 |
Tcl_SetVar, /* 237 */
Tcl_SetVar2, /* 238 */
Tcl_SignalId, /* 239 */
Tcl_SignalMsg, /* 240 */
Tcl_SourceRCFile, /* 241 */
Tcl_SplitList, /* 242 */
Tcl_SplitPath, /* 243 */
| | | 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 |
Tcl_SetVar, /* 237 */
Tcl_SetVar2, /* 238 */
Tcl_SignalId, /* 239 */
Tcl_SignalMsg, /* 240 */
Tcl_SourceRCFile, /* 241 */
Tcl_SplitList, /* 242 */
Tcl_SplitPath, /* 243 */
Tcl_StaticLibrary, /* 244 */
Tcl_StringMatch, /* 245 */
Tcl_TellOld, /* 246 */
Tcl_TraceVar, /* 247 */
Tcl_TraceVar2, /* 248 */
Tcl_TranslateFileName, /* 249 */
Tcl_Ungets, /* 250 */
Tcl_UnlinkVar, /* 251 */
|
| ︙ | ︙ | |||
1623 1624 1625 1626 1627 1628 1629 |
Tcl_UniCharIsAlnum, /* 345 */
Tcl_UniCharIsAlpha, /* 346 */
Tcl_UniCharIsDigit, /* 347 */
Tcl_UniCharIsLower, /* 348 */
Tcl_UniCharIsSpace, /* 349 */
Tcl_UniCharIsUpper, /* 350 */
Tcl_UniCharIsWordChar, /* 351 */
| | | 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 |
Tcl_UniCharIsAlnum, /* 345 */
Tcl_UniCharIsAlpha, /* 346 */
Tcl_UniCharIsDigit, /* 347 */
Tcl_UniCharIsLower, /* 348 */
Tcl_UniCharIsSpace, /* 349 */
Tcl_UniCharIsUpper, /* 350 */
Tcl_UniCharIsWordChar, /* 351 */
Tcl_Char16Len, /* 352 */
Tcl_UniCharNcmp, /* 353 */
Tcl_Char16ToUtfDString, /* 354 */
Tcl_UtfToChar16DString, /* 355 */
Tcl_GetRegExpFromObj, /* 356 */
Tcl_EvalTokens, /* 357 */
Tcl_FreeParse, /* 358 */
Tcl_LogCommandInfo, /* 359 */
|
| ︙ | ︙ | |||
1907 1908 1909 1910 1911 1912 1913 |
Tcl_FSUnloadFile, /* 629 */
Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
Tcl_OpenTcpServerEx, /* 631 */
TclZipfs_Mount, /* 632 */
TclZipfs_Unmount, /* 633 */
TclZipfs_TclLibrary, /* 634 */
TclZipfs_MountBuffer, /* 635 */
| | | | | | > > > > > > > > > > > > | 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 |
Tcl_FSUnloadFile, /* 629 */
Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
Tcl_OpenTcpServerEx, /* 631 */
TclZipfs_Mount, /* 632 */
TclZipfs_Unmount, /* 633 */
TclZipfs_TclLibrary, /* 634 */
TclZipfs_MountBuffer, /* 635 */
Tcl_FreeInternalRep, /* 636 */
Tcl_InitStringRep, /* 637 */
Tcl_FetchInternalRep, /* 638 */
Tcl_StoreInternalRep, /* 639 */
Tcl_HasStringRep, /* 640 */
Tcl_IncrRefCount, /* 641 */
Tcl_DecrRefCount, /* 642 */
Tcl_IsShared, /* 643 */
Tcl_LinkArray, /* 644 */
Tcl_GetIntForIndex, /* 645 */
Tcl_UtfToUniChar, /* 646 */
Tcl_UniCharToUtfDString, /* 647 */
Tcl_UtfToUniCharDString, /* 648 */
TclGetBytesFromObj, /* 649 */
Tcl_GetBytesFromObj, /* 650 */
TclGetStringFromObj, /* 651 */
TclGetUnicodeFromObj, /* 652 */
TclGetByteArrayFromObj, /* 653 */
Tcl_UtfCharComplete, /* 654 */
Tcl_UtfNext, /* 655 */
Tcl_UtfPrev, /* 656 */
Tcl_UniCharIsUnicode, /* 657 */
0, /* 658 */
0, /* 659 */
Tcl_AsyncMarkFromSignal, /* 660 */
0, /* 661 */
0, /* 662 */
0, /* 663 */
0, /* 664 */
0, /* 665 */
0, /* 666 */
0, /* 667 */
Tcl_UniCharLen, /* 668 */
};
/* !END!: Do not edit above this line. */
|
Changes to generic/tclTest.c.
| ︙ | ︙ | |||
159 160 161 162 163 164 165 | /* * Forward declarations for procedures defined later in this file: */ static int AsyncHandlerProc(void *clientData, Tcl_Interp *interp, int code); | < < | 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 | /* * Forward declarations for procedures defined later in this file: */ static int AsyncHandlerProc(void *clientData, Tcl_Interp *interp, int code); static Tcl_ThreadCreateType AsyncThreadProc(void *); static void CleanupTestSetassocdataTests( void *clientData, Tcl_Interp *interp); static void CmdDelProc1(void *clientData); static void CmdDelProc2(void *clientData); static Tcl_CmdProc CmdProc1; static Tcl_CmdProc CmdProc2; static void CmdTraceDeleteProc( |
| ︙ | ︙ | |||
273 274 275 276 277 278 279 | static void TestsaveresultFree(char *blockPtr); static Tcl_CmdProc TestsetassocdataCmd; static Tcl_CmdProc TestsetCmd; static Tcl_CmdProc Testset2Cmd; static Tcl_CmdProc TestseterrorcodeCmd; static Tcl_ObjCmdProc TestsetobjerrorcodeCmd; static Tcl_CmdProc TestsetplatformCmd; | | | 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 | static void TestsaveresultFree(char *blockPtr); static Tcl_CmdProc TestsetassocdataCmd; static Tcl_CmdProc TestsetCmd; static Tcl_CmdProc Testset2Cmd; static Tcl_CmdProc TestseterrorcodeCmd; static Tcl_ObjCmdProc TestsetobjerrorcodeCmd; static Tcl_CmdProc TestsetplatformCmd; static Tcl_CmdProc TeststaticlibraryCmd; static Tcl_CmdProc TesttranslatefilenameCmd; static Tcl_CmdProc TestupvarCmd; static Tcl_ObjCmdProc TestWrongNumArgsObjCmd; static Tcl_ObjCmdProc TestGetIndexFromObjStructObjCmd; static Tcl_CmdProc TestChannelCmd; static Tcl_CmdProc TestChannelEventCmd; static Tcl_CmdProc TestSocketCmd; |
| ︙ | ︙ | |||
325 326 327 328 329 330 331 332 333 334 335 336 | static Tcl_FSMatchInDirectoryProc SimpleMatchInDirectory; static Tcl_ObjCmdProc TestUtfNextCmd; static Tcl_ObjCmdProc TestUtfPrevCmd; static Tcl_ObjCmdProc TestNumUtfCharsCmd; static Tcl_ObjCmdProc TestFindFirstCmd; static Tcl_ObjCmdProc TestFindLastCmd; static Tcl_ObjCmdProc TestHashSystemHashCmd; static Tcl_NRPostProc NREUnwind_callback; static Tcl_ObjCmdProc TestNREUnwind; static Tcl_ObjCmdProc TestNRELevels; static Tcl_ObjCmdProc TestInterpResolverCmd; | > | | 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 |
static Tcl_FSMatchInDirectoryProc SimpleMatchInDirectory;
static Tcl_ObjCmdProc TestUtfNextCmd;
static Tcl_ObjCmdProc TestUtfPrevCmd;
static Tcl_ObjCmdProc TestNumUtfCharsCmd;
static Tcl_ObjCmdProc TestFindFirstCmd;
static Tcl_ObjCmdProc TestFindLastCmd;
static Tcl_ObjCmdProc TestHashSystemHashCmd;
static Tcl_ObjCmdProc TestGetIntForIndexCmd;
static Tcl_NRPostProc NREUnwind_callback;
static Tcl_ObjCmdProc TestNREUnwind;
static Tcl_ObjCmdProc TestNRELevels;
static Tcl_ObjCmdProc TestInterpResolverCmd;
#if defined(HAVE_CPUID)
static Tcl_ObjCmdProc TestcpuidCmd;
#endif
static const Tcl_Filesystem testReportingFilesystem = {
"reporting",
sizeof(Tcl_Filesystem),
TCL_FILESYSTEM_VERSION_1,
|
| ︙ | ︙ | |||
596 597 598 599 600 601 602 603 604 605 606 |
TestUtfPrevCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testnumutfchars",
TestNumUtfCharsCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testfindfirst",
TestFindFirstCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testfindlast",
TestFindLastCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testsocket", TestSocketCmd,
NULL, NULL);
| > > | | | 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 |
TestUtfPrevCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testnumutfchars",
TestNumUtfCharsCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testfindfirst",
TestFindFirstCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testfindlast",
TestFindLastCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testgetintforindex",
TestGetIntForIndexCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testsocket", TestSocketCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "teststaticlibrary", TeststaticlibraryCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testtranslatefilename",
TesttranslatefilenameCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL,
NULL);
Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
NULL, NULL);
#if defined(HAVE_CPUID)
Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd,
NULL, NULL);
#endif
Tcl_CreateObjCommand(interp, "testnreunwind", TestNREUnwind,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels,
NULL, NULL);
|
| ︙ | ︙ | |||
755 756 757 758 759 760 761 |
asyncPtr->id = nextId;
nextId++;
asyncPtr->handler = Tcl_AsyncCreate(AsyncHandlerProc,
INT2PTR(asyncPtr->id));
asyncPtr->nextPtr = firstHandler;
firstHandler = asyncPtr;
Tcl_MutexUnlock(&asyncTestMutex);
| | | 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 |
asyncPtr->id = nextId;
nextId++;
asyncPtr->handler = Tcl_AsyncCreate(AsyncHandlerProc,
INT2PTR(asyncPtr->id));
asyncPtr->nextPtr = firstHandler;
firstHandler = asyncPtr;
Tcl_MutexUnlock(&asyncTestMutex);
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(asyncPtr->id));
} else if (strcmp(argv[1], "delete") == 0) {
if (argc == 2) {
Tcl_MutexLock(&asyncTestMutex);
while (firstHandler != NULL) {
asyncPtr = firstHandler;
firstHandler = asyncPtr->nextPtr;
Tcl_AsyncDelete(asyncPtr->handler);
|
| ︙ | ︙ | |||
811 812 813 814 815 816 817 | Tcl_AsyncMark(asyncPtr->handler); break; } } Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], -1)); Tcl_MutexUnlock(&asyncTestMutex); return code; | < | 812 813 814 815 816 817 818 819 820 821 822 823 824 825 |
Tcl_AsyncMark(asyncPtr->handler);
break;
}
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], -1));
Tcl_MutexUnlock(&asyncTestMutex);
return code;
} else if (strcmp(argv[1], "marklater") == 0) {
if (argc != 3) {
goto wrongNumArgs;
}
if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) {
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
839 840 841 842 843 844 845 |
}
}
Tcl_MutexUnlock(&asyncTestMutex);
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
"\": must be create, delete, int, mark, or marklater", NULL);
return TCL_ERROR;
| < < < < < < | 839 840 841 842 843 844 845 846 847 848 849 850 851 852 |
}
}
Tcl_MutexUnlock(&asyncTestMutex);
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
"\": must be create, delete, int, mark, or marklater", NULL);
return TCL_ERROR;
}
return TCL_OK;
}
static int
AsyncHandlerProc(
void *clientData, /* If of TestAsyncHandler structure.
|
| ︙ | ︙ | |||
910 911 912 913 914 915 916 | * * Side effects: * Invokes Tcl_AsyncMark on the handler * *---------------------------------------------------------------------- */ | < | 904 905 906 907 908 909 910 911 912 913 914 915 916 917 |
*
* Side effects:
* Invokes Tcl_AsyncMark on the handler
*
*----------------------------------------------------------------------
*/
static Tcl_ThreadCreateType
AsyncThreadProc(
void *clientData) /* Parameter is the id of a
* TestAsyncHandler, defined above. */
{
TestAsyncHandler *asyncPtr;
int id = PTR2INT(clientData);
|
| ︙ | ︙ | |||
932 933 934 935 936 937 938 |
break;
}
}
Tcl_MutexUnlock(&asyncTestMutex);
Tcl_ExitThread(TCL_OK);
TCL_THREAD_CREATE_RETURN;
}
| < | 925 926 927 928 929 930 931 932 933 934 935 936 937 938 |
break;
}
}
Tcl_MutexUnlock(&asyncTestMutex);
Tcl_ExitThread(TCL_OK);
TCL_THREAD_CREATE_RETURN;
}
static int
TestbumpinterpepochObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
|
| ︙ | ︙ | |||
1027 1028 1029 1030 1031 1032 1033 |
info.proc = CmdProc2;
info.clientData = (void *) "new_command_data";
info.objProc = NULL;
info.objClientData = NULL;
info.deleteProc = CmdDelProc2;
info.deleteData = (void *) "new_delete_data";
if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) {
| | | | 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 |
info.proc = CmdProc2;
info.clientData = (void *) "new_command_data";
info.objProc = NULL;
info.objClientData = NULL;
info.deleteProc = CmdDelProc2;
info.deleteData = (void *) "new_delete_data";
if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) {
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
} else {
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(1));
}
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
"\": must be create, delete, get, or modify", NULL);
return TCL_ERROR;
}
return TCL_OK;
|
| ︙ | ︙ | |||
1624 1625 1626 1627 1628 1629 1630 |
static int
TestdoubledigitsObjCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
int objc, /* Parameter count */
Tcl_Obj* const objv[]) /* Parameter vector */
{
| | | | | | | 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 |
static int
TestdoubledigitsObjCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
int objc, /* Parameter count */
Tcl_Obj* const objv[]) /* Parameter vector */
{
static const char *options[] = {
"shortest",
"e",
"f",
NULL
};
static const int types[] = {
TCL_DD_SHORTEST,
TCL_DD_E_FORMAT,
TCL_DD_F_FORMAT
};
const Tcl_ObjType* doubleType;
double d;
int status;
int ndigits;
int type;
int decpt;
int signum;
char *str;
char *endPtr;
Tcl_Obj* strObj;
Tcl_Obj* retval;
if (objc < 4 || objc > 5) {
Tcl_WrongNumArgs(interp, 1, objv, "fpval ndigits type ?shorten?");
return TCL_ERROR;
}
status = Tcl_GetDoubleFromObj(interp, objv[1], &d);
if (status != TCL_OK) {
doubleType = Tcl_GetObjType("double");
if (Tcl_FetchInternalRep(objv[1], doubleType)
&& isnan(objv[1]->internalRep.doubleValue)) {
status = TCL_OK;
memcpy(&d, &(objv[1]->internalRep.doubleValue), sizeof(double));
}
}
if (status != TCL_OK
|| Tcl_GetIntFromObj(interp, objv[2], &ndigits) != TCL_OK
|| Tcl_GetIndexFromObj(interp, objv[3], options, "conversion type",
|
| ︙ | ︙ | |||
1680 1681 1682 1683 1684 1685 1686 |
}
type |= TCL_DD_SHORTEST;
}
str = TclDoubleDigits(d, ndigits, type, &decpt, &signum, &endPtr);
strObj = Tcl_NewStringObj(str, endPtr-str);
ckfree(str);
retval = Tcl_NewListObj(1, &strObj);
| | | 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 |
}
type |= TCL_DD_SHORTEST;
}
str = TclDoubleDigits(d, ndigits, type, &decpt, &signum, &endPtr);
strObj = Tcl_NewStringObj(str, endPtr-str);
ckfree(str);
retval = Tcl_NewListObj(1, &strObj);
Tcl_ListObjAppendElement(NULL, retval, Tcl_NewWideIntObj(decpt));
strObj = Tcl_NewStringObj(signum ? "-" : "+", 1);
Tcl_ListObjAppendElement(NULL, retval, strObj);
Tcl_SetObjResult(interp, retval);
return TCL_OK;
}
/*
|
| ︙ | ︙ | |||
1759 1760 1761 1762 1763 1764 1765 |
} else if (strcmp(argv[2], "staticlarge") == 0) {
Tcl_AppendResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", NULL);
} else if (strcmp(argv[2], "free") == 0) {
char *s = (char *)ckalloc(100);
strcpy(s, "This is a malloc-ed string");
Tcl_SetResult(interp, s, TCL_DYNAMIC);
} else if (strcmp(argv[2], "special") == 0) {
| | | | 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 |
} else if (strcmp(argv[2], "staticlarge") == 0) {
Tcl_AppendResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", NULL);
} else if (strcmp(argv[2], "free") == 0) {
char *s = (char *)ckalloc(100);
strcpy(s, "This is a malloc-ed string");
Tcl_SetResult(interp, s, TCL_DYNAMIC);
} else if (strcmp(argv[2], "special") == 0) {
char *s = (char *)ckalloc(100) + 16;
strcpy(s, "This is a specially-allocated string");
Tcl_SetResult(interp, s, SpecialFree);
} else {
Tcl_AppendResult(interp, "bad gresult option \"", argv[2],
"\": must be staticsmall, staticlarge, free, or special",
NULL);
return TCL_ERROR;
}
Tcl_DStringGetResult(interp, &dstring);
} else if (strcmp(argv[1], "length") == 0) {
if (argc != 2) {
goto wrongNumArgs;
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_DStringLength(&dstring)));
} else if (strcmp(argv[1], "result") == 0) {
if (argc != 2) {
goto wrongNumArgs;
}
Tcl_DStringResult(interp, &dstring);
} else if (strcmp(argv[1], "trunc") == 0) {
if (argc != 3) {
|
| ︙ | ︙ | |||
1892 1893 1894 1895 1896 1897 1898 |
return TCL_ERROR;
}
if (TCL_OK != Tcl_GetEncodingFromObj(interp, objv[2], &encoding)) {
return TCL_ERROR;
}
Tcl_FreeEncoding(encoding); /* Free returned reference */
Tcl_FreeEncoding(encoding); /* Free to match CREATE */
| | | 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 |
return TCL_ERROR;
}
if (TCL_OK != Tcl_GetEncodingFromObj(interp, objv[2], &encoding)) {
return TCL_ERROR;
}
Tcl_FreeEncoding(encoding); /* Free returned reference */
Tcl_FreeEncoding(encoding); /* Free to match CREATE */
TclFreeInternalRep(objv[2]); /* Free the cached ref */
break;
}
return TCL_OK;
}
static int
EncodingToUtfProc(
|
| ︙ | ︙ | |||
3538 3539 3540 3541 3542 3543 3544 |
parsePtr->commentSize));
} else {
Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj("-", 1));
}
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj(parsePtr->commandStart, parsePtr->commandSize));
Tcl_ListObjAppendElement(NULL, objPtr,
| | | 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 |
parsePtr->commentSize));
} else {
Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj("-", 1));
}
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj(parsePtr->commandStart, parsePtr->commandSize));
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewWideIntObj(parsePtr->numWords));
for (i = 0; i < parsePtr->numTokens; i++) {
tokenPtr = &parsePtr->tokenPtr[i];
switch (tokenPtr->type) {
case TCL_TOKEN_EXPAND_WORD:
typeString = "expand";
break;
case TCL_TOKEN_WORD:
|
| ︙ | ︙ | |||
3578 3579 3580 3581 3582 3583 3584 | break; } Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(typeString, -1)); Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(tokenPtr->start, tokenPtr->size)); Tcl_ListObjAppendElement(NULL, objPtr, | | > | | 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 |
break;
}
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj(typeString, -1));
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj(tokenPtr->start, tokenPtr->size));
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewWideIntObj(tokenPtr->numComponents));
}
Tcl_ListObjAppendElement(NULL, objPtr,
parsePtr->commandStart ?
Tcl_NewStringObj(parsePtr->commandStart + parsePtr->commandSize,
-1) : Tcl_NewObj());
}
/*
*----------------------------------------------------------------------
*
* TestparsevarObjCmd --
*
|
| ︙ | ︙ | |||
3893 3894 3895 3896 3897 3898 3899 |
}
if (match == 0) {
/*
* Set the interpreter's object result to an integer object w/
* value 0.
*/
| | | 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 |
}
if (match == 0) {
/*
* Set the interpreter's object result to an integer object w/
* value 0.
*/
Tcl_SetWideIntObj(Tcl_GetObjResult(interp), 0);
if (objc > 2 && (cflags®_EXPECT) && indices) {
const char *varName;
const char *value;
int start, end;
char resinfo[TCL_INTEGER_SPACE * 2];
varName = Tcl_GetString(objv[2]);
|
| ︙ | ︙ | |||
3972 3973 3974 3975 3976 3977 3978 |
objs[1] = Tcl_NewWideIntObj(end);
newPtr = Tcl_NewListObj(2, objs);
} else {
if (ii == -1) {
TclRegExpRangeUniChar(regExpr, ii, &start, &end);
newPtr = Tcl_GetRange(objPtr, start, end);
| | | | 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 |
objs[1] = Tcl_NewWideIntObj(end);
newPtr = Tcl_NewListObj(2, objs);
} else {
if (ii == -1) {
TclRegExpRangeUniChar(regExpr, ii, &start, &end);
newPtr = Tcl_GetRange(objPtr, start, end);
} else if (ii > info.nsubs || info.matches[ii].end <= 0) {
newPtr = Tcl_NewObj();
} else {
newPtr = Tcl_GetRange(objPtr, info.matches[ii].start,
info.matches[ii].end - 1);
}
}
valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, TCL_LEAVE_ERR_MSG);
if (valuePtr == NULL) {
return TCL_ERROR;
}
}
/*
* Set the interpreter's object result to an integer object w/ value 1.
*/
Tcl_SetWideIntObj(Tcl_GetObjResult(interp), 1);
return TCL_OK;
}
/*
*---------------------------------------------------------------------------
*
* TestregexpXflags --
|
| ︙ | ︙ | |||
4213 4214 4215 4216 4217 4218 4219 |
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
| | | | | | | 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 |
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TeststaticlibraryCmd --
*
* This procedure implements the "teststaticlibrary" command.
* It is used to test the procedure Tcl_StaticLibrary.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* When the packge given by argv[1] is loaded into an interpeter,
* variable "x" in that interpreter is set to "loaded".
*
*----------------------------------------------------------------------
*/
static int
TeststaticlibraryCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
int safe, loaded;
if (argc != 4) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
argv[0], " prefix safe loaded\"", NULL);
return TCL_ERROR;
}
if (Tcl_GetInt(interp, argv[2], &safe) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_GetInt(interp, argv[3], &loaded) != TCL_OK) {
return TCL_ERROR;
}
Tcl_StaticLibrary((loaded) ? interp : NULL, argv[1],
StaticInitProc, (safe) ? StaticInitProc : NULL);
return TCL_OK;
}
static int
StaticInitProc(
Tcl_Interp *interp) /* Interpreter in which package is supposedly
|
| ︙ | ︙ | |||
5068 5069 5070 5071 5072 5073 5074 |
static int
TestbytestringObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
| | | | 5061 5062 5063 5064 5065 5066 5067 5068 5069 5070 5071 5072 5073 5074 5075 5076 5077 5078 5079 5080 5081 5082 5083 |
static int
TestbytestringObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
size_t n = 0;
const char *p;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "bytearray");
return TCL_ERROR;
}
p = (const char *)Tcl_GetBytesFromObj(interp, objv[1], &n);
if (p == NULL) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n));
return TCL_OK;
}
|
| ︙ | ︙ | |||
6206 6207 6208 6209 6210 6211 6212 |
}
if (newmode == 0) {
Tcl_SetServiceMode(TCL_SERVICE_NONE);
} else {
Tcl_SetServiceMode(TCL_SERVICE_ALL);
}
}
| | | 6199 6200 6201 6202 6203 6204 6205 6206 6207 6208 6209 6210 6211 6212 6213 |
}
if (newmode == 0) {
Tcl_SetServiceMode(TCL_SERVICE_NONE);
} else {
Tcl_SetServiceMode(TCL_SERVICE_ALL);
}
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(oldmode));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TestWrongNumArgsObjCmd --
|
| ︙ | ︙ | |||
6290 6291 6292 6293 6294 6295 6296 |
TestGetIndexFromObjStructObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *const ary[] = {
| | | > | | < < < < > > > > > > > > > > > | | | | 6283 6284 6285 6286 6287 6288 6289 6290 6291 6292 6293 6294 6295 6296 6297 6298 6299 6300 6301 6302 6303 6304 6305 6306 6307 6308 6309 6310 6311 6312 6313 6314 6315 6316 6317 6318 6319 6320 6321 6322 6323 6324 6325 6326 6327 6328 6329 |
TestGetIndexFromObjStructObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *const ary[] = {
"a", "b", "c", "d", "ee", "ff", NULL, NULL
};
int target, flags = 0;
signed char idx[8];
if (objc != 3 && objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "argument targetvalue ?flags?");
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, objv[2], &target) != TCL_OK) {
return TCL_ERROR;
}
if ((objc > 3) && (Tcl_GetIntFromObj(interp, objv[3], &flags) != TCL_OK)) {
return TCL_ERROR;
}
memset(idx, 85, sizeof(idx));
if (Tcl_GetIndexFromObjStruct(interp, (Tcl_GetString(objv[1])[0] ? objv[1] : NULL), ary, 2*sizeof(char *),
"dummy", flags, &idx[1]) != TCL_OK) {
return TCL_ERROR;
}
if (idx[0] != 85 || idx[2] != 85) {
Tcl_AppendResult(interp, "Tcl_GetIndexFromObjStruct overwrites bytes near index variable", NULL);
return TCL_ERROR;
} else if (idx[1] != target) {
char buffer[64];
sprintf(buffer, "%d", idx[1]);
Tcl_AppendResult(interp, "index value comparison failed: got ",
buffer, NULL);
sprintf(buffer, "%d", target);
Tcl_AppendResult(interp, " when ", buffer, " expected", NULL);
return TCL_ERROR;
}
Tcl_WrongNumArgs(interp, objc, objv, NULL);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TestFilesystemObjCmd --
|
| ︙ | ︙ | |||
6876 6877 6878 6879 6880 6881 6882 |
static int
TestUtfNextCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
| | | | | | 6877 6878 6879 6880 6881 6882 6883 6884 6885 6886 6887 6888 6889 6890 6891 6892 6893 6894 6895 6896 6897 6898 6899 6900 6901 6902 6903 6904 6905 6906 6907 |
static int
TestUtfNextCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
size_t numBytes;
char *bytes;
const char *result, *first;
char buffer[32];
static const char tobetested[] = "A\xA0\xC0\xC1\xC2\xD0\xE0\xE8\xF2\xF7\xF8\xFE\xFF";
const char *p = tobetested;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?-bytestring? bytes");
return TCL_ERROR;
}
bytes = Tcl_GetStringFromObj(objv[1], &numBytes);
if (numBytes + 4 > sizeof(buffer)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"testutfnext\" can only handle %" TCL_Z_MODIFIER "u bytes",
sizeof(buffer) - 4));
return TCL_ERROR;
}
memcpy(buffer + 1, bytes, numBytes);
buffer[0] = buffer[numBytes + 1] = buffer[numBytes + 2] = buffer[numBytes + 3] = '\xA0';
first = result = Tcl_UtfNext(buffer + 1);
|
| ︙ | ︙ | |||
6920 6921 6922 6923 6924 6925 6926 |
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"Tcl_UtfNext is not supposed to read src[end]\n"
"Different result when src[end] is %#x", UCHAR(p[-1])));
return TCL_ERROR;
}
}
| | | 6921 6922 6923 6924 6925 6926 6927 6928 6929 6930 6931 6932 6933 6934 6935 |
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"Tcl_UtfNext is not supposed to read src[end]\n"
"Different result when src[end] is %#x", UCHAR(p[-1])));
return TCL_ERROR;
}
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(first - buffer - 1));
return TCL_OK;
}
/*
* Used to check operations of Tcl_UtfPrev.
*
* Usage: testutfprev $bytes $offset
|
| ︙ | ︙ | |||
6962 6963 6964 6965 6966 6967 6968 |
if (offset > numBytes) {
offset = numBytes;
}
} else {
offset = numBytes;
}
result = Tcl_UtfPrev(bytes + offset, bytes);
| | | 6963 6964 6965 6966 6967 6968 6969 6970 6971 6972 6973 6974 6975 6976 6977 |
if (offset > numBytes) {
offset = numBytes;
}
} else {
offset = numBytes;
}
result = Tcl_UtfPrev(bytes + offset, bytes);
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result - bytes));
return TCL_OK;
}
/*
* Used to check correct string-length determining in Tcl_NumUtfChars
*/
|
| ︙ | ︙ | |||
6990 6991 6992 6993 6994 6995 6996 |
return TCL_ERROR;
}
if (limit > numBytes + 1) {
limit = numBytes + 1;
}
}
len = Tcl_NumUtfChars(bytes, limit);
| | | 6991 6992 6993 6994 6995 6996 6997 6998 6999 7000 7001 7002 7003 7004 7005 |
return TCL_ERROR;
}
if (limit > numBytes + 1) {
limit = numBytes + 1;
}
}
len = Tcl_NumUtfChars(bytes, limit);
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(len));
}
return TCL_OK;
}
/*
* Used to check correct operation of Tcl_UtfFindFirst
*/
|
| ︙ | ︙ | |||
7039 7040 7041 7042 7043 7044 7045 |
(void) Tcl_GetIntFromObj(interp, objv[2], &len);
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindLast(Tcl_GetString(objv[1]), len), -1));
}
return TCL_OK;
}
| > > > > > > > > > > > > > > > > > > > > > > > > > > > | | 7040 7041 7042 7043 7044 7045 7046 7047 7048 7049 7050 7051 7052 7053 7054 7055 7056 7057 7058 7059 7060 7061 7062 7063 7064 7065 7066 7067 7068 7069 7070 7071 7072 7073 7074 7075 7076 7077 7078 7079 7080 7081 |
(void) Tcl_GetIntFromObj(interp, objv[2], &len);
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindLast(Tcl_GetString(objv[1]), len), -1));
}
return TCL_OK;
}
static int
TestGetIntForIndexCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
int result;
Tcl_WideInt endvalue;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "index endvalue");
return TCL_ERROR;
}
if (Tcl_GetWideIntFromObj(interp, objv[2], &endvalue) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_GetIntForIndex(interp, objv[1], endvalue, &result) != TCL_OK) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result));
return TCL_OK;
}
#if defined(HAVE_CPUID)
/*
*----------------------------------------------------------------------
*
* TestcpuidCmd --
*
* Retrieves CPU ID information.
*
|
| ︙ | ︙ | |||
7088 7089 7090 7091 7092 7093 7094 |
status = TclWinCPUID(index, regs);
if (status != TCL_OK) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("operation not available", -1));
return status;
}
for (i=0 ; i<4 ; ++i) {
| | | 7116 7117 7118 7119 7120 7121 7122 7123 7124 7125 7126 7127 7128 7129 7130 |
status = TclWinCPUID(index, regs);
if (status != TCL_OK) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("operation not available", -1));
return status;
}
for (i=0 ; i<4 ; ++i) {
regsObjs[i] = Tcl_NewWideIntObj(regs[i]);
}
Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs));
return TCL_OK;
}
#endif
/*
|
| ︙ | ︙ | |||
7129 7130 7131 7132 7133 7134 7135 |
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
}
for (i=0 ; i<limit ; i++) {
hPtr = Tcl_CreateHashEntry(&hash, INT2PTR(i), &isNew);
if (!isNew) {
| | | | | 7157 7158 7159 7160 7161 7162 7163 7164 7165 7166 7167 7168 7169 7170 7171 7172 7173 7174 7175 7176 7177 7178 7179 7180 7181 7182 7183 7184 7185 7186 7187 7188 7189 7190 7191 7192 7193 7194 |
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
}
for (i=0 ; i<limit ; i++) {
hPtr = Tcl_CreateHashEntry(&hash, INT2PTR(i), &isNew);
if (!isNew) {
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i));
Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem",-1);
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
}
Tcl_SetHashValue(hPtr, INT2PTR(i+42));
}
if (hash.numEntries != limit) {
Tcl_AppendResult(interp, "unexpected maximal size", NULL);
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
}
for (i=0 ; i<limit ; i++) {
hPtr = Tcl_FindHashEntry(&hash, (char *) INT2PTR(i));
if (hPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i));
Tcl_AppendToObj(Tcl_GetObjResult(interp)," lookup problem",-1);
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
}
if (PTR2INT(Tcl_GetHashValue(hPtr)) != i+42) {
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i));
Tcl_AppendToObj(Tcl_GetObjResult(interp)," value problem",-1);
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
}
Tcl_DeleteHashEntry(hPtr);
}
|
| ︙ | ︙ | |||
7194 7195 7196 7197 7198 7199 7200 |
for (i=1 ; i<argc ; i++) {
if (Tcl_GetInt(interp, argv[i], &val) != TCL_OK) {
return TCL_ERROR;
}
total += val;
}
| | | | 7222 7223 7224 7225 7226 7227 7228 7229 7230 7231 7232 7233 7234 7235 7236 7237 7238 7239 7240 7241 7242 7243 7244 7245 7246 7247 7248 7249 7250 7251 7252 7253 7254 7255 |
for (i=1 ; i<argc ; i++) {
if (Tcl_GetInt(interp, argv[i], &val) != TCL_OK) {
return TCL_ERROR;
}
total += val;
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(total));
return TCL_OK;
}
}
/*
* Used for determining sizeof(long) at script level.
*/
static int
TestlongsizeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
int argc,
TCL_UNUSED(const char **) /*argv*/)
{
if (argc != 1) {
Tcl_AppendResult(interp, "wrong # args", NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(long)));
return TCL_OK;
}
static int
NREUnwind_callback(
void *data[],
Tcl_Interp *interp,
|
| ︙ | ︙ | |||
7236 7237 7238 7239 7240 7241 7242 |
Tcl_NRAddCallback(interp, NREUnwind_callback, data[0], &none,
INT2PTR(-1), NULL);
} else if (data[2] == INT2PTR(-1)) {
Tcl_NRAddCallback(interp, NREUnwind_callback, data[0], data[1],
&none, NULL);
} else {
Tcl_Obj *idata[3];
| | | | | 7264 7265 7266 7267 7268 7269 7270 7271 7272 7273 7274 7275 7276 7277 7278 7279 7280 |
Tcl_NRAddCallback(interp, NREUnwind_callback, data[0], &none,
INT2PTR(-1), NULL);
} else if (data[2] == INT2PTR(-1)) {
Tcl_NRAddCallback(interp, NREUnwind_callback, data[0], data[1],
&none, NULL);
} else {
Tcl_Obj *idata[3];
idata[0] = Tcl_NewWideIntObj((int) ((char *) data[1] - (char *) data[0]));
idata[1] = Tcl_NewWideIntObj((int) ((char *) data[2] - (char *) data[0]));
idata[2] = Tcl_NewWideIntObj((int) ((char *) &none - (char *) data[0]));
Tcl_SetObjResult(interp, Tcl_NewListObj(3, idata));
}
return TCL_OK;
}
static int
TestNREUnwind(
|
| ︙ | ︙ | |||
7282 7283 7284 7285 7286 7287 7288 |
if (refDepth == NULL) {
refDepth = &depth;
}
depth = (refDepth - &depth);
| | | | | | | | 7310 7311 7312 7313 7314 7315 7316 7317 7318 7319 7320 7321 7322 7323 7324 7325 7326 7327 7328 7329 7330 7331 7332 7333 7334 7335 |
if (refDepth == NULL) {
refDepth = &depth;
}
depth = (refDepth - &depth);
levels[0] = Tcl_NewWideIntObj(depth);
levels[1] = Tcl_NewWideIntObj(iPtr->numLevels);
levels[2] = Tcl_NewWideIntObj(iPtr->cmdFramePtr->level);
levels[3] = Tcl_NewWideIntObj(iPtr->varFramePtr->level);
levels[4] = Tcl_NewWideIntObj(iPtr->execEnvPtr->execStackPtr->tosPtr
- iPtr->execEnvPtr->execStackPtr->stackWords);
while (cbPtr) {
i++;
cbPtr = cbPtr->nextPtr;
}
levels[5] = Tcl_NewWideIntObj(i);
Tcl_SetObjResult(interp, Tcl_NewListObj(6, levels));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
7694 7695 7696 7697 7698 7699 7700 |
TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END
};
foo = 0;
if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, &remObjv)!=TCL_OK) {
return TCL_ERROR;
}
| | | | 7722 7723 7724 7725 7726 7727 7728 7729 7730 7731 7732 7733 7734 7735 7736 7737 |
TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END
};
foo = 0;
if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, &remObjv)!=TCL_OK) {
return TCL_ERROR;
}
result[0] = Tcl_NewWideIntObj(foo);
result[1] = Tcl_NewWideIntObj(count);
result[2] = Tcl_NewListObj(count, remObjv);
Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));
ckfree(remObjv);
return TCL_OK;
}
/**
|
| ︙ | ︙ |
Changes to generic/tclTestObj.c.
| ︙ | ︙ | |||
34 35 36 37 38 39 40 | #pragma GCC diagnostic ignored "-Wdeprecated-declarations" #endif /* * Forward declarations for functions defined later in this file: */ | | | | | < | 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 |
#pragma GCC diagnostic ignored "-Wdeprecated-declarations"
#endif
/*
* Forward declarations for functions defined later in this file:
*/
static int CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, size_t varIndex);
static int GetVariableIndex(Tcl_Interp *interp,
Tcl_Obj *obj, size_t *indexPtr);
static void SetVarToObj(Tcl_Obj **varPtr, size_t varIndex, Tcl_Obj *objPtr);
static Tcl_ObjCmdProc TestbignumobjCmd;
static Tcl_ObjCmdProc TestbooleanobjCmd;
static Tcl_ObjCmdProc TestdoubleobjCmd;
static Tcl_ObjCmdProc TestindexobjCmd;
static Tcl_ObjCmdProc TestintobjCmd;
static Tcl_ObjCmdProc TestlistobjCmd;
static Tcl_ObjCmdProc TestobjCmd;
static Tcl_ObjCmdProc TeststringobjCmd;
#define VARPTR_KEY "TCLOBJTEST_VARPTR"
#define NUMBER_OF_OBJECT_VARS 20
static void VarPtrDeleteProc(void *clientData, TCL_UNUSED(Tcl_Interp *))
{
int i;
Tcl_Obj **varPtr = (Tcl_Obj **) clientData;
for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) {
if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]);
}
ckfree(varPtr);
}
static Tcl_Obj **GetVarPtr(Tcl_Interp *interp)
{
Tcl_InterpDeleteProc *proc;
|
| ︙ | ︙ | |||
157 158 159 160 161 162 163 |
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
};
| | > < | | | 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 |
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
};
int index;
size_t varIndex;
const char *string;
mp_int bignumValue;
Tcl_Obj **varPtr;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
varPtr = GetVarPtr(interp);
switch ((enum options)index) {
case BIGNUM_SET:
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "var value");
return TCL_ERROR;
}
string = Tcl_GetString(objv[3]);
if (mp_init(&bignumValue) != MP_OKAY) {
|
| ︙ | ︙ | |||
289 290 291 292 293 294 295 |
if (mp_mod_2d(&bignumValue, 1, &bignumValue) != MP_OKAY) {
mp_clear(&bignumValue);
Tcl_SetObjResult(interp,
Tcl_NewStringObj("error in mp_mod_2d", -1));
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
| | | | | | 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 |
if (mp_mod_2d(&bignumValue, 1, &bignumValue) != MP_OKAY) {
mp_clear(&bignumValue);
Tcl_SetObjResult(interp,
Tcl_NewStringObj("error in mp_mod_2d", -1));
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetWideIntObj(varPtr[varIndex], mp_iszero(&bignumValue));
} else {
SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(mp_iszero(&bignumValue)));
}
mp_clear(&bignumValue);
break;
case BIGNUM_RADIXSIZE:
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
return TCL_ERROR;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
&bignumValue) != TCL_OK) {
return TCL_ERROR;
}
if (mp_radix_size(&bignumValue, 10, &index) != MP_OKAY) {
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetWideIntObj(varPtr[varIndex], index);
} else {
SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(index));
}
mp_clear(&bignumValue);
break;
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
return TCL_OK;
|
| ︙ | ︙ | |||
349 350 351 352 353 354 355 |
static int
TestbooleanobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
| > | | < | | 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 |
static int
TestbooleanobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
size_t varIndex;
int boolValue;
const char *subCmd;
Tcl_Obj **varPtr;
if (objc < 3) {
wrongNumArgs:
Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
return TCL_ERROR;
}
if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
varPtr = GetVarPtr(interp);
subCmd = Tcl_GetString(objv[1]);
if (strcmp(subCmd, "set") == 0) {
|
| ︙ | ︙ | |||
449 450 451 452 453 454 455 |
static int
TestdoubleobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
| | | < | | < | 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 |
static int
TestdoubleobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
size_t varIndex;
double doubleValue;
const char *subCmd;
Tcl_Obj **varPtr;
if (objc < 3) {
wrongNumArgs:
Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
return TCL_ERROR;
}
varPtr = GetVarPtr(interp);
if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
subCmd = Tcl_GetString(objv[1]);
if (strcmp(subCmd, "set") == 0) {
if (objc != 4) {
goto wrongNumArgs;
}
if (Tcl_GetDouble(interp, Tcl_GetString(objv[3]), &doubleValue) != TCL_OK) {
return TCL_ERROR;
}
/*
* If the object currently bound to the variable with index varIndex
* has ref count 1 (i.e. the object is unshared) we can modify that
* object directly. Otherwise, if RC>1 (i.e. the object is shared), we
|
| ︙ | ︙ | |||
567 568 569 570 571 572 573 |
static int
TestindexobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
| | > | | < | | | | 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 |
static int
TestindexobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int allowAbbrev, index, setError, i, result;
Tcl_WideInt index2;
const char **argv;
static const char *const tablePtr[] = {"a", "b", "check", NULL};
/*
* Keep this structure declaration in sync with tclIndexObj.c
*/
struct IndexRep {
void *tablePtr; /* Pointer to the table of strings. */
TCL_HASH_TYPE offset; /* Offset between table entries. */
TCL_HASH_TYPE index; /* Selected index into table. */
} *indexRep;
if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]),
"check") == 0)) {
/*
* This code checks to be sure that the results of Tcl_GetIndexFromObj
* are properly cached in the object and returned on subsequent
* lookups.
*/
if (Tcl_GetWideIntFromObj(interp, objv[2], &index2) != TCL_OK) {
return TCL_ERROR;
}
Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index);
indexRep = (struct IndexRep *)objv[1]->internalRep.twoPtrValue.ptr1;
indexRep->index = index2;
result = Tcl_GetIndexFromObj(NULL, objv[1],
tablePtr, "token", 0, &index);
if (result == TCL_OK) {
Tcl_SetWideIntObj(Tcl_GetObjResult(interp), index);
}
return result;
}
if (objc < 5) {
Tcl_AppendToObj(Tcl_GetObjResult(interp), "wrong # args", -1);
return TCL_ERROR;
|
| ︙ | ︙ | |||
627 628 629 630 631 632 633 |
argv[objc-4] = NULL;
result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
argv, "token", TCL_INDEX_TEMP_TABLE|(allowAbbrev? 0 : TCL_EXACT),
&index);
ckfree(argv);
if (result == TCL_OK) {
| | | 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 |
argv[objc-4] = NULL;
result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
argv, "token", TCL_INDEX_TEMP_TABLE|(allowAbbrev? 0 : TCL_EXACT),
&index);
ckfree(argv);
if (result == TCL_OK) {
Tcl_SetWideIntObj(Tcl_GetObjResult(interp), index);
}
return result;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
657 658 659 660 661 662 663 |
static int
TestintobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
| | > | < | < | < | | < | < | | < | < | | | 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 |
static int
TestintobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
size_t varIndex;
int i;
Tcl_WideInt wideValue;
const char *subCmd;
Tcl_Obj **varPtr;
if (objc < 3) {
wrongNumArgs:
Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
return TCL_ERROR;
}
varPtr = GetVarPtr(interp);
if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
subCmd = Tcl_GetString(objv[1]);
if (strcmp(subCmd, "set") == 0) {
if (objc != 4) {
goto wrongNumArgs;
}
if (Tcl_GetWideIntFromObj(interp, objv[3], &wideValue) != TCL_OK) {
return TCL_ERROR;
}
/*
* If the object currently bound to the variable with index varIndex
* has ref count 1 (i.e. the object is unshared) we can modify that
* object directly. Otherwise, if RC>1 (i.e. the object is shared), we
* must create a new object to modify/set and decrement the old
* formerly-shared object's ref count. This is "copy on write".
*/
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetWideIntObj(varPtr[varIndex], wideValue);
} else {
SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(wideValue));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "set2") == 0) { /* doesn't set result */
if (objc != 4) {
goto wrongNumArgs;
}
if (Tcl_GetWideIntFromObj(interp, objv[3], &wideValue) != TCL_OK) {
return TCL_ERROR;
}
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetWideIntObj(varPtr[varIndex], wideValue);
} else {
SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(wideValue));
}
} else if (strcmp(subCmd, "setint") == 0) {
if (objc != 4) {
goto wrongNumArgs;
}
if (Tcl_GetWideIntFromObj(interp, objv[3], &wideValue) != TCL_OK) {
return TCL_ERROR;
}
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetWideIntObj(varPtr[varIndex], wideValue);
} else {
SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(wideValue));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "setmax") == 0) {
Tcl_WideInt maxWide = WIDE_MAX;
if (objc != 3) {
goto wrongNumArgs;
}
|
| ︙ | ︙ | |||
765 766 767 768 769 770 771 |
} else if (strcmp(subCmd, "get2") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
| < | | 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 |
} else if (strcmp(subCmd, "get2") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
Tcl_AppendToObj(Tcl_GetObjResult(interp), Tcl_GetString(varPtr[varIndex]), -1);
} else if (strcmp(subCmd, "inttoobigtest") == 0) {
/*
* If long ints have more bits than ints on this platform, verify that
* Tcl_GetIntFromObj returns an error if the long int held in an
* integer object's internal representation is too large to fit in an
* int.
*/
|
| ︙ | ︙ | |||
800 801 802 803 804 805 806 |
} else if (strcmp(subCmd, "mult10") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
| | | | | | | | | | 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 |
} else if (strcmp(subCmd, "mult10") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetWideIntFromObj(interp, varPtr[varIndex],
&wideValue) != TCL_OK) {
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetWideIntObj(varPtr[varIndex], wideValue * 10);
} else {
SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(wideValue * 10));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "div10") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetWideIntFromObj(interp, varPtr[varIndex],
&wideValue) != TCL_OK) {
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetWideIntObj(varPtr[varIndex], wideValue / 10);
} else {
SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(wideValue / 10));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"bad option \"", Tcl_GetString(objv[1]),
"\": must be set, get, get2, mult10, or div10", NULL);
return TCL_ERROR;
|
| ︙ | ︙ | |||
871 872 873 874 875 876 877 |
"get",
"replace"
};
enum listobjCmdIndex {
LISTOBJ_SET,
LISTOBJ_GET,
LISTOBJ_REPLACE
| | < | < | | < | | 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 |
"get",
"replace"
};
enum listobjCmdIndex {
LISTOBJ_SET,
LISTOBJ_GET,
LISTOBJ_REPLACE
} cmdIndex;
size_t varIndex; /* Variable number converted to binary */
Tcl_WideInt first; /* First index in the list */
Tcl_WideInt count; /* Count of elements in a list */
Tcl_Obj **varPtr;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg...?");
return TCL_ERROR;
}
varPtr = GetVarPtr(interp);
if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "command",
0, &cmdIndex) != TCL_OK) {
return TCL_ERROR;
}
switch(cmdIndex) {
|
| ︙ | ︙ | |||
920 921 922 923 924 925 926 |
case LISTOBJ_REPLACE:
if (objc < 5) {
Tcl_WrongNumArgs(interp, 2, objv,
"varIndex start count ?element...?");
return TCL_ERROR;
}
| | | | 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 |
case LISTOBJ_REPLACE:
if (objc < 5) {
Tcl_WrongNumArgs(interp, 2, objv,
"varIndex start count ?element...?");
return TCL_ERROR;
}
if (Tcl_GetWideIntFromObj(interp, objv[3], &first) != TCL_OK
|| Tcl_GetWideIntFromObj(interp, objv[4], &count) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_IsShared(varPtr[varIndex])) {
SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
}
Tcl_ResetResult(interp);
return Tcl_ListObjReplace(interp, varPtr[varIndex], first, count,
|
| ︙ | ︙ | |||
958 959 960 961 962 963 964 |
static int
TestobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
| | > | < | < | | < < | < | | < | < | < | < | | 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 |
static int
TestobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
size_t varIndex, destIndex;
int i;
const char *subCmd;
const Tcl_ObjType *targetType;
Tcl_Obj **varPtr;
if (objc < 2) {
wrongNumArgs:
Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
return TCL_ERROR;
}
varPtr = GetVarPtr(interp);
subCmd = Tcl_GetString(objv[1]);
if (strcmp(subCmd, "assign") == 0) {
if (objc != 4) {
goto wrongNumArgs;
}
if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (GetVariableIndex(interp, objv[3], &destIndex) != TCL_OK) {
return TCL_ERROR;
}
SetVarToObj(varPtr, destIndex, varPtr[varIndex]);
Tcl_SetObjResult(interp, varPtr[destIndex]);
} else if (strcmp(subCmd, "bug3598580") == 0) {
Tcl_Obj *listObjPtr, *elemObjPtr;
if (objc != 2) {
goto wrongNumArgs;
}
elemObjPtr = Tcl_NewWideIntObj(123);
listObjPtr = Tcl_NewListObj(1, &elemObjPtr);
/* Replace the single list element through itself, nonsense but legal. */
Tcl_ListObjReplace(interp, listObjPtr, 0, 1, 1, &elemObjPtr);
Tcl_SetObjResult(interp, listObjPtr);
return TCL_OK;
} else if (strcmp(subCmd, "convert") == 0) {
if (objc != 4) {
goto wrongNumArgs;
}
if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if ((targetType = Tcl_GetObjType(Tcl_GetString(objv[3]))) == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"no type ", Tcl_GetString(objv[3]), " found", NULL);
return TCL_ERROR;
}
if (Tcl_ConvertToType(interp, varPtr[varIndex], targetType)
!= TCL_OK) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "duplicate") == 0) {
if (objc != 4) {
goto wrongNumArgs;
}
if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (GetVariableIndex(interp, objv[3], &destIndex) != TCL_OK) {
return TCL_ERROR;
}
SetVarToObj(varPtr, destIndex, Tcl_DuplicateObj(varPtr[varIndex]));
Tcl_SetObjResult(interp, varPtr[destIndex]);
} else if (strcmp(subCmd, "freeallvars") == 0) {
if (objc != 2) {
goto wrongNumArgs;
}
for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) {
if (varPtr[i] != NULL) {
Tcl_DecrRefCount(varPtr[i]);
varPtr[i] = NULL;
}
}
} else if (strcmp(subCmd, "invalidateStringRep") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
Tcl_InvalidateStringRep(varPtr[varIndex]);
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "newobj") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
SetVarToObj(varPtr, varIndex, Tcl_NewObj());
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "objtype") == 0) {
const char *typeName;
|
| ︙ | ︙ | |||
1097 1098 1099 1100 1101 1102 1103 |
#endif
Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1));
}
} else if (strcmp(subCmd, "refcount") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
| < | < | | 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 |
#endif
Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1));
}
} else if (strcmp(subCmd, "refcount") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(varPtr[varIndex]->refCount));
} else if (strcmp(subCmd, "type") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (varPtr[varIndex]->typePtr == NULL) { /* a string! */
Tcl_AppendToObj(Tcl_GetObjResult(interp), "string", -1);
|
| ︙ | ︙ | |||
1171 1172 1173 1174 1175 1176 1177 |
TeststringobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_UniChar *unicode;
| | | > | < | | < | | 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 |
TeststringobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_UniChar *unicode;
size_t varIndex;
int size, option, i;
Tcl_WideInt length;
#define MAX_STRINGS 11
const char *string, *strings[MAX_STRINGS+1];
String *strPtr;
Tcl_Obj **varPtr;
static const char *const options[] = {
"append", "appendstrings", "get", "get2", "length", "length2",
"set", "set2", "setlength", "maxchars", "appendself",
"appendself2", NULL
};
if (objc < 3) {
wrongNumArgs:
Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
return TCL_ERROR;
}
varPtr = GetVarPtr(interp);
if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &option)
!= TCL_OK) {
return TCL_ERROR;
}
switch (option) {
case 0: /* append */
if (objc != 5) {
goto wrongNumArgs;
}
if (Tcl_GetWideIntFromObj(interp, objv[4], &length) != TCL_OK) {
return TCL_ERROR;
}
if (varPtr[varIndex] == NULL) {
SetVarToObj(varPtr, varIndex, Tcl_NewObj());
}
/*
* If the object bound to variable "varIndex" is shared, we must
* "copy on write" and append to a copy of the object.
*/
if (Tcl_IsShared(varPtr[varIndex])) {
SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
}
Tcl_AppendToObj(varPtr[varIndex], Tcl_GetString(objv[3]), length);
Tcl_SetObjResult(interp, varPtr[varIndex]);
break;
case 1: /* appendstrings */
if (objc > (MAX_STRINGS+3)) {
goto wrongNumArgs;
}
if (varPtr[varIndex] == NULL) {
|
| ︙ | ︙ | |||
1267 1268 1269 1270 1271 1272 1273 |
case 3: /* get2 */
if (objc != 3) {
goto wrongNumArgs;
}
if (CheckIfVarUnset(interp, varPtr, varIndex)) {
return TCL_ERROR;
}
| < | | | | 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 |
case 3: /* get2 */
if (objc != 3) {
goto wrongNumArgs;
}
if (CheckIfVarUnset(interp, varPtr, varIndex)) {
return TCL_ERROR;
}
Tcl_AppendToObj(Tcl_GetObjResult(interp), Tcl_GetString(varPtr[varIndex]), -1);
break;
case 4: /* length */
if (objc != 3) {
goto wrongNumArgs;
}
Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL)
? varPtr[varIndex]->length : -1);
break;
case 5: /* length2 */
if (objc != 3) {
goto wrongNumArgs;
}
if (varPtr[varIndex] != NULL) {
Tcl_ConvertToType(NULL, varPtr[varIndex],
Tcl_GetObjType("string"));
strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
length = (int) strPtr->allocated;
} else {
length = -1;
}
Tcl_SetWideIntObj(Tcl_GetObjResult(interp), length);
break;
case 6: /* set */
if (objc != 4) {
goto wrongNumArgs;
}
/*
|
| ︙ | ︙ | |||
1324 1325 1326 1327 1328 1329 1330 |
}
SetVarToObj(varPtr, varIndex, objv[3]);
break;
case 8: /* setlength */
if (objc != 4) {
goto wrongNumArgs;
}
| | | | | | | 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 |
}
SetVarToObj(varPtr, varIndex, objv[3]);
break;
case 8: /* setlength */
if (objc != 4) {
goto wrongNumArgs;
}
if (Tcl_GetWideIntFromObj(interp, objv[3], &length) != TCL_OK) {
return TCL_ERROR;
}
if (varPtr[varIndex] != NULL) {
Tcl_SetObjLength(varPtr[varIndex], length);
}
break;
case 9: /* maxchars */
if (objc != 3) {
goto wrongNumArgs;
}
if (varPtr[varIndex] != NULL) {
Tcl_ConvertToType(NULL, varPtr[varIndex],
Tcl_GetObjType("string"));
strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
length = strPtr->maxChars;
} else {
length = -1;
}
Tcl_SetWideIntObj(Tcl_GetObjResult(interp), length);
break;
case 10: /* appendself */
if (objc != 4) {
goto wrongNumArgs;
}
if (varPtr[varIndex] == NULL) {
SetVarToObj(varPtr, varIndex, Tcl_NewObj());
}
/*
* If the object bound to variable "varIndex" is shared, we must
* "copy on write" and append to a copy of the object.
*/
if (Tcl_IsShared(varPtr[varIndex])) {
SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
}
string = Tcl_GetStringFromObj(varPtr[varIndex], &size);
if (Tcl_GetWideIntFromObj(interp, objv[3], &length) != TCL_OK) {
return TCL_ERROR;
}
if ((length < 0) || (length > size)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"index value out of range", -1));
return TCL_ERROR;
}
Tcl_AppendToObj(varPtr[varIndex], string + length, size - length);
Tcl_SetObjResult(interp, varPtr[varIndex]);
break;
case 11: /* appendself2 */
if (objc != 4) {
goto wrongNumArgs;
}
if (varPtr[varIndex] == NULL) {
|
| ︙ | ︙ | |||
1395 1396 1397 1398 1399 1400 1401 |
if (Tcl_IsShared(varPtr[varIndex])) {
SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
}
unicode = Tcl_GetUnicodeFromObj(varPtr[varIndex], &size);
| | | | | 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 |
if (Tcl_IsShared(varPtr[varIndex])) {
SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
}
unicode = Tcl_GetUnicodeFromObj(varPtr[varIndex], &size);
if (Tcl_GetWideIntFromObj(interp, objv[3], &length) != TCL_OK) {
return TCL_ERROR;
}
if ((length < 0) || (length > size)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"index value out of range", -1));
return TCL_ERROR;
}
Tcl_AppendUnicodeToObj(varPtr[varIndex], unicode + length, size - length);
Tcl_SetObjResult(interp, varPtr[varIndex]);
break;
}
return TCL_OK;
}
|
| ︙ | ︙ | |||
1434 1435 1436 1437 1438 1439 1440 |
*
*----------------------------------------------------------------------
*/
static void
SetVarToObj(
Tcl_Obj **varPtr,
| | | 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 |
*
*----------------------------------------------------------------------
*/
static void
SetVarToObj(
Tcl_Obj **varPtr,
size_t varIndex, /* Designates the assignment variable. */
Tcl_Obj *objPtr) /* Points to object to assign to var. */
{
if (varPtr[varIndex] != NULL) {
Tcl_DecrRefCount(varPtr[varIndex]);
}
varPtr[varIndex] = objPtr;
if (objPtr != NULL) {
|
| ︙ | ︙ | |||
1465 1466 1467 1468 1469 1470 1471 |
*
*----------------------------------------------------------------------
*/
static int
GetVariableIndex(
Tcl_Interp *interp, /* Interpreter for error reporting. */
| | | | | | 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 |
*
*----------------------------------------------------------------------
*/
static int
GetVariableIndex(
Tcl_Interp *interp, /* Interpreter for error reporting. */
Tcl_Obj *obj, /* The variable index
* specified as a nonnegative number less than
* NUMBER_OF_OBJECT_VARS. */
size_t *indexPtr) /* Place to store converted result. */
{
Tcl_WideInt index;
if (Tcl_GetWideIntFromObj(interp, obj, &index) != TCL_OK) {
return TCL_ERROR;
}
if (index < 0 || index >= NUMBER_OF_OBJECT_VARS) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp), "bad variable index", -1);
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
1507 1508 1509 1510 1511 1512 1513 |
*----------------------------------------------------------------------
*/
static int
CheckIfVarUnset(
Tcl_Interp *interp, /* Interpreter for error reporting. */
Tcl_Obj ** varPtr,
| | | | 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 |
*----------------------------------------------------------------------
*/
static int
CheckIfVarUnset(
Tcl_Interp *interp, /* Interpreter for error reporting. */
Tcl_Obj ** varPtr,
size_t varIndex) /* Index of the test variable to check. */
{
if (varPtr[varIndex] == NULL) {
char buf[32 + TCL_INTEGER_SPACE];
sprintf(buf, "variable %" TCL_Z_MODIFIER "u is unset (NULL)", varIndex);
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
return 1;
}
return 0;
}
|
| ︙ | ︙ |
Changes to generic/tclThread.c.
| ︙ | ︙ | |||
76 77 78 79 80 81 82 |
memset(result, 0, size);
TclThreadStorageKeySet(keyPtr, result);
}
#else /* TCL_THREADS */
if (*keyPtr == NULL) {
result = ckalloc(size);
memset(result, 0, size);
| | | 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 |
memset(result, 0, size);
TclThreadStorageKeySet(keyPtr, result);
}
#else /* TCL_THREADS */
if (*keyPtr == NULL) {
result = ckalloc(size);
memset(result, 0, size);
*keyPtr = (Tcl_ThreadDataKey)result;
RememberSyncObject(keyPtr, &keyRecord);
} else {
result = *keyPtr;
}
#endif /* TCL_THREADS */
return result;
}
|
| ︙ | ︙ | |||
484 485 486 487 488 489 490 | * *---------------------------------------------------------------------- */ #undef Tcl_ConditionWait void Tcl_ConditionWait( | | | | | | | | 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 |
*
*----------------------------------------------------------------------
*/
#undef Tcl_ConditionWait
void
Tcl_ConditionWait(
TCL_UNUSED(Tcl_Condition *), /* Really (pthread_cond_t **) */
TCL_UNUSED(Tcl_Mutex *), /* Really (pthread_mutex_t **) */
TCL_UNUSED(const Tcl_Time *)) /* Timeout on waiting period */
{
}
#undef Tcl_ConditionNotify
void
Tcl_ConditionNotify(
TCL_UNUSED(Tcl_Condition *))
{
}
#undef Tcl_MutexLock
void
Tcl_MutexLock(
TCL_UNUSED(Tcl_Mutex *))
{
}
#undef Tcl_MutexUnlock
void
Tcl_MutexUnlock(
TCL_UNUSED(Tcl_Mutex *))
{
}
#endif /* !TCL_THREADS */
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Changes to generic/tclThreadJoin.c.
| ︙ | ︙ | |||
301 302 303 304 305 306 307 308 309 310 311 312 313 314 |
if (threadPtr->waitedUpon) {
Tcl_ConditionNotify(&threadPtr->cond);
}
Tcl_MutexUnlock(&threadPtr->threadMutex);
}
#endif /* _WIN32 */
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
| > > | 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 |
if (threadPtr->waitedUpon) {
Tcl_ConditionNotify(&threadPtr->cond);
}
Tcl_MutexUnlock(&threadPtr->threadMutex);
}
#else
TCL_MAC_EMPTY_FILE(generic_tclThreadJoin_c)
#endif /* _WIN32 */
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
|
| ︙ | ︙ |
Changes to generic/tclTimer.c.
| ︙ | ︙ | |||
944 945 946 947 948 949 950 |
if (objc == 2) {
Tcl_Obj *resultObj;
TclNewObj(resultObj);
for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
afterPtr = afterPtr->nextPtr) {
if (assocPtr->interp == interp) {
| | | | | | | | | | 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 |
if (objc == 2) {
Tcl_Obj *resultObj;
TclNewObj(resultObj);
for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
afterPtr = afterPtr->nextPtr) {
if (assocPtr->interp == interp) {
Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf(
"after#%d", afterPtr->id));
}
}
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "?id?");
return TCL_ERROR;
}
afterPtr = GetAfterEvent(assocPtr, objv[2]);
if (afterPtr == NULL) {
const char *eventStr = TclGetString(objv[2]);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"event \"%s\" doesn't exist", eventStr));
Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, NULL);
return TCL_ERROR;
} else {
Tcl_Obj *resultListPtr;
TclNewObj(resultListPtr);
Tcl_ListObjAppendElement(interp, resultListPtr,
afterPtr->commandPtr);
Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
(afterPtr->token == NULL) ? "idle" : "timer", -1));
Tcl_SetObjResult(interp, resultListPtr);
}
break;
default:
Tcl_Panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds");
}
return TCL_OK;
}
|
| ︙ | ︙ |
Changes to generic/tclTomMathDecls.h.
| ︙ | ︙ | |||
163 164 165 166 167 168 169 | #define s_mp_sqr TclBN_s_mp_sqr #define s_mp_sqr_fast TclBN_s_mp_sqr_fast #define s_mp_sub TclBN_s_mp_sub #define s_mp_toom_mul TclBN_mp_toom_mul #define s_mp_toom_sqr TclBN_mp_toom_sqr #endif /* !TCL_WITH_EXTERNAL_TOMMATH */ | | | | | | | 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 |
#define s_mp_sqr TclBN_s_mp_sqr
#define s_mp_sqr_fast TclBN_s_mp_sqr_fast
#define s_mp_sub TclBN_s_mp_sub
#define s_mp_toom_mul TclBN_mp_toom_mul
#define s_mp_toom_sqr TclBN_mp_toom_sqr
#endif /* !TCL_WITH_EXTERNAL_TOMMATH */
#define mp_init_set_int(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_init_ul") mp_init_u64(a,(unsigned int)(b)))
#define mp_set_int(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_set_ul") (mp_set_u64((a),((unsigned int)(b))),MP_OKAY))
#define mp_set_long(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_set_ul") (mp_set_u64((a),(long)(b)),MP_OKAY))
#define mp_set_long_long(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_set_u64") (mp_set_u64((a),(b)),MP_OKAY))
#define mp_unsigned_bin_size(mp) (MP_DEPRECATED_PRAGMA("replaced by mp_ubin_size") (int)mp_ubin_size(mp))
#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
# define TCL_STORAGE_CLASS DLLEXPORT
#else
# ifdef USE_TCL_STUBS
# define TCL_STORAGE_CLASS
|
| ︙ | ︙ |
Changes to generic/tclTrace.c.
| ︙ | ︙ | |||
155 156 157 158 159 160 161 |
#define FOREACH_VAR_TRACE(interp, name, clientData) \
(clientData) = NULL; \
while (((clientData) = Tcl_VarTraceInfo2((interp), (name), NULL, \
0, TraceVarProc, (clientData))) != NULL)
#define FOREACH_COMMAND_TRACE(interp, name, clientData) \
(clientData) = NULL; \
| | | | 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 |
#define FOREACH_VAR_TRACE(interp, name, clientData) \
(clientData) = NULL; \
while (((clientData) = Tcl_VarTraceInfo2((interp), (name), NULL, \
0, TraceVarProc, (clientData))) != NULL)
#define FOREACH_COMMAND_TRACE(interp, name, clientData) \
(clientData) = NULL; \
while (((clientData) = Tcl_CommandTraceInfo((interp), (name), 0, \
TraceCommandProc, (clientData))) != NULL)
/*
*----------------------------------------------------------------------
*
* Tcl_TraceObjCmd --
*
* This function is invoked to process the "trace" Tcl command. See the
|
| ︙ | ︙ | |||
428 429 430 431 432 433 434 | } /* * Make sure the ops argument is a list object; get its length and a * pointer to its array of element pointers. */ | | | 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 |
}
/*
* Make sure the ops argument is a list object; get its length and a
* pointer to its array of element pointers.
*/
result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
if (result != TCL_OK) {
return result;
}
if (listLen == 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"bad operation list \"\": must be one or more of"
" enter, leave, enterstep, or leavestep", -1));
|
| ︙ | ︙ | |||
598 599 600 601 602 603 604 |
TclNewLiteralStringObj(opObj, "enterstep");
Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
if (tcmdPtr->flags & TCL_TRACE_LEAVE_DURING_EXEC) {
TclNewLiteralStringObj(opObj, "leavestep");
Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
| | | 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 |
TclNewLiteralStringObj(opObj, "enterstep");
Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
if (tcmdPtr->flags & TCL_TRACE_LEAVE_DURING_EXEC) {
TclNewLiteralStringObj(opObj, "leavestep");
Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
TclListObjLength(NULL, elemObjPtr, &numOps);
if (0 == numOps) {
Tcl_DecrRefCount(elemObjPtr);
continue;
}
eachTraceObjPtr = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
Tcl_DecrRefCount(elemObjPtr);
|
| ︙ | ︙ | |||
669 670 671 672 673 674 675 | } /* * Make sure the ops argument is a list object; get its length and a * pointer to its array of element pointers. */ | | | 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 |
}
/*
* Make sure the ops argument is a list object; get its length and a
* pointer to its array of element pointers.
*/
result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
if (result != TCL_OK) {
return result;
}
if (listLen == 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"bad operation list \"\": must be one or more of"
" delete or rename", -1));
|
| ︙ | ︙ | |||
793 794 795 796 797 798 799 |
TclNewLiteralStringObj(opObj, "rename");
Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
if (tcmdPtr->flags & TCL_TRACE_DELETE) {
TclNewLiteralStringObj(opObj, "delete");
Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
| | | 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 |
TclNewLiteralStringObj(opObj, "rename");
Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
if (tcmdPtr->flags & TCL_TRACE_DELETE) {
TclNewLiteralStringObj(opObj, "delete");
Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
TclListObjLength(NULL, elemObjPtr, &numOps);
if (0 == numOps) {
Tcl_DecrRefCount(elemObjPtr);
continue;
}
eachTraceObjPtr = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
Tcl_DecrRefCount(elemObjPtr);
|
| ︙ | ︙ | |||
868 869 870 871 872 873 874 | } /* * Make sure the ops argument is a list object; get its length and a * pointer to its array of element pointers. */ | | | 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 |
}
/*
* Make sure the ops argument is a list object; get its length and a
* pointer to its array of element pointers.
*/
result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
if (result != TCL_OK) {
return result;
}
if (listLen == 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"bad operation list \"\": must be one or more of"
" array, read, unset, or write", -1));
|
| ︙ | ︙ |
Changes to generic/tclUniData.c.
| ︙ | ︙ | |||
25 26 27 28 29 30 31 |
static const unsigned short pageMap[] = {
0, 32, 64, 96, 0, 128, 160, 192, 224, 256, 288, 320, 352, 384, 416,
448, 224, 480, 512, 544, 576, 608, 640, 672, 704, 704, 736, 768, 800,
832, 864, 896, 928, 960, 992, 224, 1024, 224, 1056, 224, 224, 1088,
1120, 1152, 1184, 1216, 1248, 1280, 1312, 1344, 1376, 1408, 1344, 1344,
1440, 1472, 1504, 1536, 1568, 1344, 1344, 1600, 1632, 1664, 1696, 1728,
| | | | | | | | | | | | | | | | | | | | | | | | 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 |
static const unsigned short pageMap[] = {
0, 32, 64, 96, 0, 128, 160, 192, 224, 256, 288, 320, 352, 384, 416,
448, 224, 480, 512, 544, 576, 608, 640, 672, 704, 704, 736, 768, 800,
832, 864, 896, 928, 960, 992, 224, 1024, 224, 1056, 224, 224, 1088,
1120, 1152, 1184, 1216, 1248, 1280, 1312, 1344, 1376, 1408, 1344, 1344,
1440, 1472, 1504, 1536, 1568, 1344, 1344, 1600, 1632, 1664, 1696, 1728,
1760, 1792, 1824, 1344, 1856, 1888, 1920, 1952, 1984, 2016, 2048, 2080,
2112, 2144, 2176, 2208, 2240, 2272, 2304, 2336, 2368, 2400, 2432, 2464,
2496, 2528, 2560, 2592, 2624, 2656, 2688, 2720, 2752, 2784, 2816, 2848,
2880, 2912, 2944, 2976, 3008, 3040, 3072, 3104, 3136, 3168, 3200, 3232,
3264, 3296, 3328, 3360, 3392, 3296, 3424, 3456, 3488, 3520, 3552, 3584,
3616, 3296, 1344, 3648, 3680, 3712, 3744, 3776, 3808, 3840, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 3872, 1344, 3904, 3936,
3968, 1344, 4000, 1344, 4032, 4064, 4096, 4128, 4128, 4160, 4192, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 4224, 4256, 1344, 1344, 4288, 4320, 4352,
4384, 4416, 1344, 4448, 4480, 4512, 4544, 1344, 4576, 4608, 4640, 4672,
1344, 4704, 4736, 4768, 4800, 4832, 1344, 4864, 4896, 4928, 4960, 1344,
4992, 5024, 5056, 5088, 5120, 3296, 5152, 5184, 5216, 5248, 5280, 5312,
1344, 5344, 1344, 5376, 5408, 5440, 5472, 5504, 5536, 5568, 5600, 5632,
5664, 5696, 5728, 5664, 704, 704, 224, 224, 224, 224, 5760, 224, 224,
224, 5792, 5824, 5856, 5888, 5920, 5952, 5984, 6016, 6048, 6080, 6112,
6144, 6176, 6208, 6240, 6272, 6304, 6336, 6368, 6400, 6432, 6464, 6496,
6528, 6560, 6560, 6560, 6560, 6560, 6560, 6560, 6560, 6592, 6624, 4928,
6656, 6688, 6720, 6752, 6784, 4928, 6816, 6848, 6880, 6912, 6944, 6976,
7008, 4928, 4928, 4928, 4928, 4928, 7040, 7072, 7104, 4928, 4928, 4928,
7136, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 7168, 7200, 4928, 7232,
7264, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 6560, 6560, 6560,
6560, 7296, 6560, 7328, 7360, 6560, 6560, 6560, 6560, 6560, 6560, 6560,
6560, 4928, 7392, 7424, 7456, 7488, 4928, 4928, 4928, 7520, 7552, 7584,
7616, 224, 224, 224, 7648, 7680, 7712, 1344, 7744, 7776, 7808, 7808,
704, 7840, 7872, 7904, 3296, 7936, 4928, 4928, 7968, 4928, 4928, 4928,
4928, 4928, 4928, 8000, 8032, 8064, 8096, 3200, 1344, 8128, 4192, 1344,
8160, 8192, 8224, 1344, 1344, 8256, 1344, 4928, 8288, 8320, 8352, 8384,
4928, 8352, 8416, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928,
4928, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
|
| ︙ | ︙ | |||
126 127 128 129 130 131 132 |
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
| | | | | | | | | 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 |
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 8448, 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, 8480, 4928, 8512, 5440, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 8544, 8576, 224, 8608, 8640, 1344, 1344, 8672, 8704, 8736, 224,
8768, 8800, 8832, 8864, 8896, 8928, 8960, 1344, 8992, 9024, 9056, 9088,
9120, 1632, 9152, 9184, 9216, 1920, 9248, 9280, 9312, 1344, 9344, 9376,
9408, 1344, 9440, 9472, 9504, 9536, 9568, 9600, 9632, 9664, 9664, 1344,
9696, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
|
| ︙ | ︙ | |||
163 164 165 166 167 168 169 |
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
| > > > > > > | | < < < < < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < | | | | | > | < | | > | | | < | | | | | | > | | < | | | > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < | | | > | | < | | | > | < | | > > | < < | | | > | | > | | < | | | > | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 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 |
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 9728, 9760, 9792, 9824, 9824, 9824, 9824, 9824, 9824, 9824,
9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824,
9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824,
9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824,
9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824,
9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9856, 9856, 9856,
9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
9856, 9856, 9856, 9856, 9856, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 9888, 1344, 1344, 9920, 3296, 9952, 9984, 10016,
1344, 1344, 10048, 10080, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 10112, 10144, 1344, 10176, 1344, 10208, 10240, 10272,
10304, 10336, 10368, 1344, 1344, 1344, 10400, 10432, 64, 10464, 10496,
10528, 4736, 10560, 10592
#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
,10624, 10656, 10688, 3296, 1344, 1344, 1344, 10720, 10752, 10784,
10816, 10848, 10880, 10912, 10944, 10976, 3296, 3296, 3296, 3296, 9216,
1344, 11008, 11040, 1344, 11072, 11104, 11136, 11168, 1344, 11200,
3296, 11232, 11264, 11296, 1344, 11328, 11360, 11392, 11424, 1344,
11456, 1344, 11488, 11520, 11552, 3296, 3296, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 7776, 4704, 11584, 11616, 11648, 3296,
3296, 11680, 11712, 11744, 11776, 4736, 11808, 3296, 11840, 11872,
11904, 3296, 3296, 1344, 11936, 11968, 6880, 12000, 12032, 12064, 12096,
12128, 3296, 12160, 12192, 1344, 12224, 12256, 12288, 12320, 12352,
3296, 3296, 1344, 1344, 12384, 3296, 12416, 12448, 12480, 12512, 1344,
12544, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 12576,
1344, 12608, 3296, 3296, 12128, 12640, 12672, 12704, 12736, 12704,
12768, 7776, 12800, 12832, 12864, 12896, 5280, 12928, 12960, 12992,
13024, 13056, 13088, 13120, 5280, 13152, 13184, 13216, 13248, 13280,
3296, 3296, 13312, 13344, 13376, 13408, 13440, 13472, 13504, 13536,
3296, 3296, 3296, 3296, 1344, 13568, 13600, 13632, 1344, 13664, 13696,
3296, 3296, 3296, 3296, 3296, 1344, 13728, 13760, 3296, 1344, 13792,
13824, 13856, 1344, 13888, 13920, 3296, 4032, 13952, 13984, 3296, 3296,
3296, 3296, 3296, 1344, 14016, 3296, 3296, 3296, 14048, 14080, 14112,
14144, 14176, 14208, 3296, 3296, 14240, 14272, 14304, 14336, 14368,
14400, 1344, 14432, 14464, 1344, 4608, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 14496, 14528, 14560, 14592, 14624, 14656, 3296, 3296,
14688, 14720, 14752, 14784, 14816, 13920, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 14848, 3296, 3296, 3296, 3296, 3296, 14880,
14912, 14944, 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, 9920, 3296, 3296, 3296, 10816,
10816, 10816, 14976, 1344, 1344, 1344, 1344, 1344, 1344, 15008, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 12704, 1344, 1344,
15040, 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, 15072,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
13984, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
4608, 4736, 15104, 1344, 4736, 15136, 15168, 1344, 15200, 15232, 15264,
15296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 14048,
14080, 15328, 3296, 3296, 3296, 1344, 1344, 15360, 15392, 15424, 3296,
3296, 15456, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 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, 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, 4704, 3296, 12384, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
15520, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 15552,
15584, 15616, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 9792, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 1344, 1344, 1344, 15648, 15680, 15712, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
704, 15744, 15776, 4928, 4928, 4928, 15808, 3296, 4928, 4928, 4928,
4928, 4928, 4928, 4928, 8000, 4928, 15840, 4928, 15872, 15904, 15936,
4928, 6848, 4928, 4928, 15968, 3296, 3296, 3296, 3296, 16000, 4928,
4928, 16032, 16064, 3296, 3296, 3296, 3296, 16096, 16128, 16160, 16192,
16224, 16256, 16288, 16320, 16352, 16384, 16416, 16448, 16480, 16096,
16128, 16512, 16192, 16544, 16576, 16608, 16320, 16640, 16672, 16704,
16736, 16768, 16800, 16832, 16864, 16896, 16928, 16960, 4928, 4928,
4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928,
4928, 4928, 704, 16992, 704, 17024, 17056, 17088, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 17120, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 17152, 17184, 3296, 3296, 3296, 3296, 3296,
3296, 1344, 17216, 17248, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 12704, 17280, 1344, 17312, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 17344,
1344, 1344, 1344, 1344, 1344, 1344, 17376, 3296, 17408, 17440, 17472,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
17504, 6880, 17536, 3296, 3296, 17568, 17600, 3296, 3296, 3296, 3296,
3296, 3296, 17632, 17664, 17696, 17728, 17760, 17792, 3296, 17824,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 4928, 17856, 4928,
4928, 7968, 17888, 17920, 8000, 17952, 4928, 4928, 4928, 4928, 17984,
3296, 18016, 18048, 18080, 18112, 18144, 3296, 3296, 3296, 3296, 4928,
4928, 4928, 4928, 4928, 4928, 4928, 18176, 4928, 4928, 4928, 4928,
4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928,
4928, 4928, 4928, 4928, 4928, 4928, 18208, 18240, 4928, 4928, 4928,
7968, 4928, 4928, 18272, 18304, 17856, 4928, 18336, 4928, 18368, 18400,
3296, 3296, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928,
7968, 18432, 18464, 18496, 18528, 18560, 4928, 4928, 4928, 4928, 18592,
4928, 6848, 18624, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 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, 3296, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
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, 4608, 1344, 1344, 1344, 1344, 1344, 1344, 11328, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 18656,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 18688, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 11328,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 18720
#endif /* TCL_UTF_MAX > 3 */
};
/*
* The groupMap is indexed by combining the alternate page number with
* the page offset and returns a group number that identifies a unique
* set of character attributes.
|
| ︙ | ︙ | |||
641 642 643 644 645 646 647 |
93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
93, 93, 93, 93, 93, 93, 8, 93, 3, 93, 93, 3, 93, 93, 3, 93, 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, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0,
15, 15, 15, 15, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17,
17, 17, 17, 7, 7, 7, 3, 3, 4, 3, 3, 14, 14, 93, 93, 93, 93, 93, 93,
| | | 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 |
93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
93, 93, 93, 93, 93, 93, 8, 93, 3, 93, 93, 3, 93, 93, 3, 93, 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, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0,
15, 15, 15, 15, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17,
17, 17, 17, 7, 7, 7, 3, 3, 4, 3, 3, 14, 14, 93, 93, 93, 93, 93, 93,
93, 93, 93, 93, 93, 3, 17, 3, 3, 3, 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, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
93, 93, 93, 93, 93, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 15, 15,
93, 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, 3, 15, 93, 93, 93, 93, 93, 93, 93, 17, 14, 93, 93, 93, 93,
|
| ︙ | ︙ | |||
667 668 669 670 671 672 673 |
93, 93, 93, 93, 93, 93, 93, 93, 93, 92, 92, 14, 3, 3, 3, 92, 0, 0,
93, 4, 4, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 92, 93, 93, 93, 93, 93,
93, 93, 93, 93, 92, 93, 93, 93, 92, 93, 93, 93, 93, 93, 0, 0, 3, 3,
3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 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, 93, 93, 93, 0, 0, 3, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
| < < | | < | | > > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > | < | | | | | | | | | | | | | | | | | | | | > > > > > > > > | < | | < < | < < | | < < | | | | | | | < | | | | | > | | | | | | | | | | | | | | | | | < > | | | | | | | | | < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > | > > > > > > > > > | > > | > > > > | > > > > > > | < < | | < | < | | < < | < < < < < < < < < < > > > > > > < < < < < < < < < < < < | | | | | | | | | | | | | | | | | | | | | | | | | | | > | > | < < | | | | | | | | | | | | | | | | | < | > | | | < | < | | | | | | | | | | | | < | > | | | | | | | | | | | | | | | | | | | | | | | | | > > | | | | | | | | | | | | | | | | | | | | | | | | | | | | < | > | | | | | | | | | | | | < > | | | | | | | | | | | | | | | | | | | | | 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 |
93, 93, 93, 93, 93, 93, 93, 93, 93, 92, 92, 14, 3, 3, 3, 92, 0, 0,
93, 4, 4, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 92, 93, 93, 93, 93, 93,
93, 93, 93, 93, 92, 93, 93, 93, 92, 93, 93, 93, 93, 93, 0, 0, 3, 3,
3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 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, 93, 93, 93, 0, 0, 3, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 0, 0, 0, 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, 11, 15, 15, 15, 15,
15, 15, 0, 17, 17, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93,
15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 93, 93, 93, 93, 93, 93, 93,
93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
17, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 125,
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, 15, 15, 15, 15, 15, 15,
15, 15, 15, 93, 125, 93, 15, 125, 125, 125, 93, 93, 93, 93, 93, 93,
93, 93, 125, 125, 125, 125, 93, 125, 125, 15, 93, 93, 93, 93, 93, 93,
93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 3, 3, 9, 9, 9,
9, 9, 9, 9, 9, 9, 9, 3, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 93, 125, 125, 0, 15, 15, 15, 15, 15, 15, 15, 15,
0, 0, 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, 0, 15, 15, 15, 15, 15, 15,
15, 0, 15, 0, 0, 0, 15, 15, 15, 15, 0, 0, 93, 15, 125, 125, 125, 93,
93, 93, 93, 0, 0, 125, 125, 0, 0, 125, 125, 93, 15, 0, 0, 0, 0, 0,
0, 0, 0, 125, 0, 0, 0, 0, 15, 15, 0, 15, 15, 15, 93, 93, 0, 0, 9, 9,
9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 4, 4, 18, 18, 18, 18, 18, 18, 14, 4,
15, 3, 93, 0, 0, 93, 93, 125, 0, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0,
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, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15,
15, 0, 15, 15, 0, 15, 15, 0, 0, 93, 0, 125, 125, 125, 93, 93, 0, 0,
0, 0, 93, 93, 0, 0, 93, 93, 93, 0, 0, 0, 93, 0, 0, 0, 0, 0, 0, 0, 15,
15, 15, 15, 0, 15, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9,
9, 93, 93, 15, 15, 15, 93, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 93,
125, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 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, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15,
15, 15, 0, 0, 93, 15, 125, 125, 125, 93, 93, 93, 93, 93, 0, 93, 93,
125, 0, 125, 125, 93, 0, 0, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 15, 15, 93, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 4,
0, 0, 0, 0, 0, 0, 0, 15, 93, 93, 93, 93, 93, 93, 0, 93, 125, 125, 0,
15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 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, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15,
0, 0, 93, 15, 125, 93, 125, 93, 93, 93, 93, 0, 0, 125, 125, 0, 0, 125,
125, 93, 0, 0, 0, 0, 0, 0, 0, 93, 93, 125, 0, 0, 0, 0, 15, 15, 0, 15,
15, 15, 93, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 14, 15, 18, 18,
18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 15, 0, 15, 15, 15,
15, 15, 15, 0, 0, 0, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 0, 15, 15,
0, 15, 0, 15, 15, 0, 0, 0, 15, 15, 0, 0, 0, 15, 15, 15, 0, 0, 0, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 125, 125, 93,
125, 125, 0, 0, 0, 125, 125, 125, 0, 125, 125, 125, 93, 0, 0, 15, 0,
0, 0, 0, 0, 0, 125, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9,
9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 14, 14, 14, 14, 14, 14, 4, 14,
0, 0, 0, 0, 0, 93, 125, 125, 125, 93, 15, 15, 15, 15, 15, 15, 15, 15,
0, 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, 0, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 93, 15, 93, 93, 93, 125,
125, 125, 125, 0, 93, 93, 93, 0, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0,
0, 93, 93, 0, 15, 15, 15, 0, 0, 15, 0, 0, 15, 15, 93, 93, 0, 0, 9,
9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 3, 18, 18, 18, 18,
18, 18, 18, 14, 15, 93, 125, 125, 3, 15, 15, 15, 15, 15, 15, 15, 15,
0, 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, 0, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0, 93, 15, 125, 93, 125,
125, 125, 125, 125, 0, 93, 125, 125, 0, 125, 125, 93, 93, 0, 0, 0,
0, 0, 0, 0, 125, 125, 0, 0, 0, 0, 0, 0, 15, 15, 0, 15, 15, 93, 93,
0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 15, 15, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 93, 93, 125, 125, 15, 15, 15, 15, 15, 15, 15, 15,
15, 0, 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, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 15, 125, 125,
125, 93, 93, 93, 93, 0, 125, 125, 125, 0, 125, 125, 125, 93, 15, 14,
0, 0, 0, 0, 15, 15, 15, 125, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15,
93, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18,
18, 18, 18, 14, 15, 15, 15, 15, 15, 15, 0, 93, 125, 125, 0, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
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, 0, 15, 15, 15, 15, 15, 15, 15, 15,
15, 0, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 93, 0, 0, 0,
0, 125, 125, 125, 93, 93, 93, 0, 93, 0, 125, 125, 125, 125, 125, 125,
125, 125, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 125,
125, 3, 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, 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, 93, 15, 15, 93, 93, 93, 93, 93, 93,
93, 0, 0, 0, 0, 4, 15, 15, 15, 15, 15, 15, 92, 93, 93, 93, 93, 93,
93, 93, 93, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 0, 15, 0, 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, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 93, 15, 15, 93, 93, 93, 93, 93, 93, 93, 93, 93, 15, 0, 0, 15, 15,
15, 15, 15, 0, 92, 0, 93, 93, 93, 93, 93, 93, 0, 0, 9, 9, 9, 9, 9,
9, 9, 9, 9, 9, 0, 0, 15, 15, 15, 15, 15, 14, 14, 14, 3, 3, 3, 3, 3,
3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 14, 3, 14, 14, 14, 93, 93, 14, 14, 14,
14, 14, 14, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, 18,
18, 18, 18, 14, 93, 14, 93, 14, 93, 5, 6, 5, 6, 125, 125, 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, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93,
93, 93, 93, 93, 93, 93, 93, 93, 125, 93, 93, 93, 93, 93, 3, 93, 93,
15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0,
93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
93, 93, 0, 14, 14, 14, 14, 14, 14, 14, 14, 93, 14, 14, 14, 14, 14,
14, 0, 14, 14, 3, 3, 3, 3, 3, 14, 14, 14, 14, 3, 3, 0, 0, 0, 0, 0,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 93, 93, 93, 93,
125, 93, 93, 93, 93, 93, 93, 125, 93, 93, 125, 125, 93, 93, 15, 9,
9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15,
125, 125, 93, 93, 15, 15, 15, 15, 93, 93, 93, 15, 125, 125, 125, 15,
15, 125, 125, 125, 125, 125, 125, 125, 15, 15, 15, 93, 93, 93, 93,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 125, 125, 93,
93, 125, 125, 125, 125, 125, 125, 93, 15, 125, 9, 9, 9, 9, 9, 9, 9,
9, 9, 9, 125, 125, 125, 93, 14, 14, 126, 126, 126, 126, 126, 126, 126,
126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126,
126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126,
126, 126, 126, 0, 126, 0, 0, 0, 0, 0, 126, 0, 0, 127, 127, 127, 127,
127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127,
127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127,
127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 3, 92, 127,
127, 127, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0,
0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, 15, 15, 15, 15, 0, 0, 15,
15, 15, 15, 15, 15, 15, 15, 15, 0, 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, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15,
15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, 15, 15, 15, 15, 0,
0, 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, 15, 15, 15, 15, 15, 15, 0, 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, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 93, 93,
93, 3, 3, 3, 3, 3, 3, 3, 3, 3, 18, 18, 18, 18, 18, 18, 18, 18, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 128, 128, 128, 128, 128, 128,
128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128,
128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128,
128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128,
105, 105, 105, 105, 105, 105, 0, 0, 111, 111, 111, 111, 111, 111, 0,
0, 8, 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, 14, 3, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 2, 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, 5, 6, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 3, 3, 3, 129, 129, 129, 15, 15, 15, 15, 15, 15, 15,
15, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 125, 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, 15, 15, 93, 93, 125, 3, 3, 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, 15, 93, 93,
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, 0, 15, 15, 15, 0, 93, 93, 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, 15, 15, 15, 93, 93, 125, 93, 93, 93, 93, 93, 93, 93,
125, 125, 125, 125, 125, 125, 125, 125, 93, 125, 125, 93, 93, 93, 93,
93, 93, 93, 93, 93, 93, 93, 3, 3, 3, 92, 3, 3, 3, 4, 15, 93, 0, 0,
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18,
18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 8, 3, 3, 3,
3, 93, 93, 93, 17, 93, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0,
0, 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, 15,
15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
93, 93, 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, 93, 15, 0, 0, 0, 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,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 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, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
93, 93, 93, 125, 125, 125, 125, 93, 93, 125, 125, 125, 0, 0, 0, 0,
125, 125, 93, 125, 125, 125, 125, 125, 125, 93, 93, 93, 0, 0, 0, 0,
14, 0, 0, 0, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 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, 0, 0, 15, 15, 15, 15, 15, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 0, 0, 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, 0, 0, 0, 0, 0,
0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
93, 93, 125, 125, 93, 0, 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 93, 125, 93, 93,
93, 93, 93, 93, 93, 0, 93, 125, 93, 125, 125, 93, 93, 93, 93, 93, 93,
93, 93, 125, 125, 125, 125, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93,
93, 93, 0, 0, 93, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 9,
9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 92,
3, 3, 3, 3, 3, 3, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
93, 93, 93, 120, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93,
93, 93, 93, 125, 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, 15, 15,
93, 125, 93, 93, 93, 93, 93, 125, 93, 125, 125, 125, 125, 125, 93,
125, 125, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 9, 9, 9, 9, 9, 9,
9, 9, 9, 9, 3, 3, 3, 3, 3, 3, 3, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 93, 93, 93, 93, 93, 93, 93, 93, 93, 14, 14, 14, 14, 14, 14, 14,
14, 14, 3, 3, 0, 93, 93, 125, 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, 125, 93, 93, 93, 93, 125, 125, 93, 93, 125, 93, 93, 93,
15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 93, 125, 93, 93, 125, 125, 125, 93, 125, 93, 93, 93,
125, 125, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 15, 15, 15, 15, 125,
125, 125, 125, 125, 125, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93,
125, 125, 93, 93, 0, 0, 0, 3, 3, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9,
9, 0, 0, 0, 15, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 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, 92, 92, 92, 92, 3, 3, 130,
131, 132, 133, 133, 134, 135, 136, 137, 0, 0, 0, 0, 0, 0, 0, 138, 138,
138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138,
138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138,
138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 0,
0, 138, 138, 138, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 93,
93, 93, 3, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 125,
93, 93, 93, 93, 93, 93, 93, 15, 15, 15, 15, 93, 15, 15, 15, 15, 15,
15, 93, 15, 15, 125, 93, 93, 15, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 92, 139, 21, 21,
21, 140, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
21, 141, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 92, 92, 92,
92, 92, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
24, 23, 24, 23, 24, 23, 24, 21, 21, 21, 21, 21, 142, 21, 21, 143, 21,
144, 144, 144, 144, 144, 144, 144, 144, 145, 145, 145, 145, 145, 145,
145, 145, 144, 144, 144, 144, 144, 144, 0, 0, 145, 145, 145, 145, 145,
145, 0, 0, 144, 144, 144, 144, 144, 144, 144, 144, 145, 145, 145, 145,
145, 145, 145, 145, 144, 144, 144, 144, 144, 144, 144, 144, 145, 145,
145, 145, 145, 145, 145, 145, 144, 144, 144, 144, 144, 144, 0, 0, 145,
145, 145, 145, 145, 145, 0, 0, 21, 144, 21, 144, 21, 144, 21, 144,
0, 145, 0, 145, 0, 145, 0, 145, 144, 144, 144, 144, 144, 144, 144,
144, 145, 145, 145, 145, 145, 145, 145, 145, 146, 146, 147, 147, 147,
147, 148, 148, 149, 149, 150, 150, 151, 151, 0, 0, 144, 144, 144, 144,
144, 144, 144, 144, 152, 152, 152, 152, 152, 152, 152, 152, 144, 144,
144, 144, 144, 144, 144, 144, 152, 152, 152, 152, 152, 152, 152, 152,
144, 144, 144, 144, 144, 144, 144, 144, 152, 152, 152, 152, 152, 152,
152, 152, 144, 144, 21, 153, 21, 0, 21, 21, 145, 145, 154, 154, 155,
11, 156, 11, 11, 11, 21, 153, 21, 0, 21, 21, 157, 157, 157, 157, 155,
11, 11, 11, 144, 144, 21, 21, 0, 0, 21, 21, 145, 145, 158, 158, 0,
11, 11, 11, 144, 144, 21, 21, 21, 114, 21, 21, 145, 145, 159, 159,
118, 11, 11, 11, 0, 0, 21, 153, 21, 0, 21, 21, 160, 160, 161, 161,
155, 11, 11, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 17, 17, 17, 17, 17,
8, 8, 8, 8, 8, 8, 3, 3, 16, 20, 5, 16, 16, 20, 5, 16, 3, 3, 3, 3, 3,
3, 3, 3, 162, 163, 17, 17, 17, 17, 17, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3,
16, 20, 3, 3, 3, 3, 12, 12, 3, 3, 3, 7, 5, 6, 3, 3, 3, 3, 3, 3, 3,
3, 3, 3, 3, 7, 3, 12, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 17, 17, 17,
17, 17, 0, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 18, 92, 0, 0, 18,
18, 18, 18, 18, 18, 7, 7, 7, 5, 6, 92, 18, 18, 18, 18, 18, 18, 18,
18, 18, 18, 7, 7, 7, 5, 6, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
92, 92, 92, 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
93, 93, 93, 120, 120, 120, 120, 93, 120, 120, 120, 93, 93, 93, 93,
93, 93, 93, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 14, 14, 108, 14, 14, 14, 14, 108, 14, 14, 21, 108, 108, 108,
21, 21, 108, 108, 108, 21, 14, 108, 14, 14, 7, 108, 108, 108, 108,
108, 14, 14, 14, 14, 14, 14, 108, 14, 164, 14, 108, 14, 165, 166, 108,
108, 14, 21, 108, 108, 167, 108, 21, 15, 15, 15, 15, 21, 14, 14, 21,
21, 108, 108, 7, 7, 7, 7, 7, 108, 21, 21, 21, 21, 14, 7, 14, 14, 168,
14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169,
169, 169, 170, 170, 170, 170, 170, 170, 170, 170, 170, 170, 170, 170,
170, 170, 170, 170, 129, 129, 129, 23, 24, 129, 129, 129, 129, 18,
14, 14, 0, 0, 0, 0, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 7, 7, 14, 14,
14, 14, 7, 14, 14, 7, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 7, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 14, 14, 7,
14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7,
7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14,
14, 14, 14, 14, 14, 14, 5, 6, 5, 6, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 14, 14, 14, 14,
14, 14, 14, 5, 6, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7,
7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, 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, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 171, 171, 171, 171, 171, 171,
171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171,
171, 171, 171, 171, 171, 171, 172, 172, 172, 172, 172, 172, 172, 172,
172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172,
172, 172, 172, 172, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7,
14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7,
7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6,
5, 6, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 5, 6, 7, 7, 7, 7,
7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
7, 7, 7, 7, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7,
7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5,
6, 5, 6, 5, 6, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 7, 7,
7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
7, 7, 7, 7, 7, 7, 7, 5, 6, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
7, 7, 7, 7, 7, 7, 7, 7, 14, 14, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 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, 123, 123, 123, 123, 123, 123, 123,
123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123,
123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123,
123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 124,
124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124,
124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124,
124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124,
124, 124, 124, 124, 124, 23, 24, 173, 174, 175, 176, 177, 23, 24, 23,
24, 23, 24, 178, 179, 180, 181, 21, 23, 24, 21, 23, 24, 21, 21, 21,
21, 21, 92, 92, 182, 182, 23, 24, 23, 24, 21, 14, 14, 14, 14, 14, 14,
23, 24, 23, 24, 93, 93, 93, 23, 24, 0, 0, 0, 0, 0, 3, 3, 3, 3, 18,
3, 3, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183,
183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183,
183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 0, 183, 0, 0,
0, 0, 0, 183, 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, 0, 0, 0, 0, 0, 0, 0,
92, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 15, 15, 15, 15,
15, 15, 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, 15, 15, 15, 15, 15, 15, 15, 0, 15,
15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15,
15, 15, 15, 15, 0, 3, 3, 16, 20, 16, 20, 3, 3, 3, 16, 20, 3, 16, 20,
3, 3, 3, 3, 3, 3, 3, 3, 3, 8, 3, 3, 8, 3, 16, 20, 3, 3, 16, 20, 5,
6, 5, 6, 5, 6, 5, 6, 3, 3, 3, 3, 3, 92, 3, 3, 3, 3, 3, 3, 3, 3, 3,
3, 8, 8, 3, 3, 3, 3, 8, 3, 5, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
14, 14, 3, 3, 3, 5, 6, 5, 6, 5, 6, 5, 6, 8, 0, 0, 14, 14, 14, 14, 14,
14, 14, 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,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0,
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, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 2, 3, 3, 3, 14, 92, 15,
129, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 14, 14, 5, 6, 5, 6, 5, 6, 5, 6,
8, 5, 6, 6, 14, 129, 129, 129, 129, 129, 129, 129, 129, 129, 93, 93,
93, 93, 125, 125, 8, 92, 92, 92, 92, 92, 14, 14, 129, 129, 129, 92,
15, 3, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 93, 93, 11, 11, 92, 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, 3, 92, 92, 92, 15, 0, 0,
0, 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, 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, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 0, 14, 14, 18, 18, 18, 18, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 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, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18, 14, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 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, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 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, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 3,
3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24,
23, 24, 23, 24, 15, 93, 120, 120, 120, 3, 93, 93, 93, 93, 93, 93, 93,
93, 93, 93, 3, 92, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24,
23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 92,
92, 93, 93, 15, 15, 15, 15, 15, 15, 129, 129, 129, 129, 129, 129, 129,
129, 129, 129, 93, 93, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 11,
11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
11, 11, 11, 11, 11, 92, 92, 92, 92, 92, 92, 92, 92, 92, 11, 11, 23,
24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 23, 24,
23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 92, 21, 21, 21, 21, 21,
21, 21, 21, 23, 24, 23, 24, 184, 23, 24, 23, 24, 23, 24, 23, 24, 23,
24, 92, 11, 11, 23, 24, 185, 21, 15, 23, 24, 23, 24, 186, 21, 23, 24,
23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
24, 187, 188, 189, 190, 187, 21, 191, 192, 193, 194, 23, 24, 23, 24,
23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 195, 196, 197, 23,
24, 23, 24, 0, 0, 0, 0, 0, 23, 24, 0, 21, 0, 21, 23, 24, 23, 24, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
92, 92, 92, 23, 24, 15, 92, 92, 21, 15, 15, 15, 15, 15, 15, 15, 93,
15, 15, 15, 93, 15, 15, 15, 15, 93, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125,
93, 93, 125, 14, 14, 14, 14, 93, 0, 0, 0, 18, 18, 18, 18, 18, 18, 14,
14, 4, 14, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, 3, 3, 0, 0, 0, 0, 0,
0, 0, 0, 125, 125, 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, 15,
15, 15, 15, 15, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125,
125, 125, 125, 125, 125, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 9, 9,
9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93,
93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 15, 15, 15, 15, 15, 15,
3, 3, 3, 15, 3, 15, 15, 93, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93,
93, 93, 93, 93, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93,
93, 93, 93, 93, 93, 125, 125, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 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, 0, 0, 0, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 125,
125, 93, 93, 93, 93, 125, 125, 93, 93, 125, 125, 125, 3, 3, 3, 3, 3,
3, 3, 3, 3, 3, 3, 3, 3, 0, 92, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0,
0, 0, 3, 3, 15, 15, 15, 15, 15, 93, 92, 15, 15, 15, 15, 15, 15, 15,
15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 0, 15, 15,
15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 125, 125, 93, 93,
125, 125, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 93, 15, 15,
15, 15, 15, 15, 15, 15, 93, 125, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
0, 0, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 92, 15, 15, 15, 15, 15, 15, 14, 14, 14, 15, 125, 93, 125,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 93, 15, 93, 93, 93, 15, 15, 93, 93, 15, 15, 15, 15, 15, 93, 93,
15, 93, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 15, 15, 92, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 125, 93, 93, 125, 125, 3, 3, 15, 92, 92, 125, 93, 0, 0, 0,
0, 0, 0, 0, 0, 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, 0, 0, 0, 0, 0, 0, 0, 15,
15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 198, 21,
21, 21, 21, 21, 21, 21, 11, 92, 92, 92, 92, 21, 21, 21, 21, 21, 21,
21, 21, 21, 92, 11, 11, 0, 0, 0, 0, 199, 199, 199, 199, 199, 199, 199,
199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199,
199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199,
199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 15,
15, 15, 125, 125, 93, 125, 125, 93, 125, 125, 3, 125, 93, 0, 0, 9,
9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 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, 15, 15, 15, 15, 15, 15, 0, 0, 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, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0,
200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200,
200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200,
200, 200, 200, 200, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201,
201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201,
201, 201, 201, 201, 201, 201, 201, 201, 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,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 21, 21, 21, 21, 21, 0, 0, 0, 0, 0, 15, 93, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 7, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 15, 0, 15, 15, 0, 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, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 11, 11, 11, 11, 11, 11,
11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 0, 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, 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, 6, 5, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 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, 0, 0, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 0, 0, 0, 0, 0, 0, 0, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 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, 4, 14, 14, 14, 93, 93, 93,
93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 3, 3, 3, 3, 3,
3, 3, 5, 6, 3, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93,
93, 93, 93, 93, 93, 93, 93, 3, 8, 8, 12, 12, 5, 6, 5, 6, 5, 6, 5, 6,
5, 6, 5, 6, 5, 6, 5, 6, 3, 3, 5, 6, 3, 3, 3, 3, 12, 12, 12, 3, 3, 3,
0, 3, 3, 3, 3, 8, 5, 6, 5, 6, 5, 6, 3, 3, 3, 7, 8, 7, 7, 7, 0, 3, 4,
3, 3, 0, 0, 0, 0, 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, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 17,
0, 3, 3, 3, 4, 3, 3, 3, 5, 6, 3, 7, 3, 8, 3, 3, 9, 9, 9, 9, 9, 9, 9,
9, 9, 9, 3, 3, 7, 7, 7, 3, 11, 13, 13, 13, 13, 13, 13, 13, 13, 13,
13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
5, 7, 6, 7, 5, 6, 3, 5, 6, 3, 3, 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
#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
,15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15,
|
| ︙ | ︙ | |||
1217 1218 1219 1220 1221 1222 1223 |
202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202,
202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202,
202, 202, 202, 202, 0, 0, 0, 0, 203, 203, 203, 203, 203, 203, 203,
203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203,
203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203,
203, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0,
0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
| | > > > > > > > > > > | | 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 |
202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202,
202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202,
202, 202, 202, 202, 0, 0, 0, 0, 203, 203, 203, 203, 203, 203, 203,
203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203,
203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203,
203, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 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, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 204, 204, 204,
204, 204, 204, 204, 204, 204, 204, 204, 0, 204, 204, 204, 204, 204,
204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 0, 204, 204, 204,
204, 204, 204, 204, 0, 204, 204, 0, 205, 205, 205, 205, 205, 205, 205,
205, 205, 205, 205, 0, 205, 205, 205, 205, 205, 205, 205, 205, 205,
205, 205, 205, 205, 205, 205, 0, 205, 205, 205, 205, 205, 205, 205,
0, 205, 205, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92,
92, 92, 92, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 0, 92, 92, 92, 92,
92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 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, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 0, 0, 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, 0, 3, 18, 18, 18, 18, 18, 18, 18, 18, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 14, 14, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0,
|
| ︙ | ︙ | |||
1275 1276 1277 1278 1279 1280 1281 |
0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 93, 93, 8, 0, 0, 15, 15, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18,
15, 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, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93,
93, 93, 93, 93, 93, 93, 18, 18, 18, 18, 3, 3, 3, 3, 3, 0, 0, 0, 0,
| > > > | | | | | | | | | | | | | | | | | | | | | > > > > > > > > > > > > < < < < < < < < < < < < | | | | > | | | | | | | | | | | | | | | | > | | | < | | | | > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > | > | | | | | | | | | | | | | | | | > > > | | | | | | | | < < | | | > > > | > > | < > | | | | | | | | | | < < < | < < < < < < < < < < < < < < < < < < < < > > > | | > > > > > > > > > > > | > | | | | > | | | | | | | > > > > > > > | | | | | | > | | | > | | | | | | > > | | > > | | | | < < < < < < < < < < < < < < < > > > > > > > > > > > > > > > | | | | | | | | | | | | | < | < < | | | < < < | < < < < < > | > | | | < | | > | | > > > > > | > | | | > | | | | | | | | | 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 |
0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 93, 93, 8, 0, 0, 15, 15, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18,
15, 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, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93,
93, 93, 93, 93, 93, 93, 18, 18, 18, 18, 3, 3, 3, 3, 3, 0, 0, 0, 0,
0, 0, 0, 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, 15, 15, 93, 93, 93,
93, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 18, 18, 18, 18, 18, 18, 18, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 125, 93, 125,
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, 15, 15, 15, 15, 15, 15,
15, 15, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 9, 9, 9, 9, 9, 9, 9, 9,
9, 9, 93, 15, 15, 93, 93, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125,
93, 93, 93, 93, 125, 125, 93, 93, 3, 3, 17, 3, 3, 3, 3, 93, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 17, 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, 0,
0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 93,
93, 93, 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, 93, 93, 93, 93, 93, 125, 93, 93, 93, 93, 93, 93, 93,
93, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 15, 125, 125, 15,
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, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 93, 3, 3, 15, 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,
15, 15, 125, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 93, 125, 125,
15, 15, 15, 15, 3, 3, 3, 3, 93, 93, 93, 93, 3, 125, 93, 9, 9, 9, 9,
9, 9, 9, 9, 9, 9, 15, 3, 15, 3, 3, 3, 0, 18, 18, 18, 18, 18, 18, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 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, 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, 125, 125, 125,
93, 93, 93, 125, 125, 93, 125, 93, 93, 3, 3, 3, 3, 3, 3, 93, 0, 15,
15, 15, 15, 15, 15, 15, 0, 15, 0, 15, 15, 15, 15, 0, 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, 3, 0, 0, 0, 0, 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, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 93, 125, 125, 125, 93, 93, 93, 93, 93, 93,
93, 93, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0,
0, 93, 93, 125, 125, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 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, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0,
15, 15, 15, 15, 15, 0, 93, 93, 15, 125, 125, 93, 125, 125, 125, 125,
0, 0, 125, 125, 0, 0, 125, 125, 125, 0, 0, 15, 0, 0, 0, 0, 0, 0, 125,
0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 125, 125, 0, 0, 93, 93, 93, 93,
93, 93, 93, 0, 0, 0, 93, 93, 93, 93, 93, 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, 15, 15, 15, 15, 125, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93,
125, 125, 93, 93, 93, 125, 93, 15, 15, 15, 15, 3, 3, 3, 3, 3, 9, 9,
9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 0, 3, 93, 15, 15, 15, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 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,
125, 125, 125, 93, 93, 93, 93, 93, 93, 125, 93, 125, 125, 125, 125,
93, 93, 125, 93, 93, 15, 15, 3, 15, 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, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 93, 93, 93, 93, 0, 0,
125, 125, 125, 125, 93, 93, 125, 93, 93, 3, 3, 3, 3, 3, 3, 3, 3, 3,
3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 93, 93, 0,
0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
125, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 125, 125, 93, 125, 93,
93, 3, 3, 3, 15, 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, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
0, 0, 0, 0, 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, 93, 125, 93, 125, 125, 93, 93, 93,
93, 93, 93, 125, 93, 15, 3, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9,
9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 125, 125, 93, 93, 93, 93, 125, 93, 93, 93, 93, 93, 0, 0, 0, 0,
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 3, 3, 3, 14, 15, 15, 15, 15,
15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 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, 125,
125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 93, 125, 93, 93, 3, 0, 0,
0, 0, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 13,
13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 9, 9, 9, 9,
9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 0, 0,
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, 15, 15, 15, 15, 15, 15, 15, 15,
15, 125, 125, 125, 125, 125, 125, 0, 125, 125, 0, 0, 93, 93, 125, 93,
15, 125, 15, 125, 93, 3, 3, 3, 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, 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, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 93, 93, 93, 93, 0, 0, 93,
93, 125, 125, 125, 125, 93, 15, 3, 15, 125, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 93, 93,
93, 93, 93, 93, 93, 93, 93, 93, 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, 93, 93, 93,
93, 93, 93, 125, 15, 93, 93, 93, 93, 3, 3, 3, 3, 3, 3, 3, 3, 93, 0,
0, 0, 0, 0, 0, 0, 0, 15, 93, 93, 93, 93, 93, 93, 125, 125, 93, 93,
93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93,
93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 125, 93, 93, 3, 3, 3, 15,
3, 3, 3, 3, 3, 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, 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, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 125, 93, 93, 93, 93, 93, 93, 93, 0,
93, 93, 93, 93, 93, 93, 125, 93, 15, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 3, 3,
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, 0, 0, 93, 93, 93,
93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
93, 93, 0, 125, 93, 93, 93, 93, 93, 93, 93, 125, 93, 93, 125, 93, 93,
0, 0, 0, 0, 0, 0, 0, 0, 0, 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, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 0, 0, 0, 93, 0, 93, 93, 0,
93, 93, 93, 93, 93, 93, 93, 15, 93, 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, 15, 15, 15, 15, 0, 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, 15, 15, 15, 15, 15, 15,
125, 125, 125, 125, 125, 0, 93, 93, 0, 125, 125, 93, 125, 93, 15, 0,
0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 93, 93, 125, 125, 3, 3, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14,
14, 14, 4, 4, 4, 4, 14, 14, 14, 14, 14, 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, 3, 129,
129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129,
0, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 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, 15, 3, 3, 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, 0, 17, 17, 17,
17, 17, 17, 17, 17, 17, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9,
9, 9, 0, 0, 0, 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 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, 15, 15, 15, 15, 0, 0, 93, 93, 93,
93, 93, 3, 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, 93, 93, 93, 93, 93, 93, 93, 3,
3, 3, 3, 3, 14, 14, 14, 14, 92, 92, 92, 92, 3, 14, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 18, 18, 18, 18, 18, 18,
18, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 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, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 3, 3, 3, 3, 0,
0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0,
93, 15, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125,
125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125,
125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125,
125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125,
125, 0, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 92, 92, 92, 92, 92, 92, 92,
92, 92, 92, 92, 92, 92, 92, 92, 3, 92, 93, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 125, 125, 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, 15, 15,
15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92, 92, 0, 92, 92, 92, 92, 92, 92,
92, 0, 92, 92, 0, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 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, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15,
15, 15, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
0, 0, 14, 93, 93, 3, 17, 17, 17, 17, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93,
93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 0, 93, 93, 93, 93, 93, 93,
93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
0, 0, 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, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14,
14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 125,
125, 93, 93, 93, 14, 14, 14, 125, 125, 125, 125, 125, 125, 17, 17,
17, 17, 17, 17, 17, 17, 93, 93, 93, 93, 93, 93, 93, 93, 14, 14, 93,
93, 93, 93, 93, 93, 93, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 93, 93, 93, 93, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 93, 93, 93, 14, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
18, 18, 0, 0, 0, 0, 0, 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, 14, 14, 14, 14,
0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0,
0, 0, 0, 0, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108,
108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108,
108, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108,
108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108,
108, 108, 108, 108, 108, 108, 21, 21, 21, 21, 21, 21, 21, 0, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108,
108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108,
108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 108, 0, 108, 108, 0, 0, 108, 0, 0, 108, 108,
0, 0, 108, 108, 108, 108, 0, 108, 108, 108, 108, 108, 108, 108, 108,
21, 21, 21, 21, 0, 21, 0, 21, 21, 21, 21, 21, 21, 21, 0, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, 108,
108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108,
108, 108, 108, 108, 108, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 108,
0, 108, 108, 108, 108, 0, 0, 108, 108, 108, 108, 108, 108, 108, 108,
0, 108, 108, 108, 108, 108, 108, 108, 0, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 108, 108, 0, 108, 108, 108, 108, 0, 108, 108, 108, 108, 108,
0, 108, 0, 0, 0, 108, 108, 108, 108, 108, 108, 108, 0, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, 108, 108, 108,
108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108,
108, 108, 108, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 108, 108,
108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 108,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, 108,
108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108,
108, 108, 108, 108, 108, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 108,
108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108,
21, 21, 21, 21, 21, 21, 0, 0, 108, 108, 108, 108, 108, 108, 108, 108,
108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108,
108, 108, 108, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21,
21, 21, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108,
108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 7,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 108, 108,
108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108,
108, 108, 108, 108, 108, 108, 108, 108, 108, 7, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108,
108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108,
108, 108, 108, 108, 108, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, 21,
21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108,
108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108,
108, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21,
108, 21, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
9, 9, 9, 9, 9, 9, 9, 9, 9, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 14, 14, 14, 14,
93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
93, 14, 14, 14, 14, 14, 14, 14, 14, 93, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 93, 14, 14, 3, 3, 3, 3, 3, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 0, 93, 93, 93,
93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
15, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 0, 93, 93, 93, 93, 93, 93, 93, 0, 93, 93, 93, 93, 93,
93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 0, 93, 93, 93, 93,
93, 93, 93, 0, 93, 93, 0, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 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, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 92, 92,
92, 92, 92, 92, 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0,
15, 14, 0, 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, 93, 0, 0, 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, 93, 93, 93, 93, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0,
4, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 15, 0, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15,
15, 15, 15, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 93, 93, 93, 93,
93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 206, 206, 206, 206, 206, 206,
206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206,
206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206,
207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
207, 207, 207, 207, 207, 207, 93, 93, 93, 93, 93, 93, 93, 92, 0, 0,
0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 3, 3, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
18, 18, 14, 18, 18, 18, 4, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 18, 18,
18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 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, 15, 0, 15, 15, 0, 15, 0,
0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15,
0, 15, 0, 15, 0, 0, 0, 0, 0, 0, 15, 0, 0, 0, 0, 15, 0, 15, 0, 15, 0,
15, 15, 15, 0, 15, 15, 0, 15, 0, 0, 15, 0, 15, 0, 15, 0, 15, 0, 15,
0, 15, 15, 0, 15, 0, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15,
15, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 0, 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, 0, 0, 0, 0, 0, 15, 15, 15, 0, 15, 15, 15,
15, 15, 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, 0, 0, 0, 0,
0, 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 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, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 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, 0, 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, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0,
0, 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, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0,
0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 14,
14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 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, 14, 14, 14, 14, 14, 14, 14, 14, 11, 11, 11, 11, 11,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 0, 0, 0, 0, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14,
14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14,
14, 0, 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, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 0, 0, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14,
14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 14,
14, 14, 0, 0, 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, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 14, 14, 14,
14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14,
14, 0, 0, 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, 0, 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0
#endif /* TCL_UTF_MAX > 3 */
};
/*
* Each group represents a unique set of character attributes. The attributes
* are encoded into a 32-bit value as follows:
*
|
| ︙ | ︙ | |||
1638 1639 1640 1641 1642 1643 1644 |
-21886, -25470, -32638, -28542, -32126, -1981, -2174, -18879,
-2237, 1844610, -21951, -25535, -28607, -32703, -32191, 13, 14,
-1924287, -2145983, -2115007, 7233, 7298, 4170, 4234, 6749, 6813,
-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,
| | | 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 |
-21886, -25470, -32638, -28542, -32126, -1981, -2174, -18879,
-2237, 1844610, -21951, -25535, -28607, -32703, -32191, 13, 14,
-1924287, -2145983, -2115007, 7233, 7298, 4170, 4234, 6749, 6813,
-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
};
#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= 0x31360)
#else
# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1F0000) != 0)
#endif
|
| ︙ | ︙ |
Changes to generic/tclUtf.c.
| ︙ | ︙ | |||
1133 1134 1135 1136 1137 1138 1139 |
if (index < 0) {
return -1;
}
while (index-- > 0) {
i = TclUtfToUniChar(src, &ch);
src += i;
}
| | | | 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 |
if (index < 0) {
return -1;
}
while (index-- > 0) {
i = TclUtfToUniChar(src, &ch);
src += i;
}
#if TCL_UTF_MAX < 4
if ((ch >= 0xD800) && (i < 3)) {
/* Index points at character following high Surrogate */
return -1;
}
#endif
TclUtfToUCS4(src, &i);
return i;
}
/*
*---------------------------------------------------------------------------
*
* Tcl_UtfAtIndex --
*
* Returns a pointer to the specified character (not byte) position in
* the UTF-8 string. If TCL_UTF_MAX < 4, characters > U+FFFF count as
* 2 positions, but then the pointer should never be placed between
* the two positions.
*
* Results:
* As above.
*
* Side effects:
|
| ︙ | ︙ | |||
1174 1175 1176 1177 1178 1179 1180 |
Tcl_UniChar ch = 0;
int len = 0;
while (index-- > 0) {
len = TclUtfToUniChar(src, &ch);
src += len;
}
| | | 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 |
Tcl_UniChar ch = 0;
int len = 0;
while (index-- > 0) {
len = TclUtfToUniChar(src, &ch);
src += len;
}
#if TCL_UTF_MAX < 4
if ((ch >= 0xD800) && (len < 3)) {
/* Index points at character following high Surrogate */
src += TclUtfToUniChar(src, &ch);
}
#endif
return src;
}
|
| ︙ | ︙ | |||
1496 1497 1498 1499 1500 1501 1502 |
* only when both strings are of at least n chars long (no need for \0
* check)
*/
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
| | | 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 |
* only when both strings are of at least n chars long (no need for \0
* check)
*/
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
#if TCL_UTF_MAX < 4
/* Surrogates always report higher than non-surrogates */
if (((ch1 & 0xFC00) == 0xD800)) {
if ((ch2 & 0xFC00) != 0xD800) {
return ch1;
}
} else if ((ch2 & 0xFC00) == 0xD800) {
return -ch2;
|
| ︙ | ︙ | |||
1547 1548 1549 1550 1551 1552 1553 |
* n must be interpreted as chars, not bytes.
* This should be called only when both strings are of
* at least n chars long (no need for \0 check)
*/
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
| | | 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 |
* n must be interpreted as chars, not bytes.
* This should be called only when both strings are of
* at least n chars long (no need for \0 check)
*/
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
#if TCL_UTF_MAX < 4
/* Surrogates always report higher than non-surrogates */
if (((ch1 & 0xFC00) == 0xD800)) {
if ((ch2 & 0xFC00) != 0xD800) {
return ch1;
}
} else if ((ch2 & 0xFC00) == 0xD800) {
return -ch2;
|
| ︙ | ︙ | |||
1596 1597 1598 1599 1600 1601 1602 |
{
Tcl_UniChar ch1 = 0, ch2 = 0;
while (*cs && *ct) {
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
| | | 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 |
{
Tcl_UniChar ch1 = 0, ch2 = 0;
while (*cs && *ct) {
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
#if TCL_UTF_MAX < 4
/* Surrogates always report higher than non-surrogates */
if (((ch1 & 0xFC00) == 0xD800)) {
if ((ch2 & 0xFC00) != 0xD800) {
return ch1;
}
} else if ((ch2 & 0xFC00) == 0xD800) {
return -ch2;
|
| ︙ | ︙ | |||
1642 1643 1644 1645 1646 1647 1648 |
{
Tcl_UniChar ch1 = 0, ch2 = 0;
while (*cs && *ct) {
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
| | | 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 |
{
Tcl_UniChar ch1 = 0, ch2 = 0;
while (*cs && *ct) {
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
#if TCL_UTF_MAX < 4
/* Surrogates always report higher than non-surrogates */
if (((ch1 & 0xFC00) == 0xD800)) {
if ((ch2 & 0xFC00) != 0xD800) {
return ch1;
}
} else if ((ch2 & 0xFC00) == 0xD800) {
return -ch2;
|
| ︙ | ︙ | |||
1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 |
/* Clear away extension bits, if any */
return ch & 0x1FFFFF;
}
/*
*----------------------------------------------------------------------
*
* Tcl_UniCharLen --
*
* Find the length of a UniChar string. The str input must be null
* terminated.
*
* Results:
* Returns the length of str in UniChars (not bytes).
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
Tcl_UniCharLen(
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | 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 |
/* Clear away extension bits, if any */
return ch & 0x1FFFFF;
}
/*
*----------------------------------------------------------------------
*
* Tcl_Char16Len --
*
* Find the length of a UniChar string. The str input must be null
* terminated.
*
* Results:
* Returns the length of str in UniChars (not bytes).
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
Tcl_Char16Len(
const unsigned short *uniStr) /* Unicode string to find length of. */
{
int len = 0;
while (*uniStr != '\0') {
len++;
uniStr++;
}
return len;
}
/*
*----------------------------------------------------------------------
*
* Tcl_UniCharLen --
*
* Find the length of a UniChar string. The str input must be null
* terminated.
*
* Results:
* Returns the length of str in UniChars (not bytes).
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
#undef Tcl_UniCharLen
int
Tcl_UniCharLen(
const int *uniStr) /* Unicode string to find length of. */
{
int len = 0;
while (*uniStr != '\0') {
len++;
uniStr++;
}
|
| ︙ | ︙ | |||
2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 |
{
if (UNICODE_OUT_OF_RANGE(ch)) {
return 0;
}
return (GetCategory(ch) == UPPERCASE_LETTER);
}
/*
*----------------------------------------------------------------------
*
* Tcl_UniCharIsWordChar --
*
* Test if a character is alphanumeric or a connector punctuation mark.
*
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
{
if (UNICODE_OUT_OF_RANGE(ch)) {
return 0;
}
return (GetCategory(ch) == UPPERCASE_LETTER);
}
/*
*----------------------------------------------------------------------
*
* Tcl_UniCharIsUnicode --
*
* Test if a character is a Unicode character.
*
* Results:
* Returns non-zero if character belongs to the Unicode set.
*
* Excluded are:
* 1) All characters > U+10FFFF
* 2) Surrogates U+D800 - U+DFFF
* 3) Last 2 characters of each plane, so U+??FFFE and U+??FFFF
* 4) The characters in the range U+FDD0 - U+FDEF
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
Tcl_UniCharIsUnicode(
int ch) /* Unicode character to test. */
{
return ((unsigned int)ch <= 0x10FFFF) && ((ch & 0xFFF800) != 0xD800)
&& ((ch & 0xFFFE) != 0xFFFE) && ((unsigned int)(ch - 0xFDD0) >= 32);
}
/*
*----------------------------------------------------------------------
*
* Tcl_UniCharIsWordChar --
*
* Test if a character is alphanumeric or a connector punctuation mark.
*
|
| ︙ | ︙ | |||
2608 2609 2610 2611 2612 2613 2614 | * * Side effects: * None. * *--------------------------------------------------------------------------- */ | | | 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 |
*
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
#if TCL_UTF_MAX < 4
int
TclUtfToUCS4(
const char *src, /* The UTF-8 string. */
int *ucs4Ptr) /* Filled with the UCS4 codepoint represented
* by the UTF-8 string. */
{
/* Make use of the #undef Tcl_UtfToUniChar above, which already handles UCS4. */
|
| ︙ | ︙ |
Changes to generic/tclUtil.c.
| ︙ | ︙ | |||
119 120 121 122 123 124 125 | const char **nextPtr, int *sizePtr, int *literalPtr); /* * The following is the Tcl object type definition for an object that * represents a list index in the form, "end-offset". It is used as a * performance optimization in Tcl_GetIntForIndex. The internal rep is * stored directly in the wideValue, so no memory management is required | | | 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 |
const char **nextPtr, int *sizePtr,
int *literalPtr);
/*
* The following is the Tcl object type definition for an object that
* represents a list index in the form, "end-offset". It is used as a
* performance optimization in Tcl_GetIntForIndex. The internal rep is
* stored directly in the wideValue, so no memory management is required
* for it. This is a caching internalrep, keeping the result of a parse
* around. This type is only created from a pre-existing string, so an
* updateStringProc will never be called and need not exist. The type
* is unregistered, so has no need of a setFromAnyProc either.
*/
static const Tcl_ObjType endOffsetType = {
"end-offset", /* name */
|
| ︙ | ︙ | |||
798 799 800 801 802 803 804 805 |
{
int newCount = 0;
while (count > 0) {
char c = *src;
if (c == '\\') {
int numRead;
| > | > | 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 |
{
int newCount = 0;
while (count > 0) {
char c = *src;
if (c == '\\') {
char buf[4] = "";
int numRead;
int backslashCount = TclParseBackslash(src, count, &numRead, buf);
memcpy(dst, buf, backslashCount);
dst += backslashCount;
newCount += backslashCount;
src += numRead;
count -= numRead;
} else {
*dst = c;
dst++;
|
| ︙ | ︙ | |||
2026 2027 2028 2029 2030 2031 2032 |
resPtr = NULL;
for (i = 0; i < objc; i++) {
objPtr = objv[i];
if (!TclListObjIsCanonical(objPtr)) {
continue;
}
if (resPtr) {
| > > > > > > > | | 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 |
resPtr = NULL;
for (i = 0; i < objc; i++) {
objPtr = objv[i];
if (!TclListObjIsCanonical(objPtr)) {
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);
goto slow;
}
} else {
resPtr = TclListObjCopy(NULL, objPtr);
}
|
| ︙ | ︙ | |||
2578 2579 2580 2581 2582 2583 2584 |
/*
* Promote based on the type of incoming object.
* XXX: Currently doesn't take advantage of exact-ness that
* XXX: TclReToGlob tells us about
trivial = nocase ? 0 : TclMatchIsTrivial(TclGetString(ptnObj));
*/
| | | 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 |
/*
* Promote based on the type of incoming object.
* XXX: Currently doesn't take advantage of exact-ness that
* XXX: TclReToGlob tells us about
trivial = nocase ? 0 : TclMatchIsTrivial(TclGetString(ptnObj));
*/
if (TclHasInternalRep(strObj, &tclStringType) || (strObj->typePtr == NULL)) {
Tcl_UniChar *udata, *uptn;
udata = Tcl_GetUnicodeFromObj(strObj, &length);
uptn = Tcl_GetUnicodeFromObj(ptnObj, &plen);
match = TclUniCharMatch(udata, length, uptn, plen, flags);
} else if (TclIsPureByteArray(strObj) && TclIsPureByteArray(ptnObj)
&& !flags) {
|
| ︙ | ︙ | |||
3024 3025 3026 3027 3028 3029 3030 |
dsPtr->string[0] = 0;
dsPtr->length = 0;
dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
} else {
dsPtr->string = TclGetString(iPtr->objResultPtr);
dsPtr->length = iPtr->objResultPtr->length;
dsPtr->spaceAvl = dsPtr->length + 1;
| | | 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 |
dsPtr->string[0] = 0;
dsPtr->length = 0;
dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
} else {
dsPtr->string = TclGetString(iPtr->objResultPtr);
dsPtr->length = iPtr->objResultPtr->length;
dsPtr->spaceAvl = dsPtr->length + 1;
TclFreeInternalRep(iPtr->objResultPtr);
iPtr->objResultPtr->bytes = &tclEmptyString;
iPtr->objResultPtr->length = 0;
}
return;
}
/*
|
| ︙ | ︙ | |||
3218 3219 3220 3221 3222 3223 3224 |
char *end;
int *precisionPtr = (int *)Tcl_GetThreadData(&precisionKey, sizeof(int));
/*
* Handle NaN.
*/
| | | | 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 |
char *end;
int *precisionPtr = (int *)Tcl_GetThreadData(&precisionKey, sizeof(int));
/*
* Handle NaN.
*/
if (isnan(value)) {
TclFormatNaN(value, dst);
return;
}
/*
* Handle infinities.
*/
if (isinf(value)) {
/*
* Remember to copy the terminating NUL too.
*/
if (value < 0) {
memcpy(dst, "-Inf", 5);
} else {
|
| ︙ | ︙ | |||
3688 3689 3690 3691 3692 3693 3694 |
int endValue, /* The value to be stored at "indexPtr" if
* "objPtr" holds "end". */
int *indexPtr) /* Location filled in with an integer
* representing an index. May be NULL.*/
{
Tcl_WideInt wide;
| | | | 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 |
int endValue, /* The value to be stored at "indexPtr" if
* "objPtr" holds "end". */
int *indexPtr) /* Location filled in with an integer
* representing an index. May be NULL.*/
{
Tcl_WideInt wide;
if (GetWideForIndex(interp, objPtr, endValue, &wide) == TCL_ERROR) {
return TCL_ERROR;
}
if (indexPtr != NULL) {
if ((wide < 0) && (endValue >= 0)) {
*indexPtr = -1;
} else if (wide > INT_MAX) {
*indexPtr = INT_MAX;
} else if (wide < INT_MIN) {
*indexPtr = INT_MIN;
} else {
*indexPtr = (int) wide;
|
| ︙ | ︙ | |||
3741 3742 3743 3744 3745 3746 3747 |
Tcl_Interp *interp,
Tcl_Obj *objPtr, /* Pointer to the object to parse */
size_t endValue, /* The value to be stored at "indexPtr" if
* "objPtr" holds "end". */
Tcl_WideInt *widePtr) /* Location filled in with an integer
* representing an index. */
{
| | | | | 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 |
Tcl_Interp *interp,
Tcl_Obj *objPtr, /* Pointer to the object to parse */
size_t endValue, /* The value to be stored at "indexPtr" if
* "objPtr" holds "end". */
Tcl_WideInt *widePtr) /* Location filled in with an integer
* representing an index. */
{
Tcl_ObjInternalRep *irPtr;
Tcl_WideInt offset = -1; /* Offset in the "end-offset" expression - 1 */
ClientData cd;
while ((irPtr = TclFetchInternalRep(objPtr, &endOffsetType)) == NULL) {
Tcl_ObjInternalRep ir;
int length;
const char *bytes = TclGetStringFromObj(objPtr, &length);
if (*bytes != 'e') {
int numType;
const char *opPtr;
int t1 = 0, t2 = 0;
|
| ︙ | ︙ | |||
3773 3774 3775 3776 3777 3778 3779 | /* * Quick scan to see if multi-value list is even possible. * This relies on TclGetString() returning a NUL-terminated string. */ if ((TclMaxListLength(bytes, -1, NULL) > 1) /* If it's possible, do the full list parse. */ | | | 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 |
/*
* Quick scan to see if multi-value list is even possible.
* This relies on TclGetString() returning a NUL-terminated string.
*/
if ((TclMaxListLength(bytes, -1, NULL) > 1)
/* If it's possible, do the full list parse. */
&& (TCL_OK == TclListObjLength(NULL, objPtr, &length))
&& (length > 1)) {
goto parseError;
}
/* Passed the list screen, so parse for index arithmetic expression */
if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, NULL, -1, &opPtr,
TCL_PARSE_INTEGER_ONLY)) {
|
| ︙ | ︙ | |||
3805 3806 3807 3808 3809 3810 3811 |
/* Save second integer as wide if possible */
TclGetNumberFromObj(NULL, objPtr, &cd, &t2);
if (t2 == TCL_NUMBER_INT) {
w2 = (*(Tcl_WideInt *)cd);
}
}
}
| | | | 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 |
/* Save second integer as wide if possible */
TclGetNumberFromObj(NULL, objPtr, &cd, &t2);
if (t2 == TCL_NUMBER_INT) {
w2 = (*(Tcl_WideInt *)cd);
}
}
}
/* Clear invalid internalreps left by TclParseNumber */
TclFreeInternalRep(objPtr);
if (t1 && t2) {
/* We have both integer values */
if ((t1 == TCL_NUMBER_INT) && (t2 == TCL_NUMBER_INT)) {
/* Both are wide, do wide-integer math */
if (*opPtr == '-') {
if (w2 == WIDE_MIN) {
|
| ︙ | ︙ | |||
3931 3932 3933 3934 3935 3936 3937 |
}
}
}
parseOK:
/* Success. Store the new internal rep. */
ir.wideValue = offset;
| | | 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 |
}
}
}
parseOK:
/* Success. Store the new internal rep. */
ir.wideValue = offset;
Tcl_StoreInternalRep(objPtr, &endOffsetType, &ir);
}
offset = irPtr->wideValue;
if (offset == WIDE_MAX) {
*widePtr = endValue + 1;
} else if (offset == WIDE_MIN) {
|
| ︙ | ︙ | |||
4036 4037 4038 4039 4040 4041 4042 |
int after, /* Value to return for index after end */
int *indexPtr) /* Where to write the encoded answer, not NULL */
{
Tcl_WideInt wide;
int idx;
if (TCL_OK == GetWideForIndex(interp, objPtr, (unsigned)TCL_INDEX_END , &wide)) {
| | | 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054 4055 4056 4057 4058 4059 |
int after, /* Value to return for index after end */
int *indexPtr) /* Where to write the encoded answer, not NULL */
{
Tcl_WideInt wide;
int idx;
if (TCL_OK == GetWideForIndex(interp, objPtr, (unsigned)TCL_INDEX_END , &wide)) {
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &endOffsetType);
if (irPtr && irPtr->wideValue >= 0) {
/* "int[+-]int" syntax, works the same here as "int" */
irPtr = NULL;
}
/*
* We parsed an end+offset index value.
* wide holds the offset value in the range WIDE_MIN...WIDE_MAX.
|
| ︙ | ︙ | |||
4319 4320 4321 4322 4323 4324 4325 |
if (pgvPtr->encoding) {
Tcl_FreeEncoding(pgvPtr->encoding);
}
pgvPtr->encoding = encoding;
/*
* Fill the local thread copy directly with the Tcl_Obj value to avoid
| | | 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 |
if (pgvPtr->encoding) {
Tcl_FreeEncoding(pgvPtr->encoding);
}
pgvPtr->encoding = encoding;
/*
* Fill the local thread copy directly with the Tcl_Obj value to avoid
* loss of the internalrep. Increment newValue refCount early to handle case
* where we set a PGV to itself.
*/
Tcl_IncrRefCount(newValue);
cacheMap = GetThreadHash(&pgvPtr->key);
ClearHash(cacheMap);
hPtr = Tcl_CreateHashEntry(cacheMap, INT2PTR(pgvPtr->epoch), &dummy);
|
| ︙ | ︙ |
Changes to generic/tclVar.c.
| ︙ | ︙ | |||
249 250 251 252 253 254 255 |
*/
static const Tcl_ObjType localVarNameType = {
"localVarName",
FreeLocalVarName, DupLocalVarName, NULL, NULL
};
| | | | | | | | | | | | | | 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 |
*/
static const Tcl_ObjType localVarNameType = {
"localVarName",
FreeLocalVarName, DupLocalVarName, NULL, NULL
};
#define LocalSetInternalRep(objPtr, index, namePtr) \
do { \
Tcl_ObjInternalRep ir; \
Tcl_Obj *ptr = (namePtr); \
if (ptr) {Tcl_IncrRefCount(ptr);} \
ir.twoPtrValue.ptr1 = ptr; \
ir.twoPtrValue.ptr2 = INT2PTR(index); \
Tcl_StoreInternalRep((objPtr), &localVarNameType, &ir); \
} while (0)
#define LocalGetInternalRep(objPtr, index, name) \
do { \
const Tcl_ObjInternalRep *irPtr; \
irPtr = TclFetchInternalRep((objPtr), &localVarNameType); \
(name) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL; \
(index) = irPtr ? PTR2INT(irPtr->twoPtrValue.ptr2) : -1; \
} while (0)
static const Tcl_ObjType parsedVarNameType = {
"parsedVarName",
FreeParsedVarName, DupParsedVarName, NULL, NULL
};
#define ParsedSetInternalRep(objPtr, arrayPtr, elem) \
do { \
Tcl_ObjInternalRep ir; \
Tcl_Obj *ptr1 = (arrayPtr); \
Tcl_Obj *ptr2 = (elem); \
if (ptr1) {Tcl_IncrRefCount(ptr1);} \
if (ptr2) {Tcl_IncrRefCount(ptr2);} \
ir.twoPtrValue.ptr1 = ptr1; \
ir.twoPtrValue.ptr2 = ptr2; \
Tcl_StoreInternalRep((objPtr), &parsedVarNameType, &ir); \
} while (0)
#define ParsedGetInternalRep(objPtr, parsed, array, elem) \
do { \
const Tcl_ObjInternalRep *irPtr; \
irPtr = TclFetchInternalRep((objPtr), &parsedVarNameType); \
(parsed) = (irPtr != NULL); \
(array) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL; \
(elem) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL; \
} while (0)
Var *
TclVarHashCreateVar(
|
| ︙ | ︙ | |||
611 612 613 614 615 616 617 |
int localIndex;
Tcl_Obj *namePtr, *arrayPtr, *elem;
*arrayPtrPtr = NULL;
restart:
| | | 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 |
int localIndex;
Tcl_Obj *namePtr, *arrayPtr, *elem;
*arrayPtrPtr = NULL;
restart:
LocalGetInternalRep(part1Ptr, localIndex, namePtr);
if (localIndex >= 0) {
if (HasLocalVars(varFramePtr)
&& !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
&& (localIndex < varFramePtr->numCompiledLocals)) {
/*
* Use the cached index if the names coincide.
*/
|
| ︙ | ︙ | |||
635 636 637 638 639 640 641 |
goto doneParsing;
}
/*
* If part1Ptr is a parsedVarNameType, retrieve the pre-parsed parts.
*/
| | | 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 |
goto doneParsing;
}
/*
* If part1Ptr is a parsedVarNameType, retrieve the pre-parsed parts.
*/
ParsedGetInternalRep(part1Ptr, parsed, arrayPtr, elem);
if (parsed && arrayPtr) {
if (part2Ptr != NULL) {
/*
* ERROR: part1Ptr is already an array element, cannot specify
* a part2.
*/
|
| ︙ | ︙ | |||
681 682 683 684 685 686 687 | return NULL; } arrayPtr = Tcl_NewStringObj(part1, (part2 - part1)); part2Ptr = Tcl_NewStringObj(part2 + 1, len - (part2 - part1) - 2); | | | 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 |
return NULL;
}
arrayPtr = Tcl_NewStringObj(part1, (part2 - part1));
part2Ptr = Tcl_NewStringObj(part2 + 1,
len - (part2 - part1) - 2);
ParsedSetInternalRep(part1Ptr, arrayPtr, part2Ptr);
part1Ptr = arrayPtr;
}
}
}
doneParsing:
|
| ︙ | ︙ | |||
717 718 719 720 721 722 723 |
/*
* An indexed local variable.
*/
Tcl_Obj *cachedNamePtr = localName(varFramePtr, index);
if (part1Ptr == cachedNamePtr) {
| | | | | | | | | 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 |
/*
* An indexed local variable.
*/
Tcl_Obj *cachedNamePtr = localName(varFramePtr, index);
if (part1Ptr == cachedNamePtr) {
LocalSetInternalRep(part1Ptr, index, NULL);
} else {
/*
* [80304238ac] Trickiness here. We will store and incr the
* refcount on cachedNamePtr. Trouble is that it's possible
* (see test var-22.1) for cachedNamePtr to have an internalrep
* that contains a stored and refcounted part1Ptr. This
* would be a reference cycle which leads to a memory leak.
*
* The solution here is to wipe away all internalrep(s) in
* cachedNamePtr and leave it as string only. This is
* radical and destructive, so a better idea would be welcome.
*/
/*
* Firstly set cached local var reference (avoid free before set,
* see [45b9faf103f2])
*/
LocalSetInternalRep(part1Ptr, index, cachedNamePtr);
/* Then wipe it */
TclFreeInternalRep(cachedNamePtr);
/*
* Now go ahead and convert it the the "localVarName" type,
* since we suspect at least some use of the value as a
* varname and we want to resolve it quickly.
*/
LocalSetInternalRep(cachedNamePtr, index, NULL);
}
} else {
/*
* At least mark part1Ptr as already parsed.
*/
ParsedSetInternalRep(part1Ptr, NULL, NULL);
}
donePart1:
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
|
| ︙ | ︙ | |||
3187 3188 3189 3190 3191 3192 3193 |
return TCL_ERROR;
}
/*
* Parse arguments.
*/
| | | 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 |
return TCL_ERROR;
}
/*
* Parse arguments.
*/
if (TclListObjLength(interp, objv[1], &numVars) != TCL_OK) {
return TCL_ERROR;
}
if (numVars != 2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"must have two variable names", -1));
Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "array", "for", NULL);
|
| ︙ | ︙ | |||
3298 3299 3300 3301 3302 3303 3304 |
Tcl_SetErrorCode(interp, "TCL", "READ", "array", "for", NULL);
varPtr->flags |= TCL_LEAVE_ERR_MSG;
result = done;
}
goto arrayfordone;
}
| | | 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 |
Tcl_SetErrorCode(interp, "TCL", "READ", "array", "for", NULL);
varPtr->flags |= TCL_LEAVE_ERR_MSG;
result = done;
}
goto arrayfordone;
}
TclListObjGetElements(NULL, varListObj, &varc, &varv);
if (Tcl_ObjSetVar2(interp, varv[0], NULL, keyObj,
TCL_LEAVE_ERR_MSG) == NULL) {
result = TCL_ERROR;
goto arrayfordone;
}
if (valueObj != NULL) {
if (Tcl_ObjSetVar2(interp, varv[1], NULL, valueObj,
|
| ︙ | ︙ | |||
3838 3839 3840 3841 3842 3843 3844 |
}
/*
* Get the array values corresponding to each element name.
*/
TclNewObj(tmpResObj);
| | | 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 |
}
/*
* Get the array values corresponding to each element name.
*/
TclNewObj(tmpResObj);
result = TclListObjGetElements(interp, nameLstObj, &count, &nameObjPtr);
if (result != TCL_OK) {
goto errorInArrayGet;
}
for (i=0 ; i<count ; i++) {
nameObj = *nameObjPtr++;
valueObj = Tcl_ObjGetVar2(interp, varNameObj, nameObj,
|
| ︙ | ︙ | |||
4111 4112 4113 4114 4115 4116 4117 |
}
/*
* Install the contents of the dictionary or list into the array.
*/
arrayElemObj = objv[2];
| | | 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 |
}
/*
* Install the contents of the dictionary or list into the array.
*/
arrayElemObj = objv[2];
if (TclHasInternalRep(arrayElemObj, &tclDictType) && arrayElemObj->bytes == NULL) {
Tcl_Obj *keyPtr, *valuePtr;
Tcl_DictSearch search;
int done;
if (Tcl_DictObjSize(interp, arrayElemObj, &done) != TCL_OK) {
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
5784 5785 5786 5787 5788 5789 5790 |
static void
FreeLocalVarName(
Tcl_Obj *objPtr)
{
int index;
Tcl_Obj *namePtr;
| | | | | | | | 5784 5785 5786 5787 5788 5789 5790 5791 5792 5793 5794 5795 5796 5797 5798 5799 5800 5801 5802 5803 5804 5805 5806 5807 5808 5809 5810 5811 5812 5813 5814 5815 5816 5817 5818 5819 5820 5821 5822 5823 5824 5825 5826 5827 5828 5829 5830 5831 5832 5833 5834 5835 5836 5837 5838 5839 5840 5841 5842 5843 5844 5845 5846 5847 5848 5849 5850 5851 5852 5853 5854 5855 5856 5857 |
static void
FreeLocalVarName(
Tcl_Obj *objPtr)
{
int index;
Tcl_Obj *namePtr;
LocalGetInternalRep(objPtr, index, namePtr);
index++; /* Compiler warning bait. */
if (namePtr) {
Tcl_DecrRefCount(namePtr);
}
}
static void
DupLocalVarName(
Tcl_Obj *srcPtr,
Tcl_Obj *dupPtr)
{
int index;
Tcl_Obj *namePtr;
LocalGetInternalRep(srcPtr, index, namePtr);
if (!namePtr) {
namePtr = srcPtr;
}
LocalSetInternalRep(dupPtr, index, namePtr);
}
/*
* parsedVarName -
*
* INTERNALREP DEFINITION:
* twoPtrValue.ptr1 = pointer to the array name Tcl_Obj (NULL if scalar)
* twoPtrValue.ptr2 = pointer to the element name string (owned by this
* Tcl_Obj), or NULL if it is a scalar variable
*/
static void
FreeParsedVarName(
Tcl_Obj *objPtr)
{
Tcl_Obj *arrayPtr, *elem;
int parsed;
ParsedGetInternalRep(objPtr, parsed, arrayPtr, elem);
parsed++; /* Silence compiler. */
if (arrayPtr != NULL) {
TclDecrRefCount(arrayPtr);
TclDecrRefCount(elem);
}
}
static void
DupParsedVarName(
Tcl_Obj *srcPtr,
Tcl_Obj *dupPtr)
{
Tcl_Obj *arrayPtr, *elem;
int parsed;
ParsedGetInternalRep(srcPtr, parsed, arrayPtr, elem);
parsed++; /* Silence compiler. */
ParsedSetInternalRep(dupPtr, arrayPtr, elem);
}
/*
*----------------------------------------------------------------------
*
* Tcl_FindNamespaceVar -- MOVED OVER from tclNamesp.c
*
|
| ︙ | ︙ |
Changes to generic/tclZipfs.c.
| ︙ | ︙ | |||
27 28 29 30 31 32 33 34 35 36 37 38 39 40 | #define MAP_FILE 0 #endif /* !MAP_FILE */ #define NOBYFOUR #define crc32tab crc_table[0] #ifndef TBLS #define TBLS 1 #endif #ifdef HAVE_ZLIB #include "zlib.h" #include "crypt.h" #include "zutil.h" #include "crc32.h" | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
#define MAP_FILE 0
#endif /* !MAP_FILE */
#define NOBYFOUR
#define crc32tab crc_table[0]
#ifndef TBLS
#define TBLS 1
#endif
#if !defined(_WIN32) && !defined(NO_DLFCN_H)
#include <dlfcn.h>
#endif
/*
* Macros to report errors only if an interp is present.
*/
#define ZIPFS_ERROR(interp,errstr) \
do { \
if (interp) { \
Tcl_SetObjResult(interp, Tcl_NewStringObj(errstr, -1)); \
} \
} while (0)
#define ZIPFS_MEM_ERROR(interp) \
do { \
if (interp) { \
Tcl_SetObjResult(interp, Tcl_NewStringObj( \
"out of memory", -1)); \
Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL); \
} \
} while (0)
#define ZIPFS_POSIX_ERROR(interp,errstr) \
do { \
if (interp) { \
Tcl_SetObjResult(interp, Tcl_ObjPrintf( \
"%s: %s", errstr, Tcl_PosixError(interp))); \
} \
} while (0)
#define ZIPFS_ERROR_CODE(interp,errcode) \
do { \
if (interp) { \
Tcl_SetErrorCode(interp, "TCL", "ZIPFS", errcode, NULL); \
} \
} while (0)
#ifdef HAVE_ZLIB
#include "zlib.h"
#include "crypt.h"
#include "zutil.h"
#include "crc32.h"
|
| ︙ | ︙ | |||
116 117 118 119 120 121 122 | #define ZIP_COMPMETH_STORED 0 #define ZIP_COMPMETH_DEFLATED 8 #define ZIP_PASSWORD_END_SIG 0x5a5a4b50 #define DEFAULT_WRITE_MAX_SIZE (2 * 1024 * 1024) | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 153 154 155 156 157 158 159 160 161 162 163 164 165 166 |
#define ZIP_COMPMETH_STORED 0
#define ZIP_COMPMETH_DEFLATED 8
#define ZIP_PASSWORD_END_SIG 0x5a5a4b50
#define DEFAULT_WRITE_MAX_SIZE (2 * 1024 * 1024)
/*
* Windows drive letters.
*/
#ifdef _WIN32
static const char drvletters[] =
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
|
| ︙ | ︙ | |||
245 246 247 248 249 250 251 | /* * Global variables. * * Most are kept in single ZipFS struct. When build with threading support * this struct is protected by the ZipFSMutex (see below). * | | | 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 |
/*
* Global variables.
*
* Most are kept in single ZipFS struct. When build with threading support
* this struct is protected by the ZipFSMutex (see below).
*
* The "fileHash" component is the process-wide global table of all known ZIP
* archive members in all mounted ZIP archives.
*
* The "zipHash" components is the process wide global table of all mounted
* ZIP archive files.
*/
static struct {
|
| ︙ | ︙ | |||
300 301 302 303 304 305 306 | ZipChannel *info, ZipEntry *z); static int InitWritableChannel(Tcl_Interp *interp, ZipChannel *info, ZipEntry *z, int trunc); static inline int ListMountPoints(Tcl_Interp *interp); static void SerializeCentralDirectoryEntry( const unsigned char *start, const unsigned char *end, unsigned char *buf, | | < | < | 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 | ZipChannel *info, ZipEntry *z); static int InitWritableChannel(Tcl_Interp *interp, ZipChannel *info, ZipEntry *z, int trunc); static inline int ListMountPoints(Tcl_Interp *interp); static void SerializeCentralDirectoryEntry( const unsigned char *start, const unsigned char *end, unsigned char *buf, ZipEntry *z, size_t nameLength); static void SerializeCentralDirectorySuffix( const unsigned char *start, const unsigned char *end, unsigned char *buf, int entryCount, long long directoryStartOffset, long long suffixStartOffset); static void SerializeLocalEntryHeader( const unsigned char *start, const unsigned char *end, unsigned char *buf, ZipEntry *z, int nameLength, int align); #if !defined(STATIC_BUILD) static int ZipfsAppHookFindTclInit(const char *archive); |
| ︙ | ︙ | |||
342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 | Tcl_Obj *pathPtr, Tcl_Obj *objPtr); static int ZipFSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); static int ZipMapArchive(Tcl_Interp *interp, ZipFile *zf, void *handle); static void ZipfsExitHandler(ClientData clientData); static void ZipfsSetup(void); static int ZipChannelClose(void *instanceData, Tcl_Interp *interp, int flags); static Tcl_DriverGetHandleProc ZipChannelGetFile; static int ZipChannelRead(void *instanceData, char *buf, int toRead, int *errloc); #if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9) static int ZipChannelSeek(void *instanceData, long offset, | > > | 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 | Tcl_Obj *pathPtr, Tcl_Obj *objPtr); static int ZipFSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); static int ZipMapArchive(Tcl_Interp *interp, ZipFile *zf, void *handle); static void ZipfsExitHandler(ClientData clientData); static void ZipfsMountExitHandler(ClientData clientData); static void ZipfsSetup(void); static void ZipfsFinalize(void); static int ZipChannelClose(void *instanceData, Tcl_Interp *interp, int flags); static Tcl_DriverGetHandleProc ZipChannelGetFile; static int ZipChannelRead(void *instanceData, char *buf, int toRead, int *errloc); #if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9) static int ZipChannelSeek(void *instanceData, long offset, |
| ︙ | ︙ | |||
1177 1178 1179 1180 1181 1182 1183 |
static int
ZipFSFindTOC(
Tcl_Interp *interp, /* Current interpreter. NULLable. */
int needZip,
ZipFile *zf)
{
| | | 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 |
static int
ZipFSFindTOC(
Tcl_Interp *interp, /* Current interpreter. NULLable. */
int needZip,
ZipFile *zf)
{
size_t i, minoff;
const unsigned char *p, *q;
const unsigned char *start = zf->data;
const unsigned char *end = zf->data + zf->length;
/*
* Scan backwards from the end of the file for the signature. This is
* necessary because ZIP archives aren't the only things that get tagged
|
| ︙ | ︙ | |||
1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 |
/*
* Where does the central directory start?
*/
q = zf->data + ZipReadInt(start, end, p + ZIP_CENTRAL_DIRSTART_OFFS);
p -= ZipReadInt(start, end, p + ZIP_CENTRAL_DIRSIZE_OFFS);
if ((p < q) || (p < zf->data) || (p > zf->data + zf->length)
|| (q < zf->data) || (q > zf->data + zf->length)) {
if (!needZip) {
zf->baseOffset = zf->passOffset = zf->length;
return TCL_OK;
}
ZIPFS_ERROR(interp, "archive directory not found");
ZIPFS_ERROR_CODE(interp, "NO_DIR");
goto error;
}
/*
* Read the central directory.
*/
| > > < < > > > > > > > > > > > > > | | > | 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 |
/*
* Where does the central directory start?
*/
q = zf->data + ZipReadInt(start, end, p + ZIP_CENTRAL_DIRSTART_OFFS);
p -= ZipReadInt(start, end, p + ZIP_CENTRAL_DIRSIZE_OFFS);
zf->baseOffset = zf->passOffset = (p>q) ? p - q : 0;
zf->directoryOffset = q - zf->data + zf->baseOffset;
if ((p < q) || (p < zf->data) || (p > zf->data + zf->length)
|| (q < zf->data) || (q > zf->data + zf->length)) {
if (!needZip) {
zf->baseOffset = zf->passOffset = zf->length;
return TCL_OK;
}
ZIPFS_ERROR(interp, "archive directory not found");
ZIPFS_ERROR_CODE(interp, "NO_DIR");
goto error;
}
/*
* Read the central directory.
*/
q = p;
minoff = zf->length;
for (i = 0; i < zf->numFiles; i++) {
int pathlen, comlen, extra;
size_t localhdr_off = zf->length;
if (q + ZIP_CENTRAL_HEADER_LEN > end) {
ZIPFS_ERROR(interp, "wrong header length");
ZIPFS_ERROR_CODE(interp, "HDR_LEN");
goto error;
}
if (ZipReadInt(start, end, q) != ZIP_CENTRAL_HEADER_SIG) {
ZIPFS_ERROR(interp, "wrong header signature");
ZIPFS_ERROR_CODE(interp, "HDR_SIG");
goto error;
}
pathlen = ZipReadShort(start, end, q + ZIP_CENTRAL_PATHLEN_OFFS);
comlen = ZipReadShort(start, end, q + ZIP_CENTRAL_FCOMMENTLEN_OFFS);
extra = ZipReadShort(start, end, q + ZIP_CENTRAL_EXTRALEN_OFFS);
localhdr_off = ZipReadInt(start, end, q + ZIP_CENTRAL_LOCALHDR_OFFS);
if (ZipReadInt(start, end, zf->data + zf->baseOffset + localhdr_off) != ZIP_LOCAL_HEADER_SIG) {
ZIPFS_ERROR(interp, "Failed to find local header");
ZIPFS_ERROR_CODE(interp, "LCL_HDR");
goto error;
}
if (localhdr_off < minoff) {
minoff = localhdr_off;
}
q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN;
}
zf->passOffset = minoff + zf->baseOffset;
/*
* If there's also an encoded password, extract that too (but don't decode
* yet).
*/
q = zf->data + zf->passOffset;
if ((zf->passOffset >= 6) && (start < q-4) &&
(ZipReadInt(start, end, q - 4) == ZIP_PASSWORD_END_SIG)) {
const unsigned char *passPtr;
i = q[-5];
passPtr = q - 5 - i;
if (passPtr >= start && passPtr + i < end) {
zf->passBuf[0] = i;
memcpy(zf->passBuf + 1, passPtr, i);
zf->passOffset -= i ? (5 + i) : 0;
}
}
return TCL_OK;
error:
ZipFSCloseArchive(interp, zf);
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
1536 1537 1538 1539 1540 1541 1542 |
*
*-------------------------------------------------------------------------
*/
static int
ZipFSCatalogFilesystem(
Tcl_Interp *interp, /* Current interpreter. NULLable. */
| | | | 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 |
*
*-------------------------------------------------------------------------
*/
static int
ZipFSCatalogFilesystem(
Tcl_Interp *interp, /* Current interpreter. NULLable. */
ZipFile *zf, /* Temporary buffer hold archive descriptors */
const char *mountPoint, /* Mount point path. */
const char *passwd, /* Password for opening the ZIP, or NULL if
* the ZIP is unprotected. */
const char *zipname) /* Path to ZIP file to build a catalog of. */
{
int pwlen, isNew;
size_t i;
ZipFile *zf0;
ZipEntry *z;
Tcl_HashEntry *hPtr;
Tcl_DString ds, dsm, fpBuf;
unsigned char *q;
/*
* Basic verification of the password for sanity.
|
| ︙ | ︙ | |||
1566 1567 1568 1569 1570 1571 1572 |
}
}
/*
* Validate the TOC data. If that's bad, things fall apart.
*/
| | | > > | | | < < < | < < < | | 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 |
}
}
/*
* Validate the TOC data. If that's bad, things fall apart.
*/
if (zf->baseOffset >= zf->length || zf->passOffset >= zf->length ||
zf->directoryOffset >= zf->length) {
ZIPFS_ERROR(interp, "bad zip data");
ZIPFS_ERROR_CODE(interp, "BAD_ZIP");
ZipFSCloseArchive(interp, zf);
ckfree(zf);
return TCL_ERROR;
}
WriteLock();
/*
* Mount point sometimes is a relative or otherwise denormalized path.
* But an absolute name is needed as mount point here.
*/
Tcl_DStringInit(&ds);
Tcl_DStringInit(&dsm);
if (strcmp(mountPoint, "/") == 0) {
mountPoint = "";
} else {
mountPoint = CanonicalPath("", mountPoint, &dsm, 1);
}
hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, mountPoint, &isNew);
if (!isNew) {
if (interp) {
zf0 = (ZipFile *) Tcl_GetHashValue(hPtr);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"%s is already mounted on %s", zf0->name, mountPoint));
ZIPFS_ERROR_CODE(interp, "MOUNTED");
}
Unlock();
ZipFSCloseArchive(interp, zf);
ckfree(zf);
return TCL_ERROR;
}
Unlock();
/*
* Convert to a real archive descriptor.
*/
zf->mountPoint = (char *) Tcl_GetHashKey(&ZipFS.zipHash, hPtr);
Tcl_CreateExitHandler(ZipfsMountExitHandler, zf);
zf->mountPointLen = strlen(zf->mountPoint);
zf->nameLength = strlen(zipname);
zf->name = (char *) ckalloc(zf->nameLength + 1);
memcpy(zf->name, zipname, zf->nameLength + 1);
Tcl_SetHashValue(hPtr, zf);
|
| ︙ | ︙ | |||
1850 1851 1852 1853 1854 1855 1856 |
#endif /* TCL_THREADS */
Tcl_FSRegister(NULL, &zipfsFilesystem);
Tcl_InitHashTable(&ZipFS.fileHash, TCL_STRING_KEYS);
Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS);
ZipFS.idCount = 1;
ZipFS.wrmax = DEFAULT_WRITE_MAX_SIZE;
| | | > | 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 |
#endif /* TCL_THREADS */
Tcl_FSRegister(NULL, &zipfsFilesystem);
Tcl_InitHashTable(&ZipFS.fileHash, TCL_STRING_KEYS);
Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS);
ZipFS.idCount = 1;
ZipFS.wrmax = DEFAULT_WRITE_MAX_SIZE;
ZipFS.fallbackEntryEncoding = (char *)
ckalloc(strlen(ZIPFS_FALLBACK_ENCODING) + 1);
strcpy(ZipFS.fallbackEntryEncoding, ZIPFS_FALLBACK_ENCODING);
ZipFS.utf8 = Tcl_GetEncoding(NULL, "utf-8");
ZipFS.initialized = 1;
Tcl_CreateExitHandler(ZipfsExitHandler, NULL);
}
/*
*-------------------------------------------------------------------------
*
* ListMountPoints --
*
|
| ︙ | ︙ | |||
2015 2016 2017 2018 2019 2020 2021 |
}
if (ZipFSOpenArchive(interp, zipname, 1, zf) != TCL_OK) {
ckfree(zf);
return TCL_ERROR;
}
if (ZipFSCatalogFilesystem(interp, zf, mountPoint, passwd, zipname)
!= TCL_OK) {
| < < | 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 |
}
if (ZipFSOpenArchive(interp, zipname, 1, zf) != TCL_OK) {
ckfree(zf);
return TCL_ERROR;
}
if (ZipFSCatalogFilesystem(interp, zf, mountPoint, passwd, zipname)
!= TCL_OK) {
return TCL_ERROR;
}
return TCL_OK;
}
/*
*-------------------------------------------------------------------------
*
* TclZipfs_MountBuffer --
|
| ︙ | ︙ | |||
2105 2106 2107 2108 2109 2110 2111 |
zf->ptrToFree = NULL;
}
if (ZipFSFindTOC(interp, 0, zf) != TCL_OK) {
return TCL_ERROR;
}
result = ZipFSCatalogFilesystem(interp, zf, mountPoint, NULL,
"Memory Buffer");
| < | 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 |
zf->ptrToFree = NULL;
}
if (ZipFSFindTOC(interp, 0, zf) != TCL_OK) {
return TCL_ERROR;
}
result = ZipFSCatalogFilesystem(interp, zf, mountPoint, NULL,
"Memory Buffer");
return result;
}
/*
*-------------------------------------------------------------------------
*
* TclZipfs_Unmount --
|
| ︙ | ︙ | |||
2181 2182 2183 2184 2185 2186 2187 |
}
if (z->data) {
ckfree(z->data);
}
ckfree(z);
}
ZipFSCloseArchive(interp, zf);
| | | 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 |
}
if (z->data) {
ckfree(z->data);
}
ckfree(z);
}
ZipFSCloseArchive(interp, zf);
Tcl_DeleteExitHandler(ZipfsMountExitHandler, zf);
ckfree(zf);
unmounted = 1;
done:
Unlock();
if (unmounted) {
Tcl_FSMountsChanged(NULL);
|
| ︙ | ︙ | |||
2987 2988 2989 2990 2991 2992 2993 |
* itself). */
Tcl_Obj *passwordObj) /* The password for encoding things. NULL if
* there's no password protection. */
{
Tcl_Channel out;
int pwlen = 0, slen = 0, count, ret = TCL_ERROR, lobjc;
size_t len, i = 0;
| < < | 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 |
* itself). */
Tcl_Obj *passwordObj) /* The password for encoding things. NULL if
* there's no password protection. */
{
Tcl_Channel out;
int pwlen = 0, slen = 0, count, ret = TCL_ERROR, lobjc;
size_t len, i = 0;
long long directoryStartOffset;
/* The overall file offset of the start of the
* central directory. */
long long suffixStartOffset;/* The overall file offset of the start of the
* suffix of the central directory (i.e.,
* where this data will be written). */
Tcl_Obj **lobjv, *list = mappingList;
|
| ︙ | ︙ | |||
3026 3027 3028 3029 3030 3031 3032 |
if (dirRoot != NULL) {
list = ZipFSFind(interp, dirRoot);
if (!list) {
return TCL_ERROR;
}
}
Tcl_IncrRefCount(list);
| | | 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 |
if (dirRoot != NULL) {
list = ZipFSFind(interp, dirRoot);
if (!list) {
return TCL_ERROR;
}
}
Tcl_IncrRefCount(list);
if (TclListObjGetElements(interp, list, &lobjc, &lobjv) != TCL_OK) {
Tcl_DecrRefCount(list);
return TCL_ERROR;
}
if (mappingList && (lobjc % 2)) {
Tcl_DecrRefCount(list);
ZIPFS_ERROR(interp, "need even number of elements");
ZIPFS_ERROR_CODE(interp, "LIST_LENGTH");
|
| ︙ | ︙ | |||
3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 |
break;
}
}
Unlock();
if (!isMounted) {
zf = &zf0;
}
if (isMounted || ZipFSOpenArchive(interp, imgName, 0, zf) == TCL_OK) {
/*
* Copy everything up to the ZIP-related suffix.
*/
if ((size_t) Tcl_Write(out, (char *) zf->data,
| > | 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 |
break;
}
}
Unlock();
if (!isMounted) {
zf = &zf0;
memset(&zf0, 0, sizeof(ZipFile));
}
if (isMounted || ZipFSOpenArchive(interp, imgName, 0, zf) == TCL_OK) {
/*
* Copy everything up to the ZIP-related suffix.
*/
if ((size_t) Tcl_Write(out, (char *) zf->data,
|
| ︙ | ︙ | |||
3164 3165 3166 3167 3168 3169 3170 |
}
/*
* Prepare the contents of the ZIP archive.
*/
Tcl_InitHashTable(&fileHash, TCL_STRING_KEYS);
| < | 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 |
}
/*
* Prepare the contents of the ZIP archive.
*/
Tcl_InitHashTable(&fileHash, TCL_STRING_KEYS);
if (mappingList == NULL && stripPrefix != NULL) {
strip = Tcl_GetStringFromObj(stripPrefix, &slen);
if (!slen) {
strip = NULL;
}
}
for (i = 0; i < (size_t) lobjc; i += (mappingList ? 2 : 1)) {
|
| ︙ | ︙ | |||
3205 3206 3207 3208 3209 3210 3211 | continue; } z = (ZipEntry *) Tcl_GetHashValue(hPtr); name = Tcl_UtfToExternalDString(ZipFS.utf8, z->name, -1, &ds); len = Tcl_DStringLength(&ds); SerializeCentralDirectoryEntry(start, end, (unsigned char *) buf, | | | | 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 |
continue;
}
z = (ZipEntry *) Tcl_GetHashValue(hPtr);
name = Tcl_UtfToExternalDString(ZipFS.utf8, z->name, -1, &ds);
len = Tcl_DStringLength(&ds);
SerializeCentralDirectoryEntry(start, end, (unsigned char *) buf,
z, len);
if ((Tcl_Write(out, buf, ZIP_CENTRAL_HEADER_LEN)
!= ZIP_CENTRAL_HEADER_LEN)
|| ((size_t) Tcl_Write(out, name, len) != len)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"write error: %s", Tcl_PosixError(interp)));
Tcl_DStringFree(&ds);
goto done;
}
Tcl_DStringFree(&ds);
count++;
}
/*
* Finalize the central directory.
*/
Tcl_Flush(out);
suffixStartOffset = Tcl_Tell(out);
SerializeCentralDirectorySuffix(start, end, (unsigned char *) buf,
count, directoryStartOffset, suffixStartOffset);
if (Tcl_Write(out, buf, ZIP_CENTRAL_END_LEN) != ZIP_CENTRAL_END_LEN) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"write error: %s", Tcl_PosixError(interp)));
goto done;
}
Tcl_Flush(out);
ret = TCL_OK;
|
| ︙ | ︙ | |||
3382 3383 3384 3385 3386 3387 3388 |
static void
SerializeCentralDirectoryEntry(
const unsigned char *start, /* The start of writable memory. */
const unsigned char *end, /* The end of writable memory. */
unsigned char *buf, /* Where to serialize to */
ZipEntry *z, /* The description of what to serialize. */
| | < < | 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 |
static void
SerializeCentralDirectoryEntry(
const unsigned char *start, /* The start of writable memory. */
const unsigned char *end, /* The end of writable memory. */
unsigned char *buf, /* Where to serialize to */
ZipEntry *z, /* The description of what to serialize. */
size_t nameLength) /* The length of the name. */
{
ZipWriteInt(start, end, buf + ZIP_CENTRAL_SIG_OFFS,
ZIP_CENTRAL_HEADER_SIG);
ZipWriteShort(start, end, buf + ZIP_CENTRAL_VERSIONMADE_OFFS,
ZIP_MIN_VERSION);
ZipWriteShort(start, end, buf + ZIP_CENTRAL_VERSION_OFFS, ZIP_MIN_VERSION);
ZipWriteShort(start, end, buf + ZIP_CENTRAL_FLAGS_OFFS, z->isEncrypted);
|
| ︙ | ︙ | |||
3409 3410 3411 3412 3413 3414 3415 |
ZipWriteShort(start, end, buf + ZIP_CENTRAL_PATHLEN_OFFS, nameLength);
ZipWriteShort(start, end, buf + ZIP_CENTRAL_EXTRALEN_OFFS, 0);
ZipWriteShort(start, end, buf + ZIP_CENTRAL_FCOMMENTLEN_OFFS, 0);
ZipWriteShort(start, end, buf + ZIP_CENTRAL_DISKFILE_OFFS, 0);
ZipWriteShort(start, end, buf + ZIP_CENTRAL_IATTR_OFFS, 0);
ZipWriteInt(start, end, buf + ZIP_CENTRAL_EATTR_OFFS, 0);
ZipWriteInt(start, end, buf + ZIP_CENTRAL_LOCALHDR_OFFS,
| | < < | | 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 |
ZipWriteShort(start, end, buf + ZIP_CENTRAL_PATHLEN_OFFS, nameLength);
ZipWriteShort(start, end, buf + ZIP_CENTRAL_EXTRALEN_OFFS, 0);
ZipWriteShort(start, end, buf + ZIP_CENTRAL_FCOMMENTLEN_OFFS, 0);
ZipWriteShort(start, end, buf + ZIP_CENTRAL_DISKFILE_OFFS, 0);
ZipWriteShort(start, end, buf + ZIP_CENTRAL_IATTR_OFFS, 0);
ZipWriteInt(start, end, buf + ZIP_CENTRAL_EATTR_OFFS, 0);
ZipWriteInt(start, end, buf + ZIP_CENTRAL_LOCALHDR_OFFS,
z->offset);
}
static void
SerializeCentralDirectorySuffix(
const unsigned char *start, /* The start of writable memory. */
const unsigned char *end, /* The end of writable memory. */
unsigned char *buf, /* Where to serialize to */
int entryCount, /* The number of entries in the directory */
long long directoryStartOffset,
/* The overall file offset of the start of the
* central directory. */
long long suffixStartOffset)/* The overall file offset of the start of the
* suffix of the central directory (i.e.,
* where this data will be written). */
{
ZipWriteInt(start, end, buf + ZIP_CENTRAL_END_SIG_OFFS,
ZIP_CENTRAL_END_SIG);
ZipWriteShort(start, end, buf + ZIP_CENTRAL_DISKNO_OFFS, 0);
ZipWriteShort(start, end, buf + ZIP_CENTRAL_DISKDIR_OFFS, 0);
ZipWriteShort(start, end, buf + ZIP_CENTRAL_ENTS_OFFS, entryCount);
ZipWriteShort(start, end, buf + ZIP_CENTRAL_TOTALENTS_OFFS, entryCount);
ZipWriteInt(start, end, buf + ZIP_CENTRAL_DIRSIZE_OFFS,
suffixStartOffset - directoryStartOffset);
ZipWriteInt(start, end, buf + ZIP_CENTRAL_DIRSTART_OFFS,
directoryStartOffset);
ZipWriteShort(start, end, buf + ZIP_CENTRAL_COMMENTLEN_OFFS, 0);
}
/*
*-------------------------------------------------------------------------
*
* ZipFSMkZipObjCmd, ZipFSLMkZipObjCmd --
|
| ︙ | ︙ | |||
3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 |
#else
WideCharToMultiByte(CP_UTF8, 0, wName, -1, dllName, sizeof(dllName), NULL, NULL);
#endif
if (ZipfsAppHookFindTclInit(dllName) == TCL_OK) {
return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
}
#else
if (ZipfsAppHookFindTclInit(CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_DLLFILE) == TCL_OK) {
return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
}
#endif /* _WIN32 */
#endif /* !defined(STATIC_BUILD) */
| > > > > > > | 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 |
#else
WideCharToMultiByte(CP_UTF8, 0, wName, -1, dllName, sizeof(dllName), NULL, NULL);
#endif
if (ZipfsAppHookFindTclInit(dllName) == TCL_OK) {
return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
}
#elif !defined(NO_DLFCN_H)
Dl_info dlinfo;
if (dladdr((const void *)TclZipfs_TclLibrary, &dlinfo) && (dlinfo.dli_fname != NULL)
&& (ZipfsAppHookFindTclInit(dlinfo.dli_fname) == TCL_OK)) {
return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
}
#else
if (ZipfsAppHookFindTclInit(CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_DLLFILE) == TCL_OK) {
return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
}
#endif /* _WIN32 */
#endif /* !defined(STATIC_BUILD) */
|
| ︙ | ︙ | |||
5691 5692 5693 5694 5695 5696 5697 5698 5699 5700 5701 5702 5703 5704 |
#else /* !HAVE_ZLIB */
ZIPFS_ERROR(interp, "no zlib available");
ZIPFS_ERROR_CODE(interp, "NO_ZLIB");
return TCL_ERROR;
#endif /* HAVE_ZLIB */
}
#if !defined(STATIC_BUILD)
static int
ZipfsAppHookFindTclInit(
const char *archive)
{
Tcl_Obj *vfsInitScript;
int found;
| > > | 5704 5705 5706 5707 5708 5709 5710 5711 5712 5713 5714 5715 5716 5717 5718 5719 |
#else /* !HAVE_ZLIB */
ZIPFS_ERROR(interp, "no zlib available");
ZIPFS_ERROR_CODE(interp, "NO_ZLIB");
return TCL_ERROR;
#endif /* HAVE_ZLIB */
}
#ifdef HAVE_ZLIB
#if !defined(STATIC_BUILD)
static int
ZipfsAppHookFindTclInit(
const char *archive)
{
Tcl_Obj *vfsInitScript;
int found;
|
| ︙ | ︙ | |||
5732 5733 5734 5735 5736 5737 5738 5739 5740 5741 5742 5743 5744 5745 |
return TCL_ERROR;
}
#endif
static void
ZipfsExitHandler(
ClientData clientData)
{
ZipFile *zf = (ZipFile *) clientData;
if (TCL_OK != TclZipfs_Unmount(NULL, zf->mountPoint)) {
Tcl_Panic("tried to unmount busy filesystem");
}
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > | > > > | > | 5747 5748 5749 5750 5751 5752 5753 5754 5755 5756 5757 5758 5759 5760 5761 5762 5763 5764 5765 5766 5767 5768 5769 5770 5771 5772 5773 5774 5775 5776 5777 5778 5779 5780 5781 5782 5783 5784 5785 5786 5787 5788 5789 5790 5791 5792 5793 5794 5795 5796 5797 5798 5799 5800 5801 5802 5803 5804 5805 5806 5807 5808 5809 5810 5811 5812 5813 5814 5815 5816 5817 5818 5819 5820 5821 5822 5823 5824 5825 5826 5827 5828 5829 |
return TCL_ERROR;
}
#endif
static void
ZipfsExitHandler(
TCL_UNUSED(ClientData)
)
{
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
if (ZipFS.initialized != -1) {
hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
if (hPtr == NULL) {
ZipfsFinalize();
} else {
/* ZipFS.fallbackEntryEncoding was already freed by
* ZipfsMountExitHandler
*/
}
}
}
static void
ZipfsFinalize(void) {
Tcl_DeleteHashTable(&ZipFS.fileHash);
ckfree(ZipFS.fallbackEntryEncoding);
ZipFS.initialized = -1;
}
static void
ZipfsMountExitHandler(
ClientData clientData)
{
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
ZipFile *zf = (ZipFile *) clientData;
if (TCL_OK != TclZipfs_Unmount(NULL, zf->mountPoint)) {
Tcl_Panic("tried to unmount busy filesystem");
}
hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
if (hPtr == NULL) {
ZipfsFinalize();
}
}
/*
*-------------------------------------------------------------------------
*
* TclZipfs_AppHook --
*
* Performs the argument munging for the shell
*
*-------------------------------------------------------------------------
*/
const char *
TclZipfs_AppHook(
#ifdef SUPPORT_BUILTIN_ZIP_INSTALL
int *argcPtr, /* Pointer to argc */
#else
TCL_UNUSED(int *), /*argcPtr*/
#endif
#ifdef _WIN32
TCL_UNUSED(WCHAR ***)) /* argvPtr */
#else /* !_WIN32 */
char ***argvPtr) /* Pointer to argv */
#endif /* _WIN32 */
{
const char *archive;
const char *version = Tcl_InitSubsystems();
#ifdef _WIN32
Tcl_FindExecutable(NULL);
#else
Tcl_FindExecutable((*argvPtr)[0]);
#endif
archive = Tcl_GetNameOfExecutable();
|
| ︙ | ︙ | |||
5807 5808 5809 5810 5811 5812 5813 |
TclNewLiteralStringObj(vfsInitScript,
ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
Tcl_IncrRefCount(vfsInitScript);
found = Tcl_FSAccess(vfsInitScript, F_OK);
Tcl_DecrRefCount(vfsInitScript);
if (found == TCL_OK) {
zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
| | | 5858 5859 5860 5861 5862 5863 5864 5865 5866 5867 5868 5869 5870 5871 5872 |
TclNewLiteralStringObj(vfsInitScript,
ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
Tcl_IncrRefCount(vfsInitScript);
found = Tcl_FSAccess(vfsInitScript, F_OK);
Tcl_DecrRefCount(vfsInitScript);
if (found == TCL_OK) {
zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
return version;
}
}
#ifdef SUPPORT_BUILTIN_ZIP_INSTALL
} else if (*argcPtr > 1) {
/*
* If the first argument is "install", run the supplied installer
* script.
|
| ︙ | ︙ | |||
5840 5841 5842 5843 5844 5845 5846 |
TclZipfs_TclLibrary();
TclNewLiteralStringObj(vfsInitScript,
ZIPFS_ZIP_MOUNT "/tcl_library/install.tcl");
Tcl_IncrRefCount(vfsInitScript);
if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
Tcl_SetStartupScript(vfsInitScript, NULL);
}
| | | 5891 5892 5893 5894 5895 5896 5897 5898 5899 5900 5901 5902 5903 5904 5905 |
TclZipfs_TclLibrary();
TclNewLiteralStringObj(vfsInitScript,
ZIPFS_ZIP_MOUNT "/tcl_library/install.tcl");
Tcl_IncrRefCount(vfsInitScript);
if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
Tcl_SetStartupScript(vfsInitScript, NULL);
}
return version;
} else if (!TclZipfs_Mount(NULL, ZIPFS_APP_MOUNT, archive, NULL)) {
int found;
Tcl_Obj *vfsInitScript;
TclNewLiteralStringObj(vfsInitScript, ZIPFS_APP_MOUNT "/main.tcl");
Tcl_IncrRefCount(vfsInitScript);
if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
|
| ︙ | ︙ | |||
5864 5865 5866 5867 5868 5869 5870 |
TclNewLiteralStringObj(vfsInitScript,
ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
Tcl_IncrRefCount(vfsInitScript);
found = Tcl_FSAccess(vfsInitScript, F_OK);
Tcl_DecrRefCount(vfsInitScript);
if (found == TCL_OK) {
zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
| | | | | | | | | | | | > > > > > > > > > > > > > > > > > > > | 5915 5916 5917 5918 5919 5920 5921 5922 5923 5924 5925 5926 5927 5928 5929 5930 5931 5932 5933 5934 5935 5936 5937 5938 5939 5940 5941 5942 5943 5944 5945 5946 5947 5948 5949 5950 5951 5952 5953 5954 5955 5956 5957 5958 5959 5960 5961 5962 5963 5964 5965 5966 5967 5968 5969 5970 5971 5972 5973 5974 5975 5976 5977 5978 5979 5980 5981 5982 5983 5984 5985 5986 5987 5988 5989 5990 5991 5992 5993 5994 5995 5996 5997 5998 5999 6000 6001 6002 6003 6004 6005 6006 6007 |
TclNewLiteralStringObj(vfsInitScript,
ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
Tcl_IncrRefCount(vfsInitScript);
found = Tcl_FSAccess(vfsInitScript, F_OK);
Tcl_DecrRefCount(vfsInitScript);
if (found == TCL_OK) {
zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
return version;
}
}
#ifdef _WIN32
Tcl_DStringFree(&ds);
#endif /* _WIN32 */
#endif /* SUPPORT_BUILTIN_ZIP_INSTALL */
}
return version;
}
#else /* !HAVE_ZLIB */
/*
*-------------------------------------------------------------------------
*
* TclZipfs_Mount, TclZipfs_MountBuffer, TclZipfs_Unmount --
*
* Dummy version when no ZLIB support available.
*
*-------------------------------------------------------------------------
*/
int
TclZipfs_Mount(
Tcl_Interp *interp, /* Current interpreter. */
TCL_UNUSED(const char *), /* Mount point path. */
TCL_UNUSED(const char *), /* Path to ZIP file to mount. */
TCL_UNUSED(const char *)) /* Password for opening the ZIP, or NULL if
* the ZIP is unprotected. */
{
ZIPFS_ERROR(interp, "no zlib available");
ZIPFS_ERROR_CODE(interp, "NO_ZLIB");
return TCL_ERROR;
}
int
TclZipfs_MountBuffer(
Tcl_Interp *interp, /* Current interpreter. NULLable. */
TCL_UNUSED(const char *), /* Mount point path. */
TCL_UNUSED(unsigned char *),
TCL_UNUSED(size_t),
TCL_UNUSED(int))
{
ZIPFS_ERROR(interp, "no zlib available");
ZIPFS_ERROR_CODE(interp, "NO_ZLIB");
return TCL_ERROR;
}
int
TclZipfs_Unmount(
Tcl_Interp *interp, /* Current interpreter. */
TCL_UNUSED(const char *)) /* Mount point path. */
{
ZIPFS_ERROR(interp, "no zlib available");
ZIPFS_ERROR_CODE(interp, "NO_ZLIB");
return TCL_ERROR;
}
const char *
TclZipfs_AppHook(
TCL_UNUSED(int *), /*argcPtr*/
#ifdef _WIN32
TCL_UNUSED(WCHAR ***)) /* argvPtr */
#else /* !_WIN32 */
TCL_UNUSED(char ***)) /* Pointer to argv */
#endif /* _WIN32 */
{
return NULL;
}
Tcl_Obj *
TclZipfs_TclLibrary(void)
{
return NULL;
}
#endif /* !HAVE_ZLIB */
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Changes to generic/tclZlib.c.
| ︙ | ︙ | |||
1150 1151 1152 1153 1154 1155 1156 |
Tcl_ZlibStreamSetCompressionDictionary(
Tcl_ZlibStream zshandle,
Tcl_Obj *compressionDictionaryObj)
{
ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
if (compressionDictionaryObj && (NULL == TclGetBytesFromObj(NULL,
| | | 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 |
Tcl_ZlibStreamSetCompressionDictionary(
Tcl_ZlibStream zshandle,
Tcl_Obj *compressionDictionaryObj)
{
ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
if (compressionDictionaryObj && (NULL == TclGetBytesFromObj(NULL,
compressionDictionaryObj, (int *)NULL))) {
/* Missing or invalid compression dictionary */
compressionDictionaryObj = NULL;
}
if (compressionDictionaryObj != NULL) {
if (Tcl_IsShared(compressionDictionaryObj)) {
compressionDictionaryObj =
Tcl_DuplicateObj(compressionDictionaryObj);
|
| ︙ | ︙ | |||
1366 1367 1368 1369 1370 1371 1372 |
* zlib will probably need more data to decompress.
*/
if (zshPtr->currentInput) {
Tcl_DecrRefCount(zshPtr->currentInput);
zshPtr->currentInput = NULL;
}
| | | 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 |
* zlib will probably need more data to decompress.
*/
if (zshPtr->currentInput) {
Tcl_DecrRefCount(zshPtr->currentInput);
zshPtr->currentInput = NULL;
}
TclListObjLength(NULL, zshPtr->inData, &listLen);
if (listLen > 0) {
/*
* There is more input available, get it from the list and
* give it to zlib. At this point, the data must not be shared
* since we require the bytearray representation to not vanish
* under our feet. [Bug 3081008]
*/
|
| ︙ | ︙ | |||
1415 1416 1417 1418 1419 1420 1421 |
if (e == Z_NEED_DICT && HaveDictToSet(zshPtr)) {
e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
if (e == Z_OK) {
DictWasSet(zshPtr);
e = inflate(&zshPtr->stream, zshPtr->flush);
}
};
| | | 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 |
if (e == Z_NEED_DICT && HaveDictToSet(zshPtr)) {
e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
if (e == Z_OK) {
DictWasSet(zshPtr);
e = inflate(&zshPtr->stream, zshPtr->flush);
}
};
TclListObjLength(NULL, zshPtr->inData, &listLen);
while ((zshPtr->stream.avail_out > 0)
&& (e == Z_OK || e == Z_BUF_ERROR) && (listLen > 0)) {
/*
* State: We have not satisfied the request yet and there may be
* more to inflate.
*/
|
| ︙ | ︙ | |||
1495 1496 1497 1498 1499 1500 1501 |
if (zshPtr->currentInput) {
Tcl_DecrRefCount(zshPtr->currentInput);
zshPtr->currentInput = 0;
}
inflateEnd(&zshPtr->stream);
}
} else {
| | | 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 |
if (zshPtr->currentInput) {
Tcl_DecrRefCount(zshPtr->currentInput);
zshPtr->currentInput = 0;
}
inflateEnd(&zshPtr->stream);
}
} else {
TclListObjLength(NULL, zshPtr->outData, &listLen);
if (count == -1) {
count = 0;
for (i=0; i<listLen; i++) {
Tcl_ListObjIndex(NULL, zshPtr->outData, i, &itemObj);
(void) Tcl_GetByteArrayFromObj(itemObj, &itemLen);
if (i == 0) {
count += itemLen - zshPtr->outPos;
|
| ︙ | ︙ | |||
1517 1518 1519 1520 1521 1522 1523 | * Prepare the place to store the data. */ dataPtr = Tcl_SetByteArrayLength(data, existing + count); dataPtr += existing; while ((count > dataPos) && | | | 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 |
* Prepare the place to store the data.
*/
dataPtr = Tcl_SetByteArrayLength(data, existing + count);
dataPtr += existing;
while ((count > dataPos) &&
(TclListObjLength(NULL, zshPtr->outData, &listLen) == TCL_OK)
&& (listLen > 0)) {
/*
* Get the next chunk off our list of chunks and grab the data out
* of it.
*/
Tcl_ListObjIndex(NULL, zshPtr->outData, 0, &itemObj);
|
| ︙ | ︙ | |||
4068 4069 4070 4071 4072 4073 4074 |
Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
}
return TCL_ERROR;
}
unsigned int
Tcl_ZlibCRC32(
| | | | | | | | 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 |
Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
}
return TCL_ERROR;
}
unsigned int
Tcl_ZlibCRC32(
TCL_UNUSED(unsigned int),
TCL_UNUSED(const unsigned char *),
TCL_UNUSED(int))
{
return 0;
}
unsigned int
Tcl_ZlibAdler32(
TCL_UNUSED(unsigned int),
TCL_UNUSED(const unsigned char *),
TCL_UNUSED(int))
{
return 0;
}
void
Tcl_ZlibStreamSetCompressionDictionary(
Tcl_ZlibStream zshandle,
|
| ︙ | ︙ |
Changes to library/cookiejar/cookiejar.tcl.
| ︙ | ︙ | |||
53 54 55 56 57 58 59 |
}
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
variable version 0.2.0
variable domainlist \
| | | | 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 |
}
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
variable version 0.2.0
variable domainlist \
https://publicsuffix.org/list/public_suffix_list.dat
variable domainfile \
[file join [file dirname [info script]] public_suffix_list.dat.gz]
# The list is directed to from http://publicsuffix.org/list/
variable loglevel info
variable vacuumtrigger 200
variable retainlimit 100
variable offline false
variable purgeinterval 60000
variable refreshinterval 10000000
|
| ︙ | ︙ |
Name change from library/cookiejar/effective_tld_names.txt.gz to library/cookiejar/public_suffix_list.dat.gz.
cannot compute difference between binary files
Changes to library/dde/pkgIndex.tcl.
|
| < > | > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 |
if {[info sharedlibextension] != ".dll"} return
if {[package vsatisfies [package provide Tcl] 9.0-]} {
package ifneeded dde 1.4.4 \
[list load [file join $dir tcl9dde14.dll] Dde]
} elseif {![package vsatisfies [package provide Tcl] 8.7]
&& [::tcl::pkgconfig get debug]} {
package ifneeded dde 1.4.4 \
[list load [file join $dir tcldde14g.dll] Dde]
} else {
package ifneeded dde 1.4.4 \
[list load [file join $dir tcldde14.dll] Dde]
}
|
Added library/encoding/cns11643.enc.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 | # Encoding file: cns11643, double-byte D 2134 0 93 21 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00004E284E364E3F4E854E054E04518251965338536953B64E2A4E874E4951E2 4E464E8F4EBC4EBE516651E35204529C53B95902590A5B805DDB5E7A5E7F5EF4 5F505F515F61961D4E3C4E634E624EA351854EC54ECF4ECE4ECC518451865722 572351E45205529E529D52FD5300533A5C735346535D538653B7620953CC6C15 53CE57216C3F5E005F0C623762386534653565E04F0E738D4E974EE04F144EF1 4EE74EF74EE64F1D4F024F054F2256D8518B518C519951E55213520B52A60000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 22 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000053225304530353075407531E535F536D538953BA53D0598053F653F753F9 597E53F4597F5B565724590459185932593059345DDF59755E845B825BF95C14 5FD55FD45FCF625C625E626462615E815E835F0D5F52625A5FCA5FC7623965EE 624F65E7672F6B7A6C39673F673C6C376C446C45738C75927676909390926C4B 6C4C4E214E204E224E684E894E984EF94EEF7F5182784EF84F064F034EFC4EEE 4F1690994F284F1C4F074F1A4EFA4F17514A962351724F3B51B451B351B20000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 23 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00004F6451E84F675214520F5215521852A84F33534B534F518F5350521C538B 522153BE52AE53D2541653FF538E540054305405541354155445541956E35735 57365731573258EE59054E545447593656E756E55741597A574C5986574B5752 5B865F535C1859985C3D5C78598E59A25990598F5C8059A15E085B925C285C2A 5C8D5EF55F0E5C8B5C895C925FD35FDA5C935FDB5DE0620F625D625F62676257 9F505E8D65EB65EA5F7867375FD2673267366B226BCE5FEE6C586C516C770000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 24 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006C3C5FFA6C5A5FF76C53706F7072706E6283628C707372B172B26287738F 627B627A6270793C6288808D808E6272827B65F08D718FB99096909A67454E24 4E7167554E9C4F454F4A4F394F37674B4F324F426C1A4F444F4B6C6B4F404F35 4F3151516C6F5150514E6C6D6C87519D6C9C51B551B851EC522352275226521F 522B522052B452B372C65325533B537473957397739373947392544D75397594 543A7681793D5444544C5423541A5432544B5421828F54345449545054220000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 25 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000543F5451545A542F8FC956E956F256F356EF56ED56EC56E6574896285744 573F573C575357564F85575F5743575857574F744F894F8457464F4C573D4F6A 57425754575558F158F258F0590B9EA656F1593D4F955994598C519E599C51BE 5235599F5233599B52315989599A530B658853925B8D54875BFE5BFF5BFD5C2B 54885C845C8E5C9C5465546C5C855DF55E09546F54615E0B54985E925E905F03 56F75F1E5F6357725FE75FFE5FE65FDC5FCE57805FFC5FDF5FEC5FF657620000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 26 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005FF25FF05FF95945621359BA59CF623B623C628259C159B659BC6278628B 59B1629E62A5629B629C6299628D6285629D62755C445C475CAE65F65CA05CB5 5CAF66F5675B5C9F675467525CA267586744674A67615CB66C7F6C916C9E5E14 6C6E6C7C6C9F6C755F246C566CA26C795F7D6CA15FE56CAA6CA0601970797077 707E600A7075707B7264601E72BB72BC72C772B972BE72B66011600C7398601C 6214623D62AD7593768062BE768376C076C162AE62B377F477F562A97ACC0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 27 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00007ACD7CFA809F80918097809466048286828C65FB8295660B866C66058FB5 8FBE8FC766F68FC190A990A4678E6792677690A896279626962B963396349629 4E3D679F4E9D4F934F8A677D67814F6D4F8E4FA04FA24FA14F9F4FA36C1D4F72 6CEC4F8C51566CD96CB651906CAD6CE76CB751ED51FE522F6CC3523C52345239 52B952B552BF53556C9D5376537A53936D3053C153C253D554856CCF545F5493 548954799EFE548F5469546D70915494546A548A708356FD56FB56F872D80000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 28 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000056FC56F6576557815763576772D1576E5778577F73A673A258F3594B594C 74DD74E8753F59AD753E59C4759859C259B076F176F076F577F859BF77F959C9 59B859AC7942793F79C559B759D77AFB5B607CFD5B965B9E5B945B9F5B9D80B5 5C005C1982A082C05C495C4A82985CBB5CC182A782AE82BC5CB95C9E5CB45CBA 5DF65E135E125E7782C35E9882A25E995E9D5EF8866E5EF98FD25F065F218FCD 5F255F558FD790B290B45F845F8360306007963D6036963A96434FCD5FE90000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 29 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000603D60084FC94FCB62BA62B24FDC62B762E462A74FDB4FC74FD662D562E1 62DD62A662C162C562C062DF62E062DE53976589539965A665BA54A165FF54A5 66176618660165FE54AE670C54B6676B67966782678A54BC67A354BE67A2678F 54B067F967806B266B276B686B69579D6B816BB46BD1578F57996C1C579A5795 58F4590D59536C976C6C6CDF5A006CEA59DD6CE46CD86CB26CCE6CC859F2708B 70887090708F59F570877089708D70815BA8708C5CD05CD872405CD75CCB0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 2A 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00007265726672685CC95CC772CD72D372DB5CD472CF73A773A3739E5CDF73AF 5DF95E2173AA739C5E2075427544753B75415E9B759B759E5F0779C479C379C6 6037603979C7607279CA604560537ACF7C767C747CFF7CFC6042605F7F5980A8 6058606680B0624280B362CF80A480B680A780AC630380A65367820E82C4833E 829C63006313631462FA631582AA62F082C9654365AA82A682B2662166326635 8FCC8FD98FCA8FD88FCF90B7661D90AD90B99637670F9641963E96B697510000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 2B 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000097634E574E794EB24EB04EAF4EB14FD24FD567E44FBE4FB84FB04FB14FC8 67F667EE4FC64FCC4FE54FE34FB4516A67B2519F67C651C167CC51C251C35245 524867C967CA524F67EA67CB52C552CA52C453275358537D6BE053DD53DC53DA 53D954B96D1F54D054B454CA6D0A54A354DA54A46D1954B2549E549F54B56D1D 6D4254CD6D1854CC6D03570057AC5791578E578D579257A1579057A657A8709F 579C579657A770A170B470B570A958F572495909590872705952726E72CA0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 2C 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000059DF72E859EB59EF59F059D55A0D5A0459F95A0259F859E259D959E75B6A 73B473EB5BAB73C75C1B5C2F73C6663C73CB74EC74EE5CD15CDC5CE65CE15CCD 76795CE25CDD5CE55DFB5DFA5E1E76F75EA176FA77E75EFC5EFB5F2F78127805 5F66780F780E7809605C7813604E6051794B794560236031607C605279D66060 604A60617AD162187B017C7A7C787C797C7F7C807C81631F631762EA63216304 63057FBE6531654465408014654265BE80C76629661B80C86623662C661A0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 2D 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006630663B661E6637663880C9670E80D780E667E867D6822167C767BC6852 67BF67D567FE836367FB833A67B168016805680067D782F26B2A6B6B82FB82F6 82F082EA6BE182E082FA6D236CFF6D146D056D136D066D21884E6D156CAF6CF4 6D026D458A076D268FE36D448FEE6D2470A590BD70A390D570A270BB70A070AA 90C891D470A870B670B270A79653964A70B9722E5005723C5013726D5030501B 72E772ED503372EC72E572E24FF773C473BD73CF73C973C173D0503173CE0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 2E 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000074ED74EB519374EF754975507546754A5261754D75A6525E525F525575A8 52CD530E76C776FF54E276FD77E6780A54F37804780B78075504781578085511 79D379D479D079D77A7C54F854E07A7D7A837A8257017AD47AD57AD37AD07AD2 7AFE7AFC7C777C7C7C7B57B657BF57C757D057B957C1590E594A7F8F80D35A2D 80CB80D25A0F810980E280DF80C65B6C822482F782D882DD5C565C5482F882FC 5CEE5CF182E95D0082EE5E2982D0830E82E2830B82FD517986765F6786780000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 2F 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000605A60678675867D6088884288666081898C8A0560958A0660978C9F609C 8FF18FE78FE98FEF90C290BC632C90C690C06336634390CD90C9634B90C4633C 958163419CEC50324FF9501D4FFF50044FF05003635150024FFC4FF250245008 5036502E65C35010503850394FFD50564FFB51A351A651A1681A684951C751C9 5260526452595265526752575263682B5253682F52CF684452CE52D052D152CC 68266828682E550D54F46825551354EF54F554F9550255006B6D808255180000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 30 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000054F054F66BE86BE355196BE7570557C96D6357B757CD6D0D6D616D9257BE 57BB6D6D57DB57C857C457C557D157CA57C06D676D605A215A2A6D7C5A1D6D82 5A0B6D2F6D686D8B6D7E5A226D846D165A246D7B5A145A316D905A2F5A1A5A12 70DD70CB5A2670E270D75BBC5BBB5BB75C055C065C525C5370C770DA5CFA5CEB 72425CF35CF55CE95CEF72FA5E2A5E305E2E5E2C5E2F5EAF5EA973D95EFD5F32 5F8E5F935F8F604F609973D2607E73D46074604B6073607573E874DE60560000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 31 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000060A9608B60A6755B609360AE609E60A7624575C075BF632E75BA63526330 635B771B6319631B77126331635D6337633563537722635C633F654B78227835 658B7828659A66506646664E6640782A664B6648795B66606644664D79526837 682479EC79E0681B683679EA682C681968566847683E681E7A8B681568226827 685968586855683068236B2E6B2B6B306B6C7B096B8B7C846BE96BEA6BE56D6B 7C8D7C856D736D577D117D0E6D5D6D566D8F6D5B6D1C6D9A6D9B6D997F610000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 32 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006D816D717F5D7F5B6D726D5C6D9670C470DB70CC70D070E370DF80F270D6 70EE70D580FB81008201822F727A833372F573028319835173E273EC73D573F9 73DF73E683228342834E831B73E473E174F3834D831683248320755675557558 7557755E75C38353831E75B4834B75B18348865376CB76CC772A86967716770F 869E8687773F772B770E772486857721771877DD86A7869578247836869D7958 79598843796279DA79D9887679E179E579E879DB886F79E279F08874887C0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 33 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00008A128C477ADA7ADD8CA47ADB7ADC8D788DB57B0D7B0B7B147C8E7C868FF5 7C877C837C8B90048FFC8FF690D67D2490D990DA90E37D257F627F937F997F97 90DC90E47FC47FC6800A91D591E28040803C803B80F680FF80EE810481038107 506A506180F750605053822D505D82278229831F8357505B504A506250158321 505F506983188358506450465040506E50738684869F869B868986A68692868F 86A0884F8878887A886E887B88848873555055348A0D8A0B8A19553655350000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 34 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000553055525545550C8FF990099008553990DE9151553B554091DB91DF91DE 91D691E095859660965957F4965657ED57FD96BD57F8580B5042505958075044 50665052505450715050507B507C505857E758015079506C507851A851D151CF 5268527652D45A5553A053C45A385558554C55685A5F55495A6C5A53555D5529 5A43555455535A44555A5A48553A553F552B57EA5A4C57EF5A695A4757DD57FE 5A4257DE57E65B6E57E857FF580358F768A6591F5D1A595B595D595E5D0D0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 35 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005D265A2B5D0F5A3B5D125D235A615A3A5A6E5A4B5A6B5EB45EB95A455A4E 5A685A3D5A715A3F5A6F5A7560905A735A2C5A595A545A4F5A6360CF60E45BC8 60DD5BC360B15C5B5C6160CA5D215D0A5D0960C05D2C5D08638A63825D2A5D15 639E5D105D1363975D2F5D18636F5DE35E395E355E3A5E32639C636D63AE637C 5EBB5EBA5F345F39638563816391638D6098655360D066656661665B60D760AA 666260A160A4688760EE689C60E7686E68AE60DE6956686F637E638B68A90000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 36 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000687563796386639368776373636A686B636C68AA637F687163B263BA6896 688B6366637468A4655A687B654E654D658D658E65AD6B3365C765CA6B9165C9 6B8D65E366576C2A66636667671A671967166DAC6DE9689E68B6689868736E00 689A688E68B768DB68A5686C68C168846DDB6DF46895687A68996DF068B868B9 68706DCF6B356DD06B906BBB6BED6DD76DCD6DE36DC16DC36DCE70F771176DAD 6E0470F06DB970F36DE770FC6E086E0671136E0A6DB070F66DF86E0C710E0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 37 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006DB1727B6E026E076E096E016E176DFF6E12730A730871037107710170F5 70F1710870F2710F740170FE7407740073FA731A7310730E740273F374087564 73FB75CE75D275CF751B752375617568768F756775D37739772F769077317732 76D576D776D67730773B7726784877407849771E784A784C782678477850784B 7851784F78427846796B796E796C79F279F879F179F579F379F97A907B357B3B 7A9A7A937A917AE17B247B337B217B1C7B167B177B367B1F7B2F7C937C990000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 38 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00007C9A7C9C7C947D497C967D347D377D3D7D2D7D367D4C7D457D2C7D487D41 7D477F3B7D3F7D4A7D3B7D288008801A7F9C801D7F9B8049804580447C9B7FD1 7FC7812A812E801F801E81318047811A8134811781258119811B831D83718384 8380837283A18127837983918211839F83AD823A8234832382748385839C83B7 8658865A8373865786B2838F86AE8395839983758845889C889488A3888F88A5 88A988A6888A88A0889089928991899483B08A268A328A2883AE83768A1C0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 39 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000086568A2B8A2086C28A2986C586BA86B08A218C3A86B38C5B8C588C7C86BB 8CA68CAE8CAD8D6588528D7E88958D7C8D7F8D7A8DBD889188A18DC08DBB8EAD 8EAF8ED6889788A488AC888C88938ED9898289D69012900E90258A27901390EE 8C3990AB90F78C5D9159915491F291F091E591F68DC28DB995878DC1965A8EDE 8EDD966E8ED78EE08EE19679900B98E198E6900C9EC49ED24E8090F04E81508F 50975088508990EC90E950815160915A91535E4251D391F491F151D251D60000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 3A 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000527391F9527091EB91F791E853A853A653C5559755DE966D966B559655B4 96BF55859804559B55A0509B555950945586508B50A355AF557A508E509D5068 559E509255A9570F570E581A5312581F53A4583C5818583E582655AD583A5645 5822559358FB5963596455815AA85AA35A825A885AA15A855A9855955A99558E 5A895A815A965A80581E58275A91582857F5584858255ACF581B5833583F5836 582E58395A875AA0582C5A7959615A865AAB5AAA5AA45A8D5A7E5A785BD50000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 3B 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005A7C5AA55AAC5C1E5C5F5C5E5D445D3E5A975D485D1C5AA95D5B5D4D5A8C 5A9C5D575A935D535D4F5BCD5D3B5D465BD15BCA5E465E475C305E485EC05EBD 5EBF5D4B5F115D355F3E5F3B5D555F3A5D3A5D525D3D5FA75D5960EA5D396107 6122610C5D325D3660B360D660D25E4160E360E560E95FAB60C9611160FD60E2 60CE611E61206121621E611663E263DE63E660F860FC60FE60C163F8611863FE 63C163BF63F763D1655F6560656163B063CE65D163E863EF667D666B667F0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 3C 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000063CA63E066736681666D6669646163DF671E68ED63DC63C463D863D36903 63C768FE68E5691E690263D763D9690968CA690065646901691868E268CF659D 692E68C568FF65D2691C68C3667B6B6F66716B6E666A6BBE67016BF46C2D6904 6DB66E756E1E68EA6E18690F6E4868F76E4F68E46E426E6A6E706DFE68E16907 6E6D69086E7B6E7E6E5968EF6E5769146E806E5068FD6E296E766E2A6E4C712A 68CE7135712C7137711D68F468D1713868D47134712B7133712771246B3B0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 3D 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000712D7232728372827287730673247338732A732C732B6DFC732F73287417 6E496E88741974386E45741F7414743C73F7741C74157418743974F975246E51 6E3B6E03756E756D7571758E6E6175E56E286E606E716E6B769476B36E3076D9 6E657748774977436E776E55774277DF6E66786378766E5A785F786679667971 712E713179767984797579FF7A0771287A0E7A09724B725A7288728972867285 7AE77AE27B55733073227B437B577B6C7B427B5373267B417335730C7CA70000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 3E 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00007CA07CA67CA47D74741A7D59742D7D607D577D6C7D7E7D6474207D5A7D5D 752F756F756C7D767D4D7D7575E67FD37FD675E475D78060804E8145813B7747 814881428149814081148141774C81EF81F68203786483ED785C83DA841883D2 8408787084007868785E786284178346841483D38405841F8402841683CD83E6 7AE6865D86D586E17B447B487B4C7B4E86EE884788467CA27C9E88BB7CA188BF 88B47D6388B57D56899A8A437D4F7D6D8A5A7D6B7D527D548A358A388A420000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 3F 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00008A498A5D8A4B8A3D7F667FA27FA07FA18C608C5E8C7F8C7E8C8380D48CB1 8D878152814F8D888D83814D813A8D868D8B8D828DCA8DD28204823C8DD48DC9 8EB0833B83CF83F98EF28EE48EF38EEA83E78EFD83FC8F9D902B902A83C89028 9029902C840183DD903A90309037903B83CB910A83D683F583C991FE922083DE 920B84069218922283D5921B920883D1920E9213839A83C3959583EE83C483FB 968C967B967F968183FE968286E286E686D386E386DA96EE96ED86EB96EC0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 40 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000975F976F86D7976D86D188488856885588BA88D798F088B888C088BE9AA9 88BC88B79AE04EB7890188C950CC50BC899750AA50B989DB50AB50C350CD517E 527E52798A588A4452E152E052E7538053AB53AA53A953E055EA8C8055D78CBE 8CB055C157158D84586C8D89585C58505861586A5869585658605866585F5923 596659688EEF8EF75ACE8EF95AC55AC38EE58EF55AD08EE88EF68EEB8EF18EEC 8EF45B745B765BDC5BD75BDA5BDB91045C205D6D5D6690F95D645D6E91000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 41 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005D605F425F5A5F6E9164915F6130613A612A614361196131921A613D920F 920C92006408643264389206643192276419921C6411921992176429641D957B 958D958C643C96876446644796899683643A640796C8656B96F16570656D9770 65E4669398A998EB9CE69EF9668F4E844EB6669250BF668E50AE694650CA50B4 50C850C250B050C150BA693150CB50C9693E50B8697C694352786973527C6955 55DB55CC6985694D69506947696769366964696155BF697D6B446B406B710000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 42 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006B736B9C55C855F255CD6BC155C26BFA6C316C325864584F6EB86EA8586F 6E916EBB585D6E9A5865585B6EA9586358716EB56E6C6EE85ACB6EDD6EDA6EE6 6EAC5AB05ABF5AC86ED96EE36EE96EDB5ACA716F5AB65ACD71485A90714A716B 5BD9714F715771745D635D4A5D6571457151716D5D6872517250724E5E4F7341 5E4A732E73465EC574275EC674487453743D5FAF745D74566149741E74477443 74587449612E744C7445743E61297501751E91686223757A75EE760276970000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 43 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00007698641064126409775D77647753775878827890788A6439787A787D6423 788B787864306428788D788878927881797E798364256427640B7980641B642E 64217A0F656F65927A1D66867AA17AA466907AE97AEA66997B627B6B67207B5E 695F7B79694E69627B6F7B686945696A7CAE6942695769597CB069487D906935 7D8A69337D8B7D997D9569787D877D787D977D897D986976695869417FA3694C 693B694B7FDD8057694F8163816A816C692F697B693C815D81756B43815F0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 44 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006B48817D816D6BFB6BFC8241844F84846E9B847F6EC88448842A847B8472 8464842E845C84536EC6844184C86EC184628480843E848384716EA6844A8455 84586EC36EDC6ED886FC86FD87156E8D871686FF6EBF6EB36ED0885888CF88E0 6EA371477154715289E78A6A8A80715D8A6F8A6571788A788A7D8A8871587143 8A648A7E715F8A678C638C88714D8CCD724F8CC9728C8DED7290728E733C7342 733B733A73408EB1734974448F048F9E8FA090439046904890459040904C0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 45 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000074427446910C9113911574FF916B9167925D9255923569839259922F923C 928F925C926A9262925F926B926E923B92449241959A7699959976DD7755775F 968F77529696775A7769776796F496FC776D9755788797797894788F788497EE 97F57886980B788398F37899788098F798FF98F5798298EC98F17A117A18999A 7A129AE29B3D9B5D9CE87A1B9CEB9CEF9CEE9E819F1450D050D950DC50D87B69 50E150EB7B737B7150F450E250DE7B767B637CB251F47CAF7D887D8652ED0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 46 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000052EA7D7F53327D7A53AE53B07D8355FB5603560B7D8456077D9255F87F6B 5628561E7F6C5618561156515605571758928164588C817758785884587358AD 58975895587758725896588D59108161596C82495AE782405AE4824584F15AEF 5626847684795AF05D7B84655D83844084865D8B5D8C844D5D785E5284598474 5ED05ECF85075FB35FB4843A8434847A617B8478616F6181613C614261386133 844261606169617D6186622C62288452644C84C56457647C8447843664550000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 47 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000064626471646A6456643B6481846E644F647E646486F7870C86FA86D686F5 657186F8870E66A5669A669C870D66A688D666A4698F69C569C8699269B288CC 88D0898569E369C069D669D1699F69A269D289DC89E68A7669E169D5699D8A3F 8A7769988A846B746BA18A816EF06EF38C3C8C4B6F1B6F0C6F1D6F346F286F17 8C856F446F426F046F116EFA6F4A7191718E8D93718B718D717F718C717E717C 71838DEE71888DE98DE372948DE773557353734F7354746C7465746674610000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 48 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000746B746874768F0B7460903F74747506760E91107607910F911176B99114 76B776E2916E7774777777767775923A777877719265777A715B777B78A678AE 78B8926C924F926078B178AF923679897987923192547A2992507A2A924E7A2D 7A2C92567A32959F7AEC7AF07B817B9E7B8396917B9296CE7BA37B9F7B9396F5 7B867CB87CB79772980F980D980E98AC7DC87DB699AF7DD199B07DA87DAB9AAB 7DB37DCD9CED7DCF7DA49EFD50E67F417F6F7F7150F350DB50EA50DD50E40000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 49 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000050D38023805B50EF8061805F818152805281818482135330824A824C5615 560C561284BD8495561C849284C35602849684A584B584B384A384E484D884D5 589884B784AD84DA84938736587A58875891873D872B87478739587B8745871D 58FE88FF88EA5AEE88F55AD5890088ED890388E95AF35AE289EA5ADB8A9B8A8E 8AA25AD98A9C8A948A908AA98AAC5C638A9F5D805D7D8A9D5D7A8C675D775D8A 8CD08CD68CD48D988D9A8D975D7F5E585E598E0B8E088E018EB48EB35EDC0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 4A 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00008FA18FA25ED2905A5F449061905F5FB6612C9125917B9176917C61739289 92F692B192AD929292819284617A92AE9290929E616A6161615695A295A7622B 642B644D645B645D96A0969D969F96D0647D96D1646664A6975964829764645C 644B64539819645098149815981A646B645964656477990665A098F89901669F 99BE99BC99B799B699C069C999B869CE699669B099C469BC99BF69999ADA9AE4 9AE99AE89AEA9AE569BF9B2669BD69A49B4069B969CA699A69CF69B369930000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 4B 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000069AA9EBD699E69D969976990510E69B550F769C650FC510D510151DA51D9 51DB5286528E52EE533353B16EF15647562D56546F37564B5652563156445656 5650562B6F18564D5637564F58A258B76F7358B26EEE58AA58B558B06F3C58B4 58A458A76F0E59265AFE6EFD5B046F395AFC6EFC5B065B0A5AFA5B0D5B005B0E 7187719071895D9171855D8F5D905D985DA45D9B5DA35D965DE45E5A72957293 5E5E734D5FB86157615C61A661956188747261A3618F75006164750361590000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 4C 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006178761661856187619E7611760A6198619C7781777C622F6480649B648E 648D649464C678B264A8648378AD64B9648664B464AF649178A064AA64A164A7 66B666B3798B66BC66AC799466AD6A0E79886A1C6A1A7A2B7A4A6A0B7A2F69EF 6A0C69F06A227AAC69D87B886A1269FA7B916A2A7B966A107B8C7B9B6A2969F9 69EA6A2C6A247BA469E96B526B4F6B537CBA7DA76F106F656F757DAA7DC17DC0 7DC56FD07DCE6F5C6F3D6F717DCC6F916F0B6F796F816F8F7DA66F596F740000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 4D 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00007DA171AE7F7371A371AD7FE57FDE71AB71A671A2818952F2725772557299 734B747A8215849784A4748C748484BA84CE74827493747B84AB750984B484C1 84CD84AA849A84B1778A849D779084BB78C678D378C078D278C778C284AF799F 799D799E84B67A4184A07A387A3A7A4284DB84B07A3E7AB07BAE7BB38728876B 7BBF872E871E7BCD87197BB28743872C8741873E8746872087327CC47CCD7CC2 7CC67CC37CC97CC787427DF887277DED7DE2871A873087117DDC7E027E010000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 4E 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000088F27DD688FE7DE47DFE88F67E007DFC7DFD88EB7DF57DFF899F7DEB7DE5 7F787FAE7FE78A998065806A80668068806B819481A18192819681938D968E09 85018DFF84F88DFD84F58E0385048E068E058DFE8E00851B85038533853484ED 9123911C853591228505911D911A91249121877D917A91729179877192A5885C 88E6890F891B92A089A989A589EE8AB1929A8ACC8ACE92978AB792A38AB58AE9 8AB492958AB38AC18AAF8ACA8AD09286928C92998C8E927E92878CE98CDB0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 4F 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000928B8CEB8DA496A18DA28D9D977D977A977E97838E2A8E28977B97848EB8 8EB68EB98EB78F228F2B8F278F198FA499078FB3999C9071906A99BB99BA9188 918C92BF92B892BE92DC92E59B3F9B6092D492D69CF192DA92ED92F392DB5103 92B992E292EB95AF50F695B295B3510C50FD510A96A396A552F152EF56485642 970A563597879789978C97EF982A98225640981F563D9919563E99CA99DA563A 571A58AB99DE99C899E058A39AB69AB558A59AF458FF9B6B9B699B729B630000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 50 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005AF69D0D5AF89D019D0C5B019CF85B055B0F9CFE9D029E845D9F9EAB9EAA 511D51165DA0512B511E511B5290529453145E605E5C56675EDB567B5EE1565F 5661618B6183617961B161B061A2618958C358CA58BB58C058C459015B1F5B18 5B115B1561B35B125B1C64705B225B795DA664975DB35DAB5EEA648A5F5B64A3 649F61B761CE61B961BD61CF61C06199619765B361BB61D061C4623166B764D3 64C06A006A066A1769E564DC64D164C869E464D566C369EC69E266BF66C50000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 51 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000069FE66CD66C167066A1467246A636A426A5269E66A436A3369FC6A6C6A57 6A046A4C6A6E6A0F69F66A266A0769F46A376B516A716A4A6A366BA66A536C00 6A456A706F416F266A5C6B586B576F926F8D6F896F8C6F626F4F6FBB6F5A6F96 6FBE6F6C6F826F556FB56FD36F9F6F576FB76FF571B76F0071BB6F6B71D16F67 71BA6F5371B671CC6F7F6F9571D3749B6F6A6F7B749674A2749D750A750E719A 7581762C76377636763B71A476A171AA719C779871B37796729A735873520000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 52 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000078D678EB736078DC735B79A579A998347A537A4574897A4F74867ABD7ABB 7AF17488747C7BEC7BED7507757E7CD3761E7CE1761D7E197623761A76287E27 7E26769D769E806E81AF778F778981AD78CD81AA821878CC78D178CE78D4856F 854C78C48542799A855C8570855F79A2855A854B853F878A7AB4878B87A1878E 7BBE7BAC8799885E885F892489A78AEA8AFD8AF98AE38AE57DDB7DEA8AEC7DD7 7DE17E037DFA8CF27DF68CEF7DF08DA67DDF7F767FAC8E3B8E437FED8E320000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 53 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00008F318F307FE68F2D8F3C8FA78FA5819F819E819591379195918E82169196 82539345930A824E825192FD9317931C930793319332932C9330930393058527 95C284FB95B884FA95C1850C84F4852A96AB96B784F784EB97159714851284EA 970C971784FE9793851D97D2850284FD983698319833983C982E983A84F0983D 84F998B5992299239920991C991D866299A0876399EF99E899EB877387588754 99E199E68761875A9AF89AF5876D876A9B839B949B84875D9B8B9B8F877A0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 54 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009B8C875C9B89874F9B8E8775876287679D249D0F89059D139D0A890B8917 891889199D2A9D1A89119D279D169D2189A49E859EAC9EC69EC59ED79F538AB8 5128512751DF8AD5533553B38ABE568A567D56898AC358CD58D08AD95B2B5B33 5B295B355B315B375C365DBE8CDD5DB98DA05DBB8DA161E261DB61DD61DC61DA 8E2E61D98E1B8E1664DF8E198E2664E18E1464EE8E1865B566D466D58E1A66D0 66D166CE66D78F208F236A7D6A8A90736AA7906F6A996A826A88912B91290000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 55 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006A8691326A986A9D918591866A8F91816AAA91846B5D92D06C0A92C46FD7 6FD66FE592CF92F192DF6FD96FDA6FEA92DD6FF692EF92C271E392CA71E992CE 71EB71EF71F371EA92E092DE92E792D192D3737192E174AE92C674B3957C74AC 95AB95AE75837645764E764476A376A577A677A4978A77A977AF97D097CF981E 78F078F878F198287A49981B982798B27AC27AF27AF37BFA99167BF67BFC7C18 7C087C1299D399D47CDB7CDA99D699D899CB7E2C7E4D9AB39AEC7F467FF60000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 56 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000802B807481B881C89B679B749B71859285939B75857F85AB85979B6C9CFC 85AC9CFD9CFF9CF787CE9D0087CD9CFB9D0887C187B187C79ED389409F10893F 893951178943511151DE533489AB56708B1F8B098B0C566656638C4056728C96 56778CF68CF758C88E468E4F58BF58BA58C28F3D8F4193669378935D93699374 937D936E93729373936293489353935F93685DB1937F936B5DB595C45DAE96AF 96AD96B25DAD5DAF971A971B5E685E665E6F5EE9979B979F5EE85EE55F4B0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 57 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005FBC5FBB619D61A86196984061B4984761C198B761BA61BF61B8618C64D7 99A264D064CF9A0099F3648964C399F564F364D99ABD9B009B0265A29B349B49 9B9F66CA9BA39BCD9B999B9D66BA66CC9D396A349D446A496A679D356A686A3E 9EAF6A6D512F6A5B6A519F8E6A5A569F569B569E5696569456A06A4F5B3B6A6F 6A695B3A5DC15F4D5F5D61F36A4D6A4E6A466B5564F664E564EA64E765056BC8 64F96C046C036C066AAB6AED6AB26AB06AB56ABE6AC16AC86FC46AC06ABC0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 58 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006AB16AC46ABF6FA56FAE700870036FFD7010700270136FA271FA720074B9 74BC6FB2765B7651764F76EB77B871D677B977C177C077BE790B71C77907790A 790871BC790D7906791579AF729E736973667AF5736C73657C2E736A7C1B749A 7C1A7C24749274957CE67CE37580762F7E5D7E4F7E667E5B7F477FB476327630 76BB7FFA802E779D77A181CE779B77A282197795779985CC85B278E985BB85C1 78DE78E378DB87E987EE87F087D6880E87DA8948894A894E894D89B189B00000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 59 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000089B37AB78B388B327BE78B2D7BD58B347BDA8B298C747BD47BEA8D037BDC 7BEB8DA98E587CD27CD48EBF8EC18F4A8FAC7E219089913D913C91A993A07E0E 93907E159393938B93AD93BB93B87E0D7E14939C95D895D77F7B7F7C7F7A975D 97A997DA8029806C81B181A6985481B99855984B81B0983F98B981B281B781A7 81F29938993699408556993B993999A4855385619A089A0C85469A1085419B07 85449BD285479BC29BBB9BCC9BCB854E856E9D4D9D639D4E85609D509D550000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 5A 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000855D9D5E85659E909EB29EB186649ECA9F029F279F26879356AF58E058DC 87965B39877987875B7C5BF3879087915C6B5DC4650B6508650A8789891E65DC 8930892D66E166DF6ACE6AD46AE36AD76AE2892C891F89F18AE06AD86AD56AD2 8AF58ADD701E702C70256FF37204720872158AE874C474C974C774C876A977C6 77C57918791A79208CF37A667A647A6A8DA78E338E3E8E388E408E457C357C34 8E3D8E417E6C8E3F7E6E7E718F2E81D481D6821A82628265827685DB85D60000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 5B 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000908685E79133913585F4919387FD87D58807918F880F87F89308931F8987 930F89B589F5933C8B3F8B438B4C93018D0B8E6B8E688E708E758E7792FA8EC3 92F993E993EA93CB93C593C6932993ED93D3932A93E5930C930B93DB93EB93E0 93C1931695BC95DD95BE95B995BA95B695BF95B595BD96A996D497B297B497B1 97B597F2979497F097F89856982F98329924994499279A269A1F9A189A219A17 99E49B0999E399EA9BC59BDF9AB99BE39AB49BE99BEE9AFA9AF99D669D7A0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 5C 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009B809D6E9D919D839D769D7E9D6D9B939E959EE39B7A9B959F039F049D25 9F179D2051369D1453369D1D5B429D229D105B445B465B7E5DCA5DC85DCC5EF0 9ED5658566E566E79F3D512651256AF451246AE9512952F45693568C568D703D 56847036567E7216567F7212720F72177211720B5B2D5B2574CD74D074CC74CE 74D15B2F75895B7B7A6F7C4B7C445E6C5E6A5FBE61C361B57E7F8B7161E0802F 807A807B807C64EF64E964E385FC861086026581658085EE860366D2860D0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 5D 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000086138608860F881888126A9B6AA18967896589BB8B698B626A838B6E6AA4 8B616A7F8B648B4D8C516A8C6A928E838EC66C09941F6FA99404941794089405 6FED93F3941E9402941A941B9427941C71E196B571E871F2973371F097349731 97B897BA749797FC74AB749098C374AD994D74A59A2F7510751175129AC97584 9AC89AC49B2A9B389B5076E99C0A9BFB9C049BFC9BFE77B477B177A89C029BF6 9C1B9BF99C159C109BFF9C009C0C78F978FE9D959DA579A87A5C7A5B7A560000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 5E 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009E989EC17A5A9F5A516456BB7C0558E65B495BF77BFF7BFB5DD07BF45FC2 7BF365117C096AFF6AFE6AFD7BFD6B017BF07BF1704B704D704774D376687667 7E33984877D179307932792E7E479F9D7AC97AC87E3B7C567C517E3A7F457F7F 7E857E897E8E7E84802C826A862B862F862881C586168615861D881A825A825C 858389BC8B758B7C85958D118D128F5C91BB85A493F4859E8577942D858985A1 96E497379736976797BE97BD97E29868986698C898CA98C798DC8585994F0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 5F 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000099A99A3C85909A3B9ACE87BE9B149B5387C59C2E87AC9C1F87B587BC87AE 87C99DB09DBD87CC87B79DAE9DC49E7B87B487B69E9E87B89F0587DE9F699FA1 56C7571D5B4A5DD389525F72620289AD62356527651E651F8B1E8B186B076B06 8B058B0B7054721C72207AF88B077C5D7C588B067E927F4E8B1A8C4F8C708827 8C718B818B838C948C448D6F8E4E8E4D8E539442944D9454944E8F409443907E 9138973C974097C09199919F91A1919D995A9A5193839ADD936493569C380000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 60 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000937C9C459C3A93769C359350935193609EF1938F9F93529A937993578641 5DD7934F65289377937B936170537059936772219359766F793779B57C627C5E 7CF596AE96B0863D9720882D89898B8D8B878B908D1A8E99979E979D97D5945F 97F1984194569461945B945A945C9465992B9741992A9933986E986C986D9931 99AA9A5C9A589ADE9A029C4F9C5199F79C5399F899F699FB9DFC9F3999FC513E 9ABE56D29AFD5B4F6B149B487A727A739B9E9B9B9BA68B919BA59BA491BF0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 61 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009BA2946C9BAF9D3396E697459D3697C897E4995D9D389B219D459B2C9B57 9D3E9D379C5D9C619C659E089E8A9E899E8D9EB09EC89F459EFB9EFF620566EF 6B1B6B1D722572247C6D512E8642864956978978898A8B9759708C9B8D1C5C6A 8EA25E6D5E6E61D861DF61ED61EE61F161EA9C6C61EB9C6F61E99E0E65049F08 9F1D9FA3650364FC5F606B1C66DA66DB66D87CF36AB98B9B8EA791C46ABA947A 6AB76AC79A619A639AD79C766C0B9FA5700C7067700172AB864A897D8B9D0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 62 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00008C538F65947B6FFC98CD98DD72019B309E16720371FD737674B874C096E7 9E189EA274B69F7C74C27E9E9484765C9E1C76597C7197CA7657765A76A69EA3 76EC9C7B9F97790C7913975079097910791257275C1379AC7A5F7C1C7C297C19 7C205FC87C2D7C1D7C267C287C2267657C307E5C52BD7E565B667E5865F96788 6CE66CCB7E574FBD5F8D7FB36018604880756B2970A681D07706825E85B485C6 5A105CFC5CFE85B385B585BD85C785C485BF70C985CE85C885C585B185B60000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 63 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000085D28624957985B796BA866987E787E687E287DB87EB87EA7B29812887F3 8A2E87D487DC87D39AD987D8582B584587D963FA87F487E887DD6E86894B894F 894C89468950586789495BDD656E8B238B338B308C878B4750D250DF8B3E8B31 8B258B3769BA8B366B9D8B2480598B3D8B3A8C428C758C998C988C978CFE8D04 8D028D008E5C6F8A8E608E577BC37BC28E658E678E5B8E5A90F68E5D98238E54 8F468F478F488F4B71CD7499913B913E91A891A591A7984291AA93B5938C0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 64 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000093927F84939B939D938993A7938E8D0E939E9861939593888B73939F9C27 938D945877D69B2D93A493A893B493A395D295D395D196B396D796DA5DC296DF 96D896DD97239722972597AC97AE97A84F664F684FE7503F97A550A6510F523E 53245365539B517F54CB55735571556B55F456225620569256BA569156B05759 578A580F581258135847589B5900594D5AD15AD35B675C575C775CD55D755D8E 5DA55DB65DBF5E655ECD5EED5F945F9A5FBA6125615062A36360636463B60000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 65 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000640364B6651A7A255C2166E2670267A467AC68106806685E685A692C6929 6A2D6A776A7A6ACA6AE66AF56B0D6B0E6BDC6BDD6BF66C1E6C636DA56E0F6E8A 6E846E8B6E7C6F4C6F486F496F9D6F996FF8702E702D705C79CC70BF70EA70E5 71117112713F7139713B713D71777175717671717196719371B471DD71DE720E 591172187347734873EF7412743B74A4748D74B47673767776BC7819781B783D 78537854785878B778D878EE7922794D7986799979A379BC7AA77B377B590000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 66 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00007BD07C2F7C327C427C4E7C687CA97CED7DD07E077DD37E647F40791E8041 806380BB6711672582488310836283128421841E84E284DE84E1857385D485F5 863786458672874A87A987A587F5883488508887895489848B038C528CD88D0C 8D188DB08EBC8ED58FAA909C85E8915C922B9221927392F492F5933F93429386 93BE93BC93BD93F193F293EF94229423942494679466959795CE95E7973B974D 98E499429B1D9B9889629D4964495E715E8561D3990E8002781E898889B70000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 67 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005528557255BA55F055EE56B856B956C4805392B08B558B518B428B528B57 8C438C778C768C9A8D068D078D098DAC8DAA8DAD8DAB8E6D8E788E738E6A8E6F 8E7B8EC28F528F518F4F8F508F538FB49140913F91B091AD93DE93C793CF93C2 93DA93D093F993EC93CC93D993A993E693CA93D493EE93E393D593C493CE93C0 93D293A593E7957D95DA95DB96E19729972B972C9728972697B397B797B697DD 97DE97DF985C9859985D985798BF98BD98BB98BE99489947994399A699A70000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 68 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009A1A9A159A259A1D9A249A1B9A229A209A279A239A1E9A1C9A149AC29B0B 9B0A9B0E9B0C9B379BEA9BEB9BE09BDE9BE49BE69BE29BF09BD49BD79BEC9BDC 9BD99BE59BD59BE19BDA9D779D819D8A9D849D889D719D809D789D869D8B9D8C 9D7D9D6B9D749D759D709D699D859D739D7B9D829D6F9D799D7F9D879D689E94 9E919EC09EFC9F2D9F409F419F4D9F569F579F58533756B256B556B358E35B45 5DC65DC75EEE5EEF5FC05FC161F9651765166515651365DF66E866E366E40000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 69 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006AF36AF06AEA6AE86AF96AF16AEE6AEF703C7035702F7037703470317042 7038703F703A7039702A7040703B703370417213721472A8737D737C74BA76AB 76AA76BE76ED77CC77CE77CF77CD77F279257923792779287924792979B27A6E 7A6C7A6D7AF77C497C487C4A7C477C457CEE7E7B7E7E7E817E807FBA7FFF8079 81DB81D982688269862285FF860185FE861B860085F6860486098605860C85FD 8819881088118817881388168963896689B989F78B608B6A8B5D8B688B630000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 6A 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00008B658B678B6D8DAE8E868E888E848F598F568F578F558F588F5A908D9143 914191B791B591B291B3940B941393FB9420940F941493FE9415941094289419 940D93F5940093F79407940E9416941293FA940993F8943C940A93FF93FC940C 93F69411940695DE95E095DF972E972F97B997BB97FD97FE986098629863985F 98C198C29950994E9959994C994B99539A329A349A319A2C9A2A9A369A299A2E 9A389A2D9AC79ACA9AC69B109B129B119C0B9C089BF79C059C129BF89C400000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 6B 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009C079C0E9C069C179C149C099D9F9D999DA49D9D9D929D989D909D9B9DA0 9D949D9C9DAA9D979DA19D9A9DA29DA89D9E9DA39DBF9DA99D969DA69DA79E99 9E9B9E9A9EE59EE49EE79EE69F309F2E9F5B9F609F5E9F5D9F599F91513A5139 5298529756C356BD56BE5B485B475DCB5DCF5EF161FD651B6B026AFC6B036AF8 6B0070437044704A7048704970457046721D721A7219737E7517766A77D0792D 7931792F7C547C537CF27E8A7E877E887E8B7E867E8D7F4D7FBB803081DD0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 6C 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00008618862A8626861F8623861C86198627862E862186208629861E86258829 881D881B88208824881C882B884A896D8969896E896B89FA8B798B788B458B7A 8B7B8D108D148DAF8E8E8E8C8F5E8F5B8F5D91469144914591B9943F943B9436 9429943D94309439942A9437942C9440943195E595E495E39735973A97BF97E1 986498C998C698C0995899569A399A3D9A469A449A429A419A3A9A3F9ACD9B15 9B179B189B169B3A9B529C2B9C1D9C1C9C2C9C239C289C299C249C219DB70000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 6D 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009DB69DBC9DC19DC79DCA9DCF9DBE9DC59DC39DBB9DB59DCE9DB99DBA9DAC 9DC89DB19DAD9DCC9DB39DCD9DB29E7A9E9C9EEB9EEE9EED9F1B9F189F1A9F31 9F4E9F659F649F924EB956C656C556CB59715B4B5B4C5DD55DD15EF265216520 652665226B0B6B086B096C0D7055705670577052721E721F72A9737F74D874D5 74D974D7766D76AD793579B47A707A717C577C5C7C597C5B7C5A7CF47CF17E91 7F4F7F8781DE826B863486358633862C86328636882C88288826882A88250000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 6E 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000897189BF89BE89FB8B7E8B848B828B868B858B7F8D158E958E948E9A8E92 8E908E968E978F608F629147944C9450944A944B944F94479445944894499446 973F97E3986A986998CB9954995B9A4E9A539A549A4C9A4F9A489A4A9A499A52 9A509AD09B199B2B9B3B9B569B559C469C489C3F9C449C399C339C419C3C9C37 9C349C329C3D9C369DDB9DD29DDE9DDA9DCB9DD09DDC9DD19DDF9DE99DD99DD8 9DD69DF59DD59DDD9EB69EF09F359F339F329F429F6B9F959FA2513D52990000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 6F 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000058E858E759725B4D5DD8882F5F4F62016203620465296525659666EB6B11 6B126B0F6BCA705B705A7222738273817383767077D47C677C667E95826C863A 86408639863C8631863B863E88308832882E883389768974897389FE8B8C8B8E 8B8B8B888C458D198E988F648F6391BC94629455945D9457945E97C497C59800 9A569A599B1E9B1F9B209C529C589C509C4A9C4D9C4B9C559C599C4C9C4E9DFB 9DF79DEF9DE39DEB9DF89DE49DF69DE19DEE9DE69DF29DF09DE29DEC9DF40000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 70 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009DF39DE89DED9EC29ED09EF29EF39F069F1C9F389F379F369F439F4F9F71 9F709F6E9F6F56D356CD5B4E5C6D652D66ED66EE6B13705F7061705D70607223 74DB74E577D5793879B779B67C6A7E977F89826D8643883888378835884B8B94 8B958E9E8E9F8EA08E9D91BE91BD91C2946B9468946996E597469743974797C7 97E59A5E9AD59B599C639C679C669C629C5E9C609E029DFE9E079E039E069E05 9E009E019E099DFF9DFD9E049EA09F1E9F469F749F759F7656D4652E65B80000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 71 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006B186B196B176B1A7062722672AA77D877D979397C697C6B7CF67E9A7E98 7E9B7E9981E081E18646864786488979897A897C897B89FF8B988B998EA58EA4 8EA3946E946D946F9471947397499872995F9C689C6E9C6D9E0B9E0D9E109E0F 9E129E119EA19EF59F099F479F789F7B9F7A9F79571E70667C6F883C8DB28EA6 91C394749478947694759A609B2E9C749C739C719C759E149E139EF69F0A9FA4 706870657CF7866A883E883D883F8B9E8C9C8EA98EC9974B9873987498CC0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 72 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000996199AB9A649A669A679B249E159E179F4862076B1E7227864C8EA89482 948094819A699A689E19864B8B9F94839C799EB776759A6B9C7A9E1D7069706A 72299EA49F7E9F499F988AF68AFC8C6B8C6D8C938CF48E448E318E348E428E39 8E358F3B8F2F8F388F338FA88FA69075907490789072907C907A913491929320 933692F89333932F932292FC932B9304931A9310932693219315932E931995BB 96A796A896AA96D5970E97119716970D9713970F975B975C9766979898300000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 73 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009838983B9837982D9839982499109928991E991B9921991A99ED99E299F1 9AB89ABC9AFB9AED9B289B919D159D239D269D289D129D1B9ED89ED49F8D9F9C 512A511F5121513252F5568E5680569056855687568F58D558D358D158CE5B30 5B2A5B245B7A5C375C685DBC5DBA5DBD5DB85E6B5F4C5FBD61C961C261C761E6 61CB6232623464CE64CA64D864E064F064E664EC64F164E264ED6582658366D9 66D66A806A946A846AA26A9C6ADB6AA36A7E6A976A906AA06B5C6BAE6BDA0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 74 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006C086FD86FF16FDF6FE06FDB6FE46FEB6FEF6F806FEC6FE16FE96FD56FEE 6FF071E771DF71EE71E671E571ED71EC71F471E0723572467370737274A974B0 74A674A876467642764C76EA77B377AA77B077AC77A777AD77EF78F778FA78F4 78EF790179A779AA7A577ABF7C077C0D7BFE7BF77C0C7BE07CE07CDC7CDE7CE2 7CDF7CD97CDD7E2E7E3E7E467E377E327E437E2B7E3D7E317E457E417E347E39 7E487E357E3F7E2F7F447FF37FFC807180728070806F807381C681C381BA0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 75 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000081C281C081BF81BD81C981BE81E88209827185AA8584857E859C85918594 85AF859B858785A8858A85A6866787C087D187B387D287C687AB87BB87BA87C8 87CB893B893689448938893D89AC8B0E8B178B198B1B8B0A8B208B1D8B048B10 8C418C3F8C738CFA8CFD8CFC8CF88CFB8DA88E498E4B8E488E4A8F448F3E8F42 8F458F3F907F907D9084908190829080913991A3919E919C934D938293289375 934A9365934B9318937E936C935B9370935A935495CA95CB95CC95C895C60000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 76 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000096B196B896D6971C971E97A097D3984698B699359A0199FF9BAE9BAB9BAA 9BAD9D3B9D3F9E8B9ECF9EDE9EDC9EDD9EDB9F3E9F4B53E2569556AE58D958D8 5B385F5E61E3623364F464F264FE650664FA64FB64F765B766DC67266AB36AAC 6AC36ABB6AB86AC26AAE6AAF6B5F6B786BAF7009700B6FFE70066FFA7011700F 71FB71FC71FE71F87377737574A774BF751576567658765277BD77BF77BB77BC 790E79AE7A617A627A607AC47AC57C2B7C277C2A7C1E7C237C217CE77E540000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 77 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00007E557E5E7E5A7E617E527E597F487FF97FFB8077807681CD81CF820A85CF 85A985CD85D085C985B085BA85B987EF87EC87F287E0898689B289F48B288B39 8B2C8B2B8C508D058E598E638E668E648E5F8E558EC08F498F4D908790839088 91AB91AC91D09394938A939693A293B393AE93AC93B09398939A939795D495D6 95D095D596E296DC96D996DB96DE972497A397A697AD97F9984D984F984C984E 985398BA993E993F993D992E99A59A0E9AC19B039B069B4F9B4E9B4D9BCA0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 78 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009BC99BFD9BC89BC09D519D5D9D609EE09F159F2C513356A556A858DE58DF 58E25BF59F905EEC61F261F761F661F56500650F66E066DD6AE56ADD6ADA6AD3 701B701F7028701A701D701570187206720D725872A27378737A74BD74CA74E3 75877586765F766177C7791979B17A6B7A697C3E7C3F7C387C3D7C377C407E6B 7E6D7E797E697E6A7E737F857FB67FB97FB881D885E985DD85EA85D585E485E5 85F787FB8805880D87F987FE8960895F8956895E8B418B5C8B588B498B5A0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 79 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00008B4E8B4F8B468B598D088D0A8E7C8E728E878E768E6C8E7A8E748F548F4E 8FAD908A908B91B191AE93E193D193DF93C393C893DC93DD93D693E293CD93D8 93E493D793E895DC96B496E3972A9727976197DC97FB985E9858985B98BC9945 99499A169A199B0D9BE89BE79BD69BDB9D899D619D729D6A9D6C9E929E979E93 9EB452F856B756B656B456BC58E45B405B435B7D5BF65DC961F861FA65186514 651966E667276AEC703E703070327210737B74CF766276657926792A792C0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 7A 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000792B7AC77AF67C4C7C437C4D7CEF7CF08FAE7E7D7E7C7E827F4C800081DA 826685FB85F9861185FA8606860B8607860A88148815896489BA89F88B708B6C 8B668B6F8B5F8B6B8D0F8D0D8E898E818E858E8291B491CB9418940393FD95E1 973098C49952995199A89A2B9A309A379A359C139C0D9E799EB59EE89F2F9F5F 9F639F615137513856C156C056C259145C6C5DCD61FC61FE651D651C659566E9 6AFB6B046AFA6BB2704C721B72A774D674D4766977D37C507E8F7E8C7FBC0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 7B 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00008617862D861A882388228821881F896A896C89BD8B748B778B7D8D138E8A 8E8D8E8B8F5F8FAF91BA942E94339435943A94389432942B95E2973897399732 97FF9867986599579A459A439A409A3E9ACF9B549B519C2D9C259DAF9DB49DC2 9DB89E9D9EEF9F199F5C9F669F67513C513B56C856CA56C95B7F5DD45DD25F4E 61FF65246B0A6B6170517058738074E4758A766E766C79B37C607C5F807E807D 81DF8972896F89FC8B808D168D178E918E938F619148944494519452973D0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 7C 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000973E97C397C1986B99559A559A4D9AD29B1A9C499C319C3E9C3B9DD39DD7 9F349F6C9F6A9F9456CC5DD662006523652B652A66EC6B1074DA7ACA7C647C63 7C657E937E967E9481E28638863F88318B8A9090908F9463946094649768986F 995C9A5A9A5B9A579AD39AD49AD19C549C579C569DE59E9F9EF456D158E9652C 705E7671767277D77F507F888836883988628B938B928B9682778D1B91C0946A 97429748974497C698709A5F9B229B589C5F9DF99DFA9E7C9E7D9F079F770000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 7D 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009F725EF36B1670637C6C7C6E883B89C08EA191C1947294709871995E9AD6 9B239ECC706477DA8B9A947797C99A629A657E9C8B9C8EAA91C5947D947E947C 9C779C789EF78C54947F9E1A72289A6A9B319E1B9E1E7C720000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 |
Added library/encoding/iso8859-11.enc.
> > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | # Encoding file: iso8859-11, single-byte S 003F 0 1 00 0000000100020003000400050006000700080009000A000B000C000D000E000F 0010001100120013001400150016001700180019001A001B001C001D001E001F 0020002100220023002400250026002700280029002A002B002C002D002E002F 0030003100320033003400350036003700380039003A003B003C003D003E003F 0040004100420043004400450046004700480049004A004B004C004D004E004F 0050005100520053005400550056005700580059005A005B005C005D005E005F 0060006100620063006400650066006700680069006A006B006C006D006E006F 0070007100720073007400750076007700780079007A007B007C007D007E007F 0080008100820083008400850086008700880089008A008B008C008D008E008F 0090009100920093009400950096009700980099009A009B009C009D009E009F 00A00E010E020E030E040E050E060E070E080E090E0A0E0B0E0C0E0D0E0E0E0F 0E100E110E120E130E140E150E160E170E180E190E1A0E1B0E1C0E1D0E1E0E1F 0E200E210E220E230E240E250E260E270E280E290E2A0E2B0E2C0E2D0E2E0E2F 0E300E310E320E330E340E350E360E370E380E390E3A00000000000000000E3F 0E400E410E420E430E440E450E460E470E480E490E4A0E4B0E4C0E4D0E4E0E4F 0E500E510E520E530E540E550E560E570E580E590E5A0E5B0000000000000000 |
Changes to library/encoding/iso8859-7.enc.
| ︙ | ︙ | |||
8 9 10 11 12 13 14 | 0030003100320033003400350036003700380039003A003B003C003D003E003F 0040004100420043004400450046004700480049004A004B004C004D004E004F 0050005100520053005400550056005700580059005A005B005C005D005E005F 0060006100620063006400650066006700680069006A006B006C006D006E006F 0070007100720073007400750076007700780079007A007B007C007D007E007F 0080008100820083008400850086008700880089008A008B008C008D008E008F 0090009100920093009400950096009700980099009A009B009C009D009E009F | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 | 0030003100320033003400350036003700380039003A003B003C003D003E003F 0040004100420043004400450046004700480049004A004B004C004D004E004F 0050005100520053005400550056005700580059005A005B005C005D005E005F 0060006100620063006400650066006700680069006A006B006C006D006E006F 0070007100720073007400750076007700780079007A007B007C007D007E007F 0080008100820083008400850086008700880089008A008B008C008D008E008F 0090009100920093009400950096009700980099009A009B009C009D009E009F 00A02018201900A320AC20AF00A600A700A800A9037A00AB00AC00AD00002015 00B000B100B200B303840385038600B703880389038A00BB038C00BD038E038F 0390039103920393039403950396039703980399039A039B039C039D039E039F 03A003A1000003A303A403A503A603A703A803A903AA03AB03AC03AD03AE03AF 03B003B103B203B303B403B503B603B703B803B903BA03BB03BC03BD03BE03BF 03C003C103C203C303C403C503C603C703C803C903CA03CB03CC03CD03CE0000 |
Changes to library/http/http.tcl.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # http.tcl -- # # Client-side HTTP for GET, POST, and HEAD commands. These routines can # be used in untrusted code that uses the Safesock security policy. # These procedures use a callback interface to avoid using vwait, which # is not defined in the safe base. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. package require Tcl 8.6- # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 |
# http.tcl --
#
# Client-side HTTP for GET, POST, and HEAD commands. These routines can
# be used in untrusted code that uses the Safesock security policy.
# These procedures use a callback interface to avoid using vwait, which
# is not defined in the safe base.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
package require Tcl 8.6-
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
package provide http 2.10a1
namespace eval http {
# Allow resourcing to not clobber existing data
variable http
if {![info exists http]} {
array set http {
|
| ︙ | ︙ |
Changes to library/http/pkgIndex.tcl.
1 |
if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
| | | 1 2 |
if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
package ifneeded http 2.10a1 [list tclPkgSetup $dir http 2.10a1 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
|
Changes to library/init.tcl.
| ︙ | ︙ | |||
15 16 17 18 19 20 21 |
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# 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]"
}
| | | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 |
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# 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 8.7a6
# Compute the auto path to use in this interpreter.
# The values on the path come from several locations:
#
# The environment variable TCLLIBPATH
#
# tcl_library, which is the directory containing this init.tcl script.
|
| ︙ | ︙ | |||
210 211 212 213 214 215 216 | # Compute stack trace contribution from the [uplevel]. # Note the dependence on how Tcl_AddErrorInfo, etc. # construct the stack trace. # set errInfo [dict get $opts -errorinfo] set errCode [dict get $opts -errorcode] set cinfo $args | | | | 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 |
# Compute stack trace contribution from the [uplevel].
# Note the dependence on how Tcl_AddErrorInfo, etc.
# construct the stack trace.
#
set errInfo [dict get $opts -errorinfo]
set errCode [dict get $opts -errorcode]
set cinfo $args
if {[string length [encoding convertto utf-8 $cinfo]] > 150} {
set cinfo [string range $cinfo 0 150]
while {[string length [encoding convertto utf-8 $cinfo]] > 150} {
set cinfo [string range $cinfo 0 end-1]
}
append cinfo ...
}
set tail "\n (\"uplevel\" body line 1)\n invoked\
from within\n\"uplevel 1 \$args\""
set expect "$msg\n while executing\n\"$cinfo\"$tail"
|
| ︙ | ︙ | |||
587 588 589 590 591 592 593 |
global auto_execs env tcl_platform
if {[info exists auto_execs($name)]} {
return $auto_execs($name)
}
set auto_execs($name) ""
| | | 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 |
global auto_execs env tcl_platform
if {[info exists auto_execs($name)]} {
return $auto_execs($name)
}
set auto_execs($name) ""
set shellBuiltins [list assoc cls copy date del dir echo erase exit ftype \
md mkdir mklink move rd ren rename rmdir start time type ver vol]
if {[info exists env(PATHEXT)]} {
# Add an initial ; to have the {} extension check first.
set execExtensions [split ";$env(PATHEXT)" ";"]
} else {
set execExtensions [list {} .com .exe .bat .cmd]
}
|
| ︙ | ︙ |
Changes to library/manifest.txt.
1 2 3 4 5 6 7 |
###
# Package manifest for all Tcl packages included in the /library file system
###
apply {{dir} {
set ::test [info script]
set isafe [interp issafe]
foreach {safe package version file} {
| | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 |
###
# Package manifest for all Tcl packages included in the /library file system
###
apply {{dir} {
set ::test [info script]
set isafe [interp issafe]
foreach {safe package version file} {
0 http 2.10a1 {http http.tcl}
1 msgcat 1.7.1 {msgcat msgcat.tcl}
1 opt 0.4.8 {opt optparse.tcl}
0 cookiejar 0.2.0 {cookiejar cookiejar.tcl}
0 tcl::idna 1.0.1 {cookiejar idna.tcl}
0 platform 1.0.18 {platform platform.tcl}
0 platform::shell 1.1.4 {platform shell.tcl}
1 tcltest 2.5.4 {tcltest tcltest.tcl}
} {
if {$isafe && !$safe} continue
package ifneeded $package $version [list source [file join $dir {*}$file]]
}
}} $dir
|
Changes to library/platform/pkgIndex.tcl.
|
| | | 1 2 3 | package ifneeded platform 1.0.18 [list source [file join $dir platform.tcl]] package ifneeded platform::shell 1.1.4 [list source [file join $dir shell.tcl]] |
Changes to library/platform/platform.tcl.
| ︙ | ︙ | |||
360 361 362 363 364 365 366 367 368 369 370 371 372 373 |
default { set alt {} }
}
if {$v ne ""} {
foreach {major minor} [split $v .] break
set res {}
if {$major eq 11} {
# Add 11.0 to 11.minor to patterns.
for {set j $minor} {$j >= 0} {incr j -1} {
lappend res macosx${major}.${j}-${cpu}
foreach a $alt {
lappend res macosx${major}.${j}-$a
}
| > > > > > > > > > > > | 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 |
default { set alt {} }
}
if {$v ne ""} {
foreach {major minor} [split $v .] break
set res {}
if {$major eq 12} {
# Add 12.0 to 12.minor to patterns.
for {set j $minor} {$j >= 0} {incr j -1} {
lappend res macosx${major}.${j}-${cpu}
foreach a $alt {
lappend res macosx${major}.${j}-$a
}
}
set major 11
set minor 5
}
if {$major eq 11} {
# Add 11.0 to 11.minor to patterns.
for {set j $minor} {$j >= 0} {incr j -1} {
lappend res macosx${major}.${j}-${cpu}
foreach a $alt {
lappend res macosx${major}.${j}-$a
}
|
| ︙ | ︙ | |||
405 406 407 408 409 410 411 |
return $res
}
# ### ### ### ######### ######### #########
## Ready
| | | 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 |
return $res
}
# ### ### ### ######### ######### #########
## Ready
package provide platform 1.0.18
# ### ### ### ######### ######### #########
## Demo application
if {[info exists argv0] && ($argv0 eq [info script])} {
puts ====================================
parray tcl_platform
|
| ︙ | ︙ |
Changes to library/registry/pkgIndex.tcl.
1 2 |
if {![package vsatisfies [package provide Tcl] 8.5-]} return
if {[info sharedlibextension] != ".dll"} return
| > | > > > | > | 1 2 3 4 5 6 7 8 9 |
if {![package vsatisfies [package provide Tcl] 8.5-]} return
if {[info sharedlibextension] != ".dll"} return
if {[package vsatisfies [package provide Tcl] 9.0-]} {
package ifneeded registry 1.3.6 \
[list load [file join $dir tcl9registry13.dll] Registry]
} else {
package ifneeded registry 1.3.6 \
[list load [file join $dir tclregistry13.dll] Registry]
}
|
Changes to library/safe.tcl.
| ︙ | ︙ | |||
127 128 129 130 131 132 133 | CheckInterp $child namespace upvar ::safe [VarName $child] state return [join [list \ [list -accessPath $state(access_path)] \ [list -statics $state(staticsok)] \ [list -nested $state(nestedok)] \ | | | 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 |
CheckInterp $child
namespace upvar ::safe [VarName $child] state
return [join [list \
[list -accessPath $state(access_path)] \
[list -statics $state(staticsok)] \
[list -nested $state(nestedok)] \
[list -deleteHook $state(cleanupHook)]]]
}
2 {
# If we have exactly 2 arguments the semantic is a "configure
# get"
lassign $args child arg
# get the flag sub program (we 'know' about Opt's internal
|
| ︙ | ︙ |
Changes to library/tcltest/tcltest.tcl.
1 2 3 4 5 6 7 8 9 10 11 12 | # 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 |
# tcltest.tcl --
#
# This file contains support code for the Tcl test suite. It
# defines the tcltest namespace and finds and defines the output
# directory, constraints available, output and error channels,
# etc. used by Tcl tests. See the tcltest man page for more
# details.
#
# This design was based on the Tcl testing approach designed and
# initially implemented by Mary Ann May-Pumphrey of Sun
# Microsystems.
#
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
# Copyright © 2000 Ajuba Solutions
# Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
# All rights reserved.
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,
|
| ︙ | ︙ |
Changes to library/tzdata/Africa/Accra.
1 | # created by tools/tclZIC.tcl - do not edit | > > | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Abidjan)]} {
LoadTimeZoneFile Africa/Abidjan
}
set TZData(:Africa/Accra) $TZData(:Africa/Abidjan)
|
Changes to library/tzdata/America/Anguilla.
1 | # created by tools/tclZIC.tcl - do not edit | | | | | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Puerto_Rico)]} {
LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Anguilla) $TZData(:America/Puerto_Rico)
|
Changes to library/tzdata/America/Antigua.
1 | # created by tools/tclZIC.tcl - do not edit | | | | | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Puerto_Rico)]} {
LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Antigua) $TZData(:America/Puerto_Rico)
|
Changes to library/tzdata/America/Aruba.
1 | # created by tools/tclZIC.tcl - do not edit | | | | | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Puerto_Rico)]} {
LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Aruba) $TZData(:America/Puerto_Rico)
|
Changes to library/tzdata/America/Atikokan.
1 | # created by tools/tclZIC.tcl - do not edit | > > | | < < < < < < < < < | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Panama)]} {
LoadTimeZoneFile America/Panama
}
set TZData(:America/Atikokan) $TZData(:America/Panama)
|
Changes to library/tzdata/America/Barbados.
1 2 3 4 |
# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Barbados) {
{-9223372036854775808 -14309 0 LMT}
| | > | > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 |
# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Barbados) {
{-9223372036854775808 -14309 0 LMT}
{-1841256091 -14400 0 AST}
{-874263600 -10800 1 ADT}
{-862682400 -14400 0 AST}
{-841604400 -10800 1 ADT}
{-830714400 -14400 0 AST}
{-820526400 -14400 0 -0330}
{-811882800 -12600 1 AST}
{-798660000 -14400 0 -0330}
{-788904000 -14400 0 AST}
{234943200 -10800 1 ADT}
{244616400 -14400 0 AST}
{261554400 -10800 1 ADT}
{276066000 -14400 0 AST}
{293004000 -10800 1 ADT}
{307515600 -14400 0 AST}
{325058400 -10800 1 ADT}
|
| ︙ | ︙ |
Changes to library/tzdata/America/Blanc-Sablon.
1 | # created by tools/tclZIC.tcl - do not edit | > > | | < < < < < < < < < | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Puerto_Rico)]} {
LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Blanc-Sablon) $TZData(:America/Puerto_Rico)
|
Changes to library/tzdata/America/Coral_Harbour.
1 | # created by tools/tclZIC.tcl - do not edit | | | | | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Panama)]} {
LoadTimeZoneFile America/Panama
}
set TZData(:America/Coral_Harbour) $TZData(:America/Panama)
|
Changes to library/tzdata/America/Creston.
1 | # created by tools/tclZIC.tcl - do not edit | > > | | < < < < < | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Phoenix)]} {
LoadTimeZoneFile America/Phoenix
}
set TZData(:America/Creston) $TZData(:America/Phoenix)
|
Changes to library/tzdata/America/Curacao.
1 | # created by tools/tclZIC.tcl - do not edit | > > | | < < < < | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Puerto_Rico)]} {
LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Curacao) $TZData(:America/Puerto_Rico)
|
Changes to library/tzdata/America/Dominica.
1 | # created by tools/tclZIC.tcl - do not edit | | | | | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Puerto_Rico)]} {
LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Dominica) $TZData(:America/Puerto_Rico)
|
Changes to library/tzdata/America/Grenada.
1 | # created by tools/tclZIC.tcl - do not edit | | | | | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Puerto_Rico)]} {
LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Grenada) $TZData(:America/Puerto_Rico)
|
Changes to library/tzdata/America/Guadeloupe.
1 | # created by tools/tclZIC.tcl - do not edit | | | | | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Puerto_Rico)]} {
LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Guadeloupe) $TZData(:America/Puerto_Rico)
|
Changes to library/tzdata/America/Guyana.
1 2 3 |
# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Guyana) {
| | > | | | | 1 2 3 4 5 6 7 8 9 |
# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Guyana) {
{-9223372036854775808 -13959 0 LMT}
{-1843589241 -14400 0 -04}
{-1730577600 -13500 0 -0345}
{176096700 -10800 0 -03}
{701841600 -14400 0 -04}
}
|
Changes to library/tzdata/America/Kralendijk.
1 | # created by tools/tclZIC.tcl - do not edit | | | | | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Puerto_Rico)]} {
LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Kralendijk) $TZData(:America/Puerto_Rico)
|
Changes to library/tzdata/America/Lower_Princes.
1 | # created by tools/tclZIC.tcl - do not edit | | | | | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Puerto_Rico)]} {
LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Lower_Princes) $TZData(:America/Puerto_Rico)
|
Changes to library/tzdata/America/Marigot.
1 | # created by tools/tclZIC.tcl - do not edit | | | | | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Puerto_Rico)]} {
LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Marigot) $TZData(:America/Puerto_Rico)
|
Changes to library/tzdata/America/Montserrat.
1 | # created by tools/tclZIC.tcl - do not edit | | | | | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Puerto_Rico)]} {
LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Montserrat) $TZData(:America/Puerto_Rico)
|
Changes to library/tzdata/America/Nassau.
1 | # created by tools/tclZIC.tcl - do not edit | > > | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Toronto)]} {
LoadTimeZoneFile America/Toronto
}
set TZData(:America/Nassau) $TZData(:America/Toronto)
|
Changes to library/tzdata/America/Port_of_Spain.
1 | # created by tools/tclZIC.tcl - do not edit | > > | | < < < | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Puerto_Rico)]} {
LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Port_of_Spain) $TZData(:America/Puerto_Rico)
|
Changes to library/tzdata/America/St_Barthelemy.
1 | # created by tools/tclZIC.tcl - do not edit | | | | | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Puerto_Rico)]} {
LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/St_Barthelemy) $TZData(:America/Puerto_Rico)
|
Changes to library/tzdata/America/St_Kitts.
1 | # created by tools/tclZIC.tcl - do not edit | | | | | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Puerto_Rico)]} {
LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/St_Kitts) $TZData(:America/Puerto_Rico)
|
Changes to library/tzdata/America/St_Lucia.
1 | # created by tools/tclZIC.tcl - do not edit | | | | | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Puerto_Rico)]} {
LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/St_Lucia) $TZData(:America/Puerto_Rico)
|
Changes to library/tzdata/America/St_Thomas.
1 | # created by tools/tclZIC.tcl - do not edit | | | | | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Puerto_Rico)]} {
LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/St_Thomas) $TZData(:America/Puerto_Rico)
|
Changes to library/tzdata/America/St_Vincent.
1 | # created by tools/tclZIC.tcl - do not edit | | | | | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Puerto_Rico)]} {
LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/St_Vincent) $TZData(:America/Puerto_Rico)
|
Changes to library/tzdata/America/Tortola.
1 | # created by tools/tclZIC.tcl - do not edit | | | | | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Puerto_Rico)]} {
LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Tortola) $TZData(:America/Puerto_Rico)
|
Changes to library/tzdata/America/Virgin.
1 | # created by tools/tclZIC.tcl - do not edit | | | | | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Puerto_Rico)]} {
LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Virgin) $TZData(:America/Puerto_Rico)
|
Changes to library/tzdata/Antarctica/DumontDUrville.
1 | # created by tools/tclZIC.tcl - do not edit | > > | | < < < < < | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Port_Moresby)]} {
LoadTimeZoneFile Pacific/Port_Moresby
}
set TZData(:Antarctica/DumontDUrville) $TZData(:Pacific/Port_Moresby)
|
Changes to library/tzdata/Antarctica/Syowa.
1 | # created by tools/tclZIC.tcl - do not edit | > > | | < < < | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Riyadh)]} {
LoadTimeZoneFile Asia/Riyadh
}
set TZData(:Antarctica/Syowa) $TZData(:Asia/Riyadh)
|
Changes to library/tzdata/Asia/Amman.
| ︙ | ︙ | |||
83 84 85 86 87 88 89 |
{1540504800 7200 0 EET}
{1553810400 10800 1 EEST}
{1571954400 7200 0 EET}
{1585260000 10800 1 EEST}
{1604008800 7200 0 EET}
{1616709600 10800 1 EEST}
{1635458400 7200 0 EET}
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 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 |
{1540504800 7200 0 EET}
{1553810400 10800 1 EEST}
{1571954400 7200 0 EET}
{1585260000 10800 1 EEST}
{1604008800 7200 0 EET}
{1616709600 10800 1 EEST}
{1635458400 7200 0 EET}
{1645740000 10800 1 EEST}
{1666908000 7200 0 EET}
{1677189600 10800 1 EEST}
{1698357600 7200 0 EET}
{1709244000 10800 1 EEST}
{1729807200 7200 0 EET}
{1740693600 10800 1 EEST}
{1761861600 7200 0 EET}
{1772143200 10800 1 EEST}
{1793311200 7200 0 EET}
{1803592800 10800 1 EEST}
{1824760800 7200 0 EET}
{1835042400 10800 1 EEST}
{1856210400 7200 0 EET}
{1866492000 10800 1 EEST}
{1887660000 7200 0 EET}
{1898546400 10800 1 EEST}
{1919109600 7200 0 EET}
{1929996000 10800 1 EEST}
{1951164000 7200 0 EET}
{1961445600 10800 1 EEST}
{1982613600 7200 0 EET}
{1992895200 10800 1 EEST}
{2014063200 7200 0 EET}
{2024344800 10800 1 EEST}
{2045512800 7200 0 EET}
{2055794400 10800 1 EEST}
{2076962400 7200 0 EET}
{2087848800 10800 1 EEST}
{2109016800 7200 0 EET}
{2119298400 10800 1 EEST}
{2140466400 7200 0 EET}
{2150748000 10800 1 EEST}
{2171916000 7200 0 EET}
{2182197600 10800 1 EEST}
{2203365600 7200 0 EET}
{2213647200 10800 1 EEST}
{2234815200 7200 0 EET}
{2245701600 10800 1 EEST}
{2266264800 7200 0 EET}
{2277151200 10800 1 EEST}
{2298319200 7200 0 EET}
{2308600800 10800 1 EEST}
{2329768800 7200 0 EET}
{2340050400 10800 1 EEST}
{2361218400 7200 0 EET}
{2371500000 10800 1 EEST}
{2392668000 7200 0 EET}
{2402949600 10800 1 EEST}
{2424117600 7200 0 EET}
{2435004000 10800 1 EEST}
{2455567200 7200 0 EET}
{2466453600 10800 1 EEST}
{2487621600 7200 0 EET}
{2497903200 10800 1 EEST}
{2519071200 7200 0 EET}
{2529352800 10800 1 EEST}
{2550520800 7200 0 EET}
{2560802400 10800 1 EEST}
{2581970400 7200 0 EET}
{2592856800 10800 1 EEST}
{2613420000 7200 0 EET}
{2624306400 10800 1 EEST}
{2645474400 7200 0 EET}
{2655756000 10800 1 EEST}
{2676924000 7200 0 EET}
{2687205600 10800 1 EEST}
{2708373600 7200 0 EET}
{2718655200 10800 1 EEST}
{2739823200 7200 0 EET}
{2750104800 10800 1 EEST}
{2771272800 7200 0 EET}
{2782159200 10800 1 EEST}
{2802722400 7200 0 EET}
{2813608800 10800 1 EEST}
{2834776800 7200 0 EET}
{2845058400 10800 1 EEST}
{2866226400 7200 0 EET}
{2876508000 10800 1 EEST}
{2897676000 7200 0 EET}
{2907957600 10800 1 EEST}
{2929125600 7200 0 EET}
{2939407200 10800 1 EEST}
{2960575200 7200 0 EET}
{2971461600 10800 1 EEST}
{2992629600 7200 0 EET}
{3002911200 10800 1 EEST}
{3024079200 7200 0 EET}
{3034360800 10800 1 EEST}
{3055528800 7200 0 EET}
{3065810400 10800 1 EEST}
{3086978400 7200 0 EET}
{3097260000 10800 1 EEST}
{3118428000 7200 0 EET}
{3129314400 10800 1 EEST}
{3149877600 7200 0 EET}
{3160764000 10800 1 EEST}
{3181932000 7200 0 EET}
{3192213600 10800 1 EEST}
{3213381600 7200 0 EET}
{3223663200 10800 1 EEST}
{3244831200 7200 0 EET}
{3255112800 10800 1 EEST}
{3276280800 7200 0 EET}
{3286562400 10800 1 EEST}
{3307730400 7200 0 EET}
{3318616800 10800 1 EEST}
{3339180000 7200 0 EET}
{3350066400 10800 1 EEST}
{3371234400 7200 0 EET}
{3381516000 10800 1 EEST}
{3402684000 7200 0 EET}
{3412965600 10800 1 EEST}
{3434133600 7200 0 EET}
{3444415200 10800 1 EEST}
{3465583200 7200 0 EET}
{3476469600 10800 1 EEST}
{3497032800 7200 0 EET}
{3507919200 10800 1 EEST}
{3529087200 7200 0 EET}
{3539368800 10800 1 EEST}
{3560536800 7200 0 EET}
{3570818400 10800 1 EEST}
{3591986400 7200 0 EET}
{3602268000 10800 1 EEST}
{3623436000 7200 0 EET}
{3633717600 10800 1 EEST}
{3654885600 7200 0 EET}
{3665772000 10800 1 EEST}
{3686335200 7200 0 EET}
{3697221600 10800 1 EEST}
{3718389600 7200 0 EET}
{3728671200 10800 1 EEST}
{3749839200 7200 0 EET}
{3760120800 10800 1 EEST}
{3781288800 7200 0 EET}
{3791570400 10800 1 EEST}
{3812738400 7200 0 EET}
{3823020000 10800 1 EEST}
{3844188000 7200 0 EET}
{3855074400 10800 1 EEST}
{3876242400 7200 0 EET}
{3886524000 10800 1 EEST}
{3907692000 7200 0 EET}
{3917973600 10800 1 EEST}
{3939141600 7200 0 EET}
{3949423200 10800 1 EEST}
{3970591200 7200 0 EET}
{3980872800 10800 1 EEST}
{4002040800 7200 0 EET}
{4012927200 10800 1 EEST}
{4033490400 7200 0 EET}
{4044376800 10800 1 EEST}
{4065544800 7200 0 EET}
{4075826400 10800 1 EEST}
{4096994400 7200 0 EET}
}
|
Changes to library/tzdata/Asia/Gaza.
| ︙ | ︙ | |||
120 121 122 123 124 125 126 |
{1521846000 10800 1 EEST}
{1540591200 7200 0 EET}
{1553810400 10800 1 EEST}
{1572037200 7200 0 EET}
{1585346400 10800 1 EEST}
{1603490400 7200 0 EET}
{1616796000 10800 1 EEST}
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 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 |
{1521846000 10800 1 EEST}
{1540591200 7200 0 EET}
{1553810400 10800 1 EEST}
{1572037200 7200 0 EET}
{1585346400 10800 1 EEST}
{1603490400 7200 0 EET}
{1616796000 10800 1 EEST}
{1635458400 7200 0 EET}
{1648245600 10800 1 EEST}
{1666908000 7200 0 EET}
{1679695200 10800 1 EEST}
{1698357600 7200 0 EET}
{1711749600 10800 1 EEST}
{1729807200 7200 0 EET}
{1743199200 10800 1 EEST}
{1761861600 7200 0 EET}
{1774648800 10800 1 EEST}
{1793311200 7200 0 EET}
{1806098400 10800 1 EEST}
{1824760800 7200 0 EET}
{1837548000 10800 1 EEST}
{1856210400 7200 0 EET}
{1868997600 10800 1 EEST}
{1887660000 7200 0 EET}
{1901052000 10800 1 EEST}
{1919109600 7200 0 EET}
{1932501600 10800 1 EEST}
{1951164000 7200 0 EET}
{1963951200 10800 1 EEST}
{1982613600 7200 0 EET}
{1995400800 10800 1 EEST}
{2014063200 7200 0 EET}
{2026850400 10800 1 EEST}
{2045512800 7200 0 EET}
{2058300000 10800 1 EEST}
{2076962400 7200 0 EET}
{2090354400 10800 1 EEST}
{2109016800 7200 0 EET}
{2121804000 10800 1 EEST}
{2140466400 7200 0 EET}
{2153253600 10800 1 EEST}
{2171916000 7200 0 EET}
{2184703200 10800 1 EEST}
{2203365600 7200 0 EET}
{2216152800 10800 1 EEST}
{2234815200 7200 0 EET}
{2248207200 10800 1 EEST}
{2266264800 7200 0 EET}
{2279656800 10800 1 EEST}
{2298319200 7200 0 EET}
{2311106400 10800 1 EEST}
{2329768800 7200 0 EET}
{2342556000 10800 1 EEST}
{2361218400 7200 0 EET}
{2374005600 10800 1 EEST}
{2392668000 7200 0 EET}
{2405455200 10800 1 EEST}
{2424117600 7200 0 EET}
{2437509600 10800 1 EEST}
{2455567200 7200 0 EET}
{2468959200 10800 1 EEST}
{2487621600 7200 0 EET}
{2500408800 10800 1 EEST}
{2519071200 7200 0 EET}
{2531858400 10800 1 EEST}
{2550520800 7200 0 EET}
{2563308000 10800 1 EEST}
{2581970400 7200 0 EET}
{2595362400 10800 1 EEST}
{2613420000 7200 0 EET}
{2626812000 10800 1 EEST}
{2645474400 7200 0 EET}
{2658261600 10800 1 EEST}
{2676924000 7200 0 EET}
{2689711200 10800 1 EEST}
{2708373600 7200 0 EET}
{2721160800 10800 1 EEST}
{2739823200 7200 0 EET}
{2752610400 10800 1 EEST}
{2771272800 7200 0 EET}
{2784664800 10800 1 EEST}
{2802722400 7200 0 EET}
{2816114400 10800 1 EEST}
{2834776800 7200 0 EET}
{2847564000 10800 1 EEST}
{2866226400 7200 0 EET}
{2879013600 10800 1 EEST}
{2897676000 7200 0 EET}
{2910463200 10800 1 EEST}
{2929125600 7200 0 EET}
{2941912800 10800 1 EEST}
{2960575200 7200 0 EET}
{2973967200 10800 1 EEST}
{2992629600 7200 0 EET}
{3005416800 10800 1 EEST}
{3024079200 7200 0 EET}
{3036866400 10800 1 EEST}
{3055528800 7200 0 EET}
{3068316000 10800 1 EEST}
{3086978400 7200 0 EET}
{3099765600 10800 1 EEST}
{3118428000 7200 0 EET}
{3131820000 10800 1 EEST}
{3149877600 7200 0 EET}
{3163269600 10800 1 EEST}
{3181932000 7200 0 EET}
{3194719200 10800 1 EEST}
{3213381600 7200 0 EET}
{3226168800 10800 1 EEST}
{3244831200 7200 0 EET}
{3257618400 10800 1 EEST}
{3276280800 7200 0 EET}
{3289068000 10800 1 EEST}
{3307730400 7200 0 EET}
{3321122400 10800 1 EEST}
{3339180000 7200 0 EET}
{3352572000 10800 1 EEST}
{3371234400 7200 0 EET}
{3384021600 10800 1 EEST}
{3402684000 7200 0 EET}
{3415471200 10800 1 EEST}
{3434133600 7200 0 EET}
{3446920800 10800 1 EEST}
{3465583200 7200 0 EET}
{3478975200 10800 1 EEST}
{3497032800 7200 0 EET}
{3510424800 10800 1 EEST}
{3529087200 7200 0 EET}
{3541874400 10800 1 EEST}
{3560536800 7200 0 EET}
{3573324000 10800 1 EEST}
{3591986400 7200 0 EET}
{3604773600 10800 1 EEST}
{3623436000 7200 0 EET}
{3636223200 10800 1 EEST}
{3654885600 7200 0 EET}
{3668277600 10800 1 EEST}
{3686335200 7200 0 EET}
{3699727200 10800 1 EEST}
{3718389600 7200 0 EET}
{3731176800 10800 1 EEST}
{3749839200 7200 0 EET}
{3762626400 10800 1 EEST}
{3781288800 7200 0 EET}
{3794076000 10800 1 EEST}
{3812738400 7200 0 EET}
{3825525600 10800 1 EEST}
{3844188000 7200 0 EET}
{3857580000 10800 1 EEST}
{3876242400 7200 0 EET}
{3889029600 10800 1 EEST}
{3907692000 7200 0 EET}
{3920479200 10800 1 EEST}
{3939141600 7200 0 EET}
{3951928800 10800 1 EEST}
{3970591200 7200 0 EET}
{3983378400 10800 1 EEST}
{4002040800 7200 0 EET}
{4015432800 10800 1 EEST}
{4033490400 7200 0 EET}
{4046882400 10800 1 EEST}
{4065544800 7200 0 EET}
{4078332000 10800 1 EEST}
{4096994400 7200 0 EET}
}
|
Changes to library/tzdata/Asia/Hebron.
| ︙ | ︙ | |||
119 120 121 122 123 124 125 |
{1521846000 10800 1 EEST}
{1540591200 7200 0 EET}
{1553810400 10800 1 EEST}
{1572037200 7200 0 EET}
{1585346400 10800 1 EEST}
{1603490400 7200 0 EET}
{1616796000 10800 1 EEST}
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 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 |
{1521846000 10800 1 EEST}
{1540591200 7200 0 EET}
{1553810400 10800 1 EEST}
{1572037200 7200 0 EET}
{1585346400 10800 1 EEST}
{1603490400 7200 0 EET}
{1616796000 10800 1 EEST}
{1635458400 7200 0 EET}
{1648245600 10800 1 EEST}
{1666908000 7200 0 EET}
{1679695200 10800 1 EEST}
{1698357600 7200 0 EET}
{1711749600 10800 1 EEST}
{1729807200 7200 0 EET}
{1743199200 10800 1 EEST}
{1761861600 7200 0 EET}
{1774648800 10800 1 EEST}
{1793311200 7200 0 EET}
{1806098400 10800 1 EEST}
{1824760800 7200 0 EET}
{1837548000 10800 1 EEST}
{1856210400 7200 0 EET}
{1868997600 10800 1 EEST}
{1887660000 7200 0 EET}
{1901052000 10800 1 EEST}
{1919109600 7200 0 EET}
{1932501600 10800 1 EEST}
{1951164000 7200 0 EET}
{1963951200 10800 1 EEST}
{1982613600 7200 0 EET}
{1995400800 10800 1 EEST}
{2014063200 7200 0 EET}
{2026850400 10800 1 EEST}
{2045512800 7200 0 EET}
{2058300000 10800 1 EEST}
{2076962400 7200 0 EET}
{2090354400 10800 1 EEST}
{2109016800 7200 0 EET}
{2121804000 10800 1 EEST}
{2140466400 7200 0 EET}
{2153253600 10800 1 EEST}
{2171916000 7200 0 EET}
{2184703200 10800 1 EEST}
{2203365600 7200 0 EET}
{2216152800 10800 1 EEST}
{2234815200 7200 0 EET}
{2248207200 10800 1 EEST}
{2266264800 7200 0 EET}
{2279656800 10800 1 EEST}
{2298319200 7200 0 EET}
{2311106400 10800 1 EEST}
{2329768800 7200 0 EET}
{2342556000 10800 1 EEST}
{2361218400 7200 0 EET}
{2374005600 10800 1 EEST}
{2392668000 7200 0 EET}
{2405455200 10800 1 EEST}
{2424117600 7200 0 EET}
{2437509600 10800 1 EEST}
{2455567200 7200 0 EET}
{2468959200 10800 1 EEST}
{2487621600 7200 0 EET}
{2500408800 10800 1 EEST}
{2519071200 7200 0 EET}
{2531858400 10800 1 EEST}
{2550520800 7200 0 EET}
{2563308000 10800 1 EEST}
{2581970400 7200 0 EET}
{2595362400 10800 1 EEST}
{2613420000 7200 0 EET}
{2626812000 10800 1 EEST}
{2645474400 7200 0 EET}
{2658261600 10800 1 EEST}
{2676924000 7200 0 EET}
{2689711200 10800 1 EEST}
{2708373600 7200 0 EET}
{2721160800 10800 1 EEST}
{2739823200 7200 0 EET}
{2752610400 10800 1 EEST}
{2771272800 7200 0 EET}
{2784664800 10800 1 EEST}
{2802722400 7200 0 EET}
{2816114400 10800 1 EEST}
{2834776800 7200 0 EET}
{2847564000 10800 1 EEST}
{2866226400 7200 0 EET}
{2879013600 10800 1 EEST}
{2897676000 7200 0 EET}
{2910463200 10800 1 EEST}
{2929125600 7200 0 EET}
{2941912800 10800 1 EEST}
{2960575200 7200 0 EET}
{2973967200 10800 1 EEST}
{2992629600 7200 0 EET}
{3005416800 10800 1 EEST}
{3024079200 7200 0 EET}
{3036866400 10800 1 EEST}
{3055528800 7200 0 EET}
{3068316000 10800 1 EEST}
{3086978400 7200 0 EET}
{3099765600 10800 1 EEST}
{3118428000 7200 0 EET}
{3131820000 10800 1 EEST}
{3149877600 7200 0 EET}
{3163269600 10800 1 EEST}
{3181932000 7200 0 EET}
{3194719200 10800 1 EEST}
{3213381600 7200 0 EET}
{3226168800 10800 1 EEST}
{3244831200 7200 0 EET}
{3257618400 10800 1 EEST}
{3276280800 7200 0 EET}
{3289068000 10800 1 EEST}
{3307730400 7200 0 EET}
{3321122400 10800 1 EEST}
{3339180000 7200 0 EET}
{3352572000 10800 1 EEST}
{3371234400 7200 0 EET}
{3384021600 10800 1 EEST}
{3402684000 7200 0 EET}
{3415471200 10800 1 EEST}
{3434133600 7200 0 EET}
{3446920800 10800 1 EEST}
{3465583200 7200 0 EET}
{3478975200 10800 1 EEST}
{3497032800 7200 0 EET}
{3510424800 10800 1 EEST}
{3529087200 7200 0 EET}
{3541874400 10800 1 EEST}
{3560536800 7200 0 EET}
{3573324000 10800 1 EEST}
{3591986400 7200 0 EET}
{3604773600 10800 1 EEST}
{3623436000 7200 0 EET}
{3636223200 10800 1 EEST}
{3654885600 7200 0 EET}
{3668277600 10800 1 EEST}
{3686335200 7200 0 EET}
{3699727200 10800 1 EEST}
{3718389600 7200 0 EET}
{3731176800 10800 1 EEST}
{3749839200 7200 0 EET}
{3762626400 10800 1 EEST}
{3781288800 7200 0 EET}
{3794076000 10800 1 EEST}
{3812738400 7200 0 EET}
{3825525600 10800 1 EEST}
{3844188000 7200 0 EET}
{3857580000 10800 1 EEST}
{3876242400 7200 0 EET}
{3889029600 10800 1 EEST}
{3907692000 7200 0 EET}
{3920479200 10800 1 EEST}
{3939141600 7200 0 EET}
{3951928800 10800 1 EEST}
{3970591200 7200 0 EET}
{3983378400 10800 1 EEST}
{4002040800 7200 0 EET}
{4015432800 10800 1 EEST}
{4033490400 7200 0 EET}
{4046882400 10800 1 EEST}
{4065544800 7200 0 EET}
{4078332000 10800 1 EEST}
{4096994400 7200 0 EET}
}
|
Changes to library/tzdata/Atlantic/Azores.
| ︙ | ︙ | |||
62 63 64 65 66 67 68 69 70 71 72 73 74 75 |
{-733359600 -7200 0 -02}
{-717624000 -3600 1 -01}
{-701899200 -7200 0 -02}
{-686174400 -3600 1 -01}
{-670449600 -7200 0 -02}
{-654724800 -3600 1 -01}
{-639000000 -7200 0 -02}
{-591825600 -3600 1 -01}
{-575496000 -7200 0 -02}
{-559771200 -3600 1 -01}
{-544046400 -7200 0 -02}
{-528321600 -3600 1 -01}
{-512596800 -7200 0 -02}
{-496872000 -3600 1 -01}
| > > | 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 |
{-733359600 -7200 0 -02}
{-717624000 -3600 1 -01}
{-701899200 -7200 0 -02}
{-686174400 -3600 1 -01}
{-670449600 -7200 0 -02}
{-654724800 -3600 1 -01}
{-639000000 -7200 0 -02}
{-623275200 -3600 1 -01}
{-607550400 -7200 0 -02}
{-591825600 -3600 1 -01}
{-575496000 -7200 0 -02}
{-559771200 -3600 1 -01}
{-544046400 -7200 0 -02}
{-528321600 -3600 1 -01}
{-512596800 -7200 0 -02}
{-496872000 -3600 1 -01}
|
| ︙ | ︙ |
Changes to library/tzdata/Atlantic/Madeira.
| ︙ | ︙ | |||
62 63 64 65 66 67 68 69 70 71 72 73 74 75 |
{-733363200 -3600 0 -01}
{-717627600 0 1 +00}
{-701902800 -3600 0 -01}
{-686178000 0 1 +00}
{-670453200 -3600 0 -01}
{-654728400 0 1 +00}
{-639003600 -3600 0 -01}
{-591829200 0 1 +00}
{-575499600 -3600 0 -01}
{-559774800 0 1 +00}
{-544050000 -3600 0 -01}
{-528325200 0 1 +00}
{-512600400 -3600 0 -01}
{-496875600 0 1 +00}
| > > | 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 |
{-733363200 -3600 0 -01}
{-717627600 0 1 +00}
{-701902800 -3600 0 -01}
{-686178000 0 1 +00}
{-670453200 -3600 0 -01}
{-654728400 0 1 +00}
{-639003600 -3600 0 -01}
{-623278800 0 1 +00}
{-607554000 -3600 0 -01}
{-591829200 0 1 +00}
{-575499600 -3600 0 -01}
{-559774800 0 1 +00}
{-544050000 -3600 0 -01}
{-528325200 0 1 +00}
{-512600400 -3600 0 -01}
{-496875600 0 1 +00}
|
| ︙ | ︙ |
Changes to library/tzdata/Europe/Lisbon.
| ︙ | ︙ | |||
66 67 68 69 70 71 72 73 74 75 76 77 78 79 |
{-733366800 0 0 WET}
{-717631200 3600 1 WEST}
{-701906400 0 0 WET}
{-686181600 3600 1 WEST}
{-670456800 0 0 WET}
{-654732000 3600 1 WEST}
{-639007200 0 0 WET}
{-591832800 3600 1 WEST}
{-575503200 0 0 WET}
{-559778400 3600 1 WEST}
{-544053600 0 0 WET}
{-528328800 3600 1 WEST}
{-512604000 0 0 WET}
{-496879200 3600 1 WEST}
| > > | 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 |
{-733366800 0 0 WET}
{-717631200 3600 1 WEST}
{-701906400 0 0 WET}
{-686181600 3600 1 WEST}
{-670456800 0 0 WET}
{-654732000 3600 1 WEST}
{-639007200 0 0 WET}
{-623282400 3600 1 WEST}
{-607557600 0 0 WET}
{-591832800 3600 1 WEST}
{-575503200 0 0 WET}
{-559778400 3600 1 WEST}
{-544053600 0 0 WET}
{-528328800 3600 1 WEST}
{-512604000 0 0 WET}
{-496879200 3600 1 WEST}
|
| ︙ | ︙ |
Changes to library/tzdata/Pacific/Apia.
| ︙ | ︙ | |||
24 25 26 27 28 29 30 |
{1522504800 46800 0 +13}
{1538229600 50400 1 +13}
{1554559200 46800 0 +13}
{1569679200 50400 1 +13}
{1586008800 46800 0 +13}
{1601128800 50400 1 +13}
{1617458400 46800 0 +13}
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 24 25 26 27 28 29 30 31 |
{1522504800 46800 0 +13}
{1538229600 50400 1 +13}
{1554559200 46800 0 +13}
{1569679200 50400 1 +13}
{1586008800 46800 0 +13}
{1601128800 50400 1 +13}
{1617458400 46800 0 +13}
}
|
Changes to library/tzdata/Pacific/Enderbury.
1 | # created by tools/tclZIC.tcl - do not edit | > > | | < < < < < | 1 2 3 4 5 |
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Kanton)]} {
LoadTimeZoneFile Pacific/Kanton
}
set TZData(:Pacific/Enderbury) $TZData(:Pacific/Kanton)
|
Changes to library/tzdata/Pacific/Fiji.
| ︙ | ︙ | |||
27 28 29 30 31 32 33 |
{1515852000 43200 0 +12}
{1541253600 46800 1 +12}
{1547301600 43200 0 +12}
{1573308000 46800 1 +12}
{1578751200 43200 0 +12}
{1608386400 46800 1 +12}
{1610805600 43200 0 +12}
| < < | 27 28 29 30 31 32 33 34 35 36 37 38 39 40 |
{1515852000 43200 0 +12}
{1541253600 46800 1 +12}
{1547301600 43200 0 +12}
{1573308000 46800 1 +12}
{1578751200 43200 0 +12}
{1608386400 46800 1 +12}
{1610805600 43200 0 +12}
{1668261600 46800 1 +12}
{1673704800 43200 0 +12}
{1699711200 46800 1 +12}
{1705154400 43200 0 +12}
{1731160800 46800 1 +12}
{1736604000 43200 0 +12}
{1762610400 46800 1 +12}
|
| ︙ | ︙ |
Added library/tzdata/Pacific/Kanton.
> > > > > > > > | 1 2 3 4 5 6 7 8 |
# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Kanton) {
{-9223372036854775808 0 0 -00}
{-1020470400 -43200 0 -12}
{307627200 -39600 0 -11}
{788871600 46800 0 +13}
}
|
Changes to library/tzdata/Pacific/Niue.
1 2 3 4 |
# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Niue) {
{-9223372036854775808 -40780 0 LMT}
| | < | | 1 2 3 4 5 6 7 |
# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Niue) {
{-9223372036854775808 -40780 0 LMT}
{-543069620 -40800 0 -1120}
{-173623200 -39600 0 -11}
}
|
Changes to library/tzdata/Pacific/Rarotonga.
1 2 3 |
# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Rarotonga) {
| | > | | 1 2 3 4 5 6 7 8 9 10 11 12 13 |
# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Rarotonga) {
{-9223372036854775808 48056 0 LMT}
{-2209555256 -38344 0 LMT}
{-543072056 -37800 0 -1030}
{279714600 -34200 0 -10}
{289387800 -36000 0 -10}
{309952800 -34200 1 -10}
{320837400 -36000 0 -10}
{341402400 -34200 1 -10}
{352287000 -36000 0 -10}
{372852000 -34200 1 -10}
|
| ︙ | ︙ |
Changes to library/tzdata/Pacific/Tongatapu.
1 2 3 |
# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Tongatapu) {
| | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 |
# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Tongatapu) {
{-9223372036854775808 44352 0 LMT}
{-767189952 44400 0 +1220}
{-284041200 46800 0 +13}
{915102000 46800 0 +13}
{939214800 50400 1 +13}
{953384400 46800 0 +13}
{973342800 50400 1 +13}
{980596800 46800 0 +13}
{1004792400 50400 1 +13}
{1012046400 46800 0 +13}
|
| ︙ | ︙ |
Changes to libtommath/bn_mp_sqrt.c.
1 2 3 4 5 6 7 8 9 10 11 12 13 | #include "tommath_private.h" #ifdef BN_MP_SQRT_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ #ifndef NO_FLOATING_POINT #include <math.h> #if (MP_DIGIT_BIT != 28) || (FLT_RADIX != 2) || (DBL_MANT_DIG != 53) || (DBL_MAX_EXP != 1024) #define NO_FLOATING_POINT #endif #endif /* this function is less generic than mp_n_root, simpler and faster */ | > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | #include "tommath_private.h" #ifdef BN_MP_SQRT_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ #ifndef NO_FLOATING_POINT #include <float.h> #include <math.h> #if (MP_DIGIT_BIT != 28) || (FLT_RADIX != 2) || (DBL_MANT_DIG != 53) || (DBL_MAX_EXP != 1024) #define NO_FLOATING_POINT #endif #endif /* this function is less generic than mp_n_root, simpler and faster */ |
| ︙ | ︙ |
Changes to libtommath/tommath.def.
| ︙ | ︙ | |||
139 140 141 142 143 144 145 |
mp_to_radix
mp_to_sbin
mp_to_ubin
mp_ubin_size
mp_unpack
mp_xor
mp_zero
| > > > > > > > > > > > | 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 |
mp_to_radix
mp_to_sbin
mp_to_ubin
mp_ubin_size
mp_unpack
mp_xor
mp_zero
s_mp_mul_digs
s_mp_sub
s_mp_add
s_mp_toom_mul
s_mp_mul_digs_fast
s_mp_karatsuba_mul
s_mp_sqr_fast
s_mp_reverse
s_mp_karatsuba_sqr
s_mp_toom_sqr
s_mp_sqr
|
Changes to libtommath/tommath.h.
| ︙ | ︙ | |||
34 35 36 37 38 39 40 | /* MS Visual C++ doesn't have a 128bit type for words, so fall back to 32bit MPI's (where words are 64bit) */ #if (defined(_MSC_VER) || defined(__LLP64__) || defined(__e2k__) || defined(__LCC__)) && !defined(MP_32BIT) && !defined(MP_64BIT) # define MP_32BIT #endif /* detect 64-bit mode if possible */ | | | | 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 |
/* MS Visual C++ doesn't have a 128bit type for words, so fall back to 32bit MPI's (where words are 64bit) */
#if (defined(_MSC_VER) || defined(__LLP64__) || defined(__e2k__) || defined(__LCC__)) && !defined(MP_32BIT) && !defined(MP_64BIT)
# define MP_32BIT
#endif
/* detect 64-bit mode if possible */
#if defined(__x86_64__) || defined(_M_X64) || defined(_M_AMD64) || defined(_M_ARM64) || \
defined(__powerpc64__) || defined(__ppc64__) || defined(__PPC64__) || \
defined(__s390x__) || defined(__arch64__) || defined(__aarch64__) || \
defined(__sparcv9) || defined(__sparc_v9__) || defined(__sparc64__) || \
defined(__ia64) || defined(__ia64__) || defined(__itanium__) || defined(_M_IA64) || \
defined(__LP64__) || defined(_LP64) || defined(__64BIT__)
# if !(defined(MP_64BIT) || defined(MP_32BIT) || defined(MP_16BIT) || defined(MP_8BIT))
# if defined(__GNUC__) && defined(__SIZEOF_INT128__) && !defined(__hppa)
/* we support 128bit integers only via: __attribute__((mode(TI))) */
# define MP_64BIT
# else
/* otherwise we fall back to MP_32BIT even on 64bit platforms */
# define MP_32BIT
# endif
# endif
|
| ︙ | ︙ |
Added libtommath/win64-arm/libtommath.dll.
cannot compute difference between binary files
Added libtommath/win64-arm/libtommath.dll.a.
cannot compute difference between binary files
Added libtommath/win64-arm/tommath.lib.
cannot compute difference between binary files
Changes to libtommath/win64/libtommath.dll.
cannot compute difference between binary files
Changes to libtommath/win64/libtommath.dll.a.
cannot compute difference between binary files
libtommath/win64/tommath.lib became a regular file.
cannot compute difference between binary files
Changes to macosx/Tcl.xcode/project.pbxproj.
| ︙ | ︙ | |||
390 391 392 393 394 395 396 |
F96D3E9E08F272A7004A47F5 /* Sleep.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Sleep.3; sourceTree = "<group>"; };
F96D3E9F08F272A7004A47F5 /* socket.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = socket.n; sourceTree = "<group>"; };
F96D3EA008F272A7004A47F5 /* source.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = source.n; sourceTree = "<group>"; };
F96D3EA108F272A7004A47F5 /* SourceRCFile.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SourceRCFile.3; sourceTree = "<group>"; };
F96D3EA208F272A7004A47F5 /* split.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = split.n; sourceTree = "<group>"; };
F96D3EA308F272A7004A47F5 /* SplitList.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SplitList.3; sourceTree = "<group>"; };
F96D3EA408F272A7004A47F5 /* SplitPath.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SplitPath.3; sourceTree = "<group>"; };
| | | 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 |
F96D3E9E08F272A7004A47F5 /* Sleep.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Sleep.3; sourceTree = "<group>"; };
F96D3E9F08F272A7004A47F5 /* socket.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = socket.n; sourceTree = "<group>"; };
F96D3EA008F272A7004A47F5 /* source.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = source.n; sourceTree = "<group>"; };
F96D3EA108F272A7004A47F5 /* SourceRCFile.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SourceRCFile.3; sourceTree = "<group>"; };
F96D3EA208F272A7004A47F5 /* split.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = split.n; sourceTree = "<group>"; };
F96D3EA308F272A7004A47F5 /* SplitList.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SplitList.3; sourceTree = "<group>"; };
F96D3EA408F272A7004A47F5 /* SplitPath.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SplitPath.3; sourceTree = "<group>"; };
F96D3EA508F272A7004A47F5 /* StaticLibrary.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StaticLibrary.3; sourceTree = "<group>"; };
F96D3EA608F272A7004A47F5 /* StdChannels.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StdChannels.3; sourceTree = "<group>"; };
F96D3EA708F272A7004A47F5 /* string.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = string.n; sourceTree = "<group>"; };
F96D3EA808F272A7004A47F5 /* StringObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StringObj.3; sourceTree = "<group>"; };
F96D3EA908F272A7004A47F5 /* StrMatch.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StrMatch.3; sourceTree = "<group>"; };
F96D3EAA08F272A7004A47F5 /* subst.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = subst.n; sourceTree = "<group>"; };
F96D3EAB08F272A7004A47F5 /* SubstObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SubstObj.3; sourceTree = "<group>"; };
F96D3EAC08F272A7004A47F5 /* switch.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = switch.n; sourceTree = "<group>"; };
|
| ︙ | ︙ | |||
1137 1138 1139 1140 1141 1142 1143 | F96D3E9E08F272A7004A47F5 /* Sleep.3 */, F96D3E9F08F272A7004A47F5 /* socket.n */, F96D3EA008F272A7004A47F5 /* source.n */, F96D3EA108F272A7004A47F5 /* SourceRCFile.3 */, F96D3EA208F272A7004A47F5 /* split.n */, F96D3EA308F272A7004A47F5 /* SplitList.3 */, F96D3EA408F272A7004A47F5 /* SplitPath.3 */, | | | 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 | F96D3E9E08F272A7004A47F5 /* Sleep.3 */, F96D3E9F08F272A7004A47F5 /* socket.n */, F96D3EA008F272A7004A47F5 /* source.n */, F96D3EA108F272A7004A47F5 /* SourceRCFile.3 */, F96D3EA208F272A7004A47F5 /* split.n */, F96D3EA308F272A7004A47F5 /* SplitList.3 */, F96D3EA408F272A7004A47F5 /* SplitPath.3 */, F96D3EA508F272A7004A47F5 /* StaticLibrary.3 */, F96D3EA608F272A7004A47F5 /* StdChannels.3 */, F96D3EA708F272A7004A47F5 /* string.n */, F96D3EA808F272A7004A47F5 /* StringObj.3 */, F96D3EA908F272A7004A47F5 /* StrMatch.3 */, F96D3EAA08F272A7004A47F5 /* subst.n */, F96D3EAB08F272A7004A47F5 /* SubstObj.3 */, F96D3EAC08F272A7004A47F5 /* switch.n */, |
| ︙ | ︙ |
Changes to macosx/Tcl.xcodeproj/project.pbxproj.
| ︙ | ︙ | |||
389 390 391 392 393 394 395 |
F96D3E9E08F272A7004A47F5 /* Sleep.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Sleep.3; sourceTree = "<group>"; };
F96D3E9F08F272A7004A47F5 /* socket.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = socket.n; sourceTree = "<group>"; };
F96D3EA008F272A7004A47F5 /* source.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = source.n; sourceTree = "<group>"; };
F96D3EA108F272A7004A47F5 /* SourceRCFile.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SourceRCFile.3; sourceTree = "<group>"; };
F96D3EA208F272A7004A47F5 /* split.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = split.n; sourceTree = "<group>"; };
F96D3EA308F272A7004A47F5 /* SplitList.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SplitList.3; sourceTree = "<group>"; };
F96D3EA408F272A7004A47F5 /* SplitPath.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SplitPath.3; sourceTree = "<group>"; };
| | | 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 |
F96D3E9E08F272A7004A47F5 /* Sleep.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Sleep.3; sourceTree = "<group>"; };
F96D3E9F08F272A7004A47F5 /* socket.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = socket.n; sourceTree = "<group>"; };
F96D3EA008F272A7004A47F5 /* source.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = source.n; sourceTree = "<group>"; };
F96D3EA108F272A7004A47F5 /* SourceRCFile.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SourceRCFile.3; sourceTree = "<group>"; };
F96D3EA208F272A7004A47F5 /* split.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = split.n; sourceTree = "<group>"; };
F96D3EA308F272A7004A47F5 /* SplitList.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SplitList.3; sourceTree = "<group>"; };
F96D3EA408F272A7004A47F5 /* SplitPath.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SplitPath.3; sourceTree = "<group>"; };
F96D3EA508F272A7004A47F5 /* StaticLibrary.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StaticLibrary.3; sourceTree = "<group>"; };
F96D3EA608F272A7004A47F5 /* StdChannels.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StdChannels.3; sourceTree = "<group>"; };
F96D3EA708F272A7004A47F5 /* string.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = string.n; sourceTree = "<group>"; };
F96D3EA808F272A7004A47F5 /* StringObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StringObj.3; sourceTree = "<group>"; };
F96D3EA908F272A7004A47F5 /* StrMatch.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StrMatch.3; sourceTree = "<group>"; };
F96D3EAA08F272A7004A47F5 /* subst.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = subst.n; sourceTree = "<group>"; };
F96D3EAB08F272A7004A47F5 /* SubstObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SubstObj.3; sourceTree = "<group>"; };
F96D3EAC08F272A7004A47F5 /* switch.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = switch.n; sourceTree = "<group>"; };
|
| ︙ | ︙ | |||
1137 1138 1139 1140 1141 1142 1143 | F96D3E9E08F272A7004A47F5 /* Sleep.3 */, F96D3E9F08F272A7004A47F5 /* socket.n */, F96D3EA008F272A7004A47F5 /* source.n */, F96D3EA108F272A7004A47F5 /* SourceRCFile.3 */, F96D3EA208F272A7004A47F5 /* split.n */, F96D3EA308F272A7004A47F5 /* SplitList.3 */, F96D3EA408F272A7004A47F5 /* SplitPath.3 */, | | | 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 | F96D3E9E08F272A7004A47F5 /* Sleep.3 */, F96D3E9F08F272A7004A47F5 /* socket.n */, F96D3EA008F272A7004A47F5 /* source.n */, F96D3EA108F272A7004A47F5 /* SourceRCFile.3 */, F96D3EA208F272A7004A47F5 /* split.n */, F96D3EA308F272A7004A47F5 /* SplitList.3 */, F96D3EA408F272A7004A47F5 /* SplitPath.3 */, F96D3EA508F272A7004A47F5 /* StaticLibrary.3 */, F96D3EA608F272A7004A47F5 /* StdChannels.3 */, F96D3EA708F272A7004A47F5 /* string.n */, F96D3EA808F272A7004A47F5 /* StringObj.3 */, F96D3EA908F272A7004A47F5 /* StrMatch.3 */, F96D3EAA08F272A7004A47F5 /* subst.n */, F96D3EAB08F272A7004A47F5 /* SubstObj.3 */, F96D3EAC08F272A7004A47F5 /* switch.n */, |
| ︙ | ︙ |
Changes to macosx/tclMacOSXFCmd.c.
| ︙ | ︙ | |||
573 574 575 576 577 578 579 |
GetOSTypeFromObj(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
Tcl_Obj *objPtr, /* The object from which to get an OSType. */
OSType *osTypePtr) /* Place to store resulting OSType. */
{
int result = TCL_OK;
| | | 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 |
GetOSTypeFromObj(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
Tcl_Obj *objPtr, /* The object from which to get an OSType. */
OSType *osTypePtr) /* Place to store resulting OSType. */
{
int result = TCL_OK;
if (!TclHasInternalRep(objPtr, &tclOSTypeType)) {
result = SetOSTypeFromAny(interp, objPtr);
}
*osTypePtr = (OSType) objPtr->internalRep.wideValue;
return result;
}
/*
|
| ︙ | ︙ | |||
655 656 657 658 659 660 661 |
char bytes[4] = {'\0','\0','\0','\0'};
memcpy(bytes, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
osType = (OSType) bytes[0] << 24 |
(OSType) bytes[1] << 16 |
(OSType) bytes[2] << 8 |
(OSType) bytes[3];
| | | 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 |
char bytes[4] = {'\0','\0','\0','\0'};
memcpy(bytes, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
osType = (OSType) bytes[0] << 24 |
(OSType) bytes[1] << 16 |
(OSType) bytes[2] << 8 |
(OSType) bytes[3];
TclFreeInternalRep(objPtr);
objPtr->internalRep.wideValue = (Tcl_WideInt) osType;
objPtr->typePtr = &tclOSTypeType;
}
Tcl_DStringFree(&ds);
Tcl_FreeEncoding(encoding);
return result;
}
|
| ︙ | ︙ |
Changes to macosx/tclMacOSXNotify.c.
| ︙ | ︙ | |||
453 454 455 456 457 458 459 460 461 462 463 464 465 466 | * The following static indicates if the notifier thread is running. * * You must hold the notifierInitLock before accessing this variable. */ static int notifierThreadRunning; /* * This is the thread ID of the notifier thread that does select. Only valid * when notifierThreadRunning is non-zero. * * You must hold the notifierInitLock before accessing this variable. */ | > > > > > > > > > > > > > > | 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 | * The following static indicates if the notifier thread is running. * * You must hold the notifierInitLock before accessing this variable. */ static int notifierThreadRunning; /* * The following static flag indicates that async handlers are pending. */ #if TCL_THREADS static int asyncPending = 0; #endif /* * Signal mask information for notifier thread. */ static sigset_t notifierSigMask; static sigset_t allSigMask; /* * This is the thread ID of the notifier thread that does select. Only valid * when notifierThreadRunning is non-zero. * * You must hold the notifierInitLock before accessing this variable. */ |
| ︙ | ︙ | |||
530 531 532 533 534 535 536 | #define noCFafterFork 1 #endif /* MAC_OS_X_VERSION_MIN_REQUIRED */ #endif /* HAVE_PTHREAD_ATFORK */ /* *---------------------------------------------------------------------- * | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | < < < < < < | | 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 |
#define noCFafterFork 1
#endif /* MAC_OS_X_VERSION_MIN_REQUIRED */
#endif /* HAVE_PTHREAD_ATFORK */
/*
*----------------------------------------------------------------------
*
* LookUpFileHandler --
*
* Look up the file handler structure (and optionally the previous one in
* the chain) associated with a file descriptor.
*
* Returns:
* A pointer to the file handler, or NULL if it can't be found.
*
* Side effects:
* If prevPtrPtr is non-NULL, it will be written to if the file handler
* is found.
*
*----------------------------------------------------------------------
*/
static inline FileHandler *
LookUpFileHandler(
ThreadSpecificData *tsdPtr, /* Where to look things up. */
int fd, /* What we are looking for. */
FileHandler **prevPtrPtr) /* If non-NULL, where to report the previous
* pointer. */
{
FileHandler *filePtr, *prevPtr;
/*
* Find the entry for the given file (and return if there isn't one).
*/
for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ;
prevPtr = filePtr, filePtr = filePtr->nextPtr) {
if (filePtr == NULL) {
return NULL;
}
if (filePtr->fd == fd) {
break;
}
}
/*
* Report what we've found to our caller.
*/
if (prevPtrPtr) {
*prevPtrPtr = prevPtr;
}
return filePtr;
}
/*
*----------------------------------------------------------------------
*
* TclpInitNotifier --
*
* Initializes the platform specific notifier state.
*
* Results:
* Returns a handle to the notifier state for this thread.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
ClientData
TclpInitNotifier(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
#ifdef WEAK_IMPORT_SPINLOCKLOCK
/*
* Initialize support for weakly imported spinlock API.
*/
if (pthread_once(&spinLockLockInitControl, SpinLockLockInit)) {
Tcl_Panic("Tcl_InitNotifier: %s", "pthread_once failed");
}
#endif
#ifndef __CONSTANT_CFSTRINGS__
if (!tclEventsOnlyRunLoopMode) {
tclEventsOnlyRunLoopMode = CFSTR(TCL_EVENTS_ONLY_RUN_LOOP_MODE);
}
|
| ︙ | ︙ | |||
586 587 588 589 590 591 592 |
bzero(&runLoopSourceContext, sizeof(CFRunLoopSourceContext));
runLoopSourceContext.info = tsdPtr;
runLoopSourceContext.perform = QueueFileEvents;
runLoopSource = CFRunLoopSourceCreate(NULL, LONG_MIN,
&runLoopSourceContext);
if (!runLoopSource) {
| | > | | | | | 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 |
bzero(&runLoopSourceContext, sizeof(CFRunLoopSourceContext));
runLoopSourceContext.info = tsdPtr;
runLoopSourceContext.perform = QueueFileEvents;
runLoopSource = CFRunLoopSourceCreate(NULL, LONG_MIN,
&runLoopSourceContext);
if (!runLoopSource) {
Tcl_Panic("Tcl_InitNotifier: %s",
"could not create CFRunLoopSource");
}
CFRunLoopAddSource(runLoop, runLoopSource, kCFRunLoopCommonModes);
CFRunLoopAddSource(runLoop, runLoopSource, tclEventsOnlyRunLoopMode);
bzero(&runLoopObserverContext, sizeof(CFRunLoopObserverContext));
runLoopObserverContext.info = tsdPtr;
runLoopObserver = CFRunLoopObserverCreate(NULL,
kCFRunLoopEntry|kCFRunLoopExit, TRUE,
LONG_MIN, UpdateWaitingListAndServiceEvents,
&runLoopObserverContext);
if (!runLoopObserver) {
Tcl_Panic("Tcl_InitNotifier: %s",
"could not create CFRunLoopObserver");
}
CFRunLoopAddObserver(runLoop, runLoopObserver, kCFRunLoopCommonModes);
/*
* Create a second CFRunLoopObserver with the same callback as above
* for the tclEventsOnlyRunLoopMode to ensure that the callback can be
* re-entered via Tcl_ServiceAll() in the kCFRunLoopBeforeWaiting case
* (CFRunLoop prevents observer callback re-entry of a given observer
* instance).
*/
runLoopObserverTcl = CFRunLoopObserverCreate(NULL,
kCFRunLoopEntry|kCFRunLoopExit, TRUE,
LONG_MIN, UpdateWaitingListAndServiceEvents,
&runLoopObserverContext);
if (!runLoopObserverTcl) {
Tcl_Panic("Tcl_InitNotifier: %s",
"could not create CFRunLoopObserver");
}
CFRunLoopAddObserver(runLoop, runLoopObserverTcl,
tclEventsOnlyRunLoopMode);
tsdPtr->runLoop = runLoop;
tsdPtr->runLoopSource = runLoopSource;
tsdPtr->runLoopObserver = runLoopObserver;
|
| ︙ | ︙ | |||
646 647 648 649 650 651 652 |
* child of a fork.
*/
if (MayUsePthreadAtfork() && !atForkInit) {
int result = pthread_atfork(AtForkPrepare, AtForkParent, AtForkChild);
if (result) {
| | | | | | | | 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 |
* child of a fork.
*/
if (MayUsePthreadAtfork() && !atForkInit) {
int result = pthread_atfork(AtForkPrepare, AtForkParent, AtForkChild);
if (result) {
Tcl_Panic("Tcl_InitNotifier: %s", "pthread_atfork failed");
}
atForkInit = 1;
}
#endif /* HAVE_PTHREAD_ATFORK */
if (notifierCount == 0) {
int fds[2], status;
/*
* Initialize trigger pipe.
*/
if (pipe(fds) != 0) {
Tcl_Panic("Tcl_InitNotifier: %s", "could not create trigger pipe");
}
status = fcntl(fds[0], F_GETFL);
status |= O_NONBLOCK;
if (fcntl(fds[0], F_SETFL, status) < 0) {
Tcl_Panic("Tcl_InitNotifier: %s",
"could not make receive pipe non-blocking");
}
status = fcntl(fds[1], F_GETFL);
status |= O_NONBLOCK;
if (fcntl(fds[1], F_SETFL, status) < 0) {
Tcl_Panic("Tcl_InitNotifier: %s",
"could not make trigger pipe non-blocking");
}
receivePipe = fds[0];
triggerPipe = fds[1];
/*
* Create notifier thread lazily in Tcl_WaitForEvent() to avoid
|
| ︙ | ︙ | |||
753 754 755 756 757 758 759 760 761 762 763 764 |
if (!notifierCount) {
Tcl_Panic("StartNotifierThread: notifier not initialized");
}
if (!notifierThreadRunning) {
int result;
pthread_attr_t attr;
pthread_attr_init(&attr);
pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM);
pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE);
pthread_attr_setstacksize(&attr, 60 * 1024);
result = pthread_create(¬ifierThread, &attr,
| > > > > > > > > > | > > > > > > | | | | < < < < < < < | 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 |
if (!notifierCount) {
Tcl_Panic("StartNotifierThread: notifier not initialized");
}
if (!notifierThreadRunning) {
int result;
pthread_attr_t attr;
/*
* Arrange for the notifier thread to start with all
* signals blocked. In its mainloop it unblocks the
* signals at safe points.
*/
sigfillset(&allSigMask);
pthread_sigmask(SIG_BLOCK, &allSigMask, ¬ifierSigMask);
pthread_attr_init(&attr);
pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM);
pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE);
pthread_attr_setstacksize(&attr, 60 * 1024);
result = pthread_create(¬ifierThread, &attr,
(void * (*)(void *)) NotifierThreadProc, NULL);
pthread_attr_destroy(&attr);
if (result) {
Tcl_Panic("StartNotifierThread: unable to start notifier thread");
}
notifierThreadRunning = 1;
/*
* Restore original signal mask.
*/
pthread_sigmask(SIG_SETMASK, ¬ifierSigMask, NULL);
}
UNLOCK_NOTIFIER_INIT;
}
/*
*----------------------------------------------------------------------
*
* TclpFinalizeNotifier --
*
* This function is called to cleanup the notifier state before a thread
* is terminated.
*
* Results:
* None.
*
* Side effects:
* May terminate the background notifier thread if this is the last
* notifier instance.
*
*----------------------------------------------------------------------
*/
void
TclpFinalizeNotifier(
TCL_UNUSED(ClientData))
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
LOCK_NOTIFIER_INIT;
notifierCount--;
DISABLE_ASL;
/*
* If this is the last thread to use the notifier, close the notifier pipe
|
| ︙ | ︙ | |||
833 834 835 836 837 838 839 840 841 842 843 844 845 846 |
int result = pthread_join(notifierThread, NULL);
if (result) {
Tcl_Panic("Tcl_FinalizeNotifier: unable to join notifier "
"thread");
}
notifierThreadRunning = 0;
}
close(receivePipe);
triggerPipe = -1;
}
CLOSE_NOTIFIER_LOG;
}
| > > > > > > > > | 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 |
int result = pthread_join(notifierThread, NULL);
if (result) {
Tcl_Panic("Tcl_FinalizeNotifier: unable to join notifier "
"thread");
}
notifierThreadRunning = 0;
/*
* If async marks are outstanding, perform actions now.
*/
if (asyncPending) {
asyncPending = 0;
TclAsyncMarkFromNotifier();
}
}
close(receivePipe);
triggerPipe = -1;
}
CLOSE_NOTIFIER_LOG;
}
|
| ︙ | ︙ | |||
872 873 874 875 876 877 878 |
}
UNLOCK_NOTIFIER_TSD;
}
/*
*----------------------------------------------------------------------
*
| | | | < < < < < | | < < < < < | | 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 |
}
UNLOCK_NOTIFIER_TSD;
}
/*
*----------------------------------------------------------------------
*
* TclpAlertNotifier --
*
* Wake up the specified notifier from any thread. This routine is called
* by the platform independent notifier code whenever the Tcl_ThreadAlert
* routine is called. This routine is guaranteed not to be called on a
* given notifier after Tcl_FinalizeNotifier is called for that notifier.
*
* Results:
* None.
*
* Side effects:
* Signals the notifier condition variable for the specified notifier.
*
*----------------------------------------------------------------------
*/
void
TclpAlertNotifier(
ClientData clientData)
{
ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
LOCK_NOTIFIER_TSD;
if (tsdPtr->runLoop) {
CFRunLoopSourceSignal(tsdPtr->runLoopSource);
CFRunLoopWakeUp(tsdPtr->runLoop);
}
UNLOCK_NOTIFIER_TSD;
}
/*
*----------------------------------------------------------------------
*
* TclpSetTimer --
*
* This function sets the current notifier timer value.
*
* Results:
* None.
*
* Side effects:
* Replaces any previous timer.
*
*----------------------------------------------------------------------
*/
void
TclpSetTimer(
const Tcl_Time *timePtr) /* Timeout value, may be NULL. */
{
ThreadSpecificData *tsdPtr;
CFRunLoopTimerRef runLoopTimer;
CFTimeInterval waitTime;
tsdPtr = TCL_TSD_INIT(&dataKey);
runLoopTimer = tsdPtr->runLoopTimer;
if (!runLoopTimer) {
return;
}
if (timePtr) {
Tcl_Time vTime = *timePtr;
if (vTime.sec != 0 || vTime.usec != 0) {
TclScaleTime(&vTime);
waitTime = vTime.sec + 1.0e-6 * vTime.usec;
} else {
waitTime = 0;
}
} else {
waitTime = CF_TIMEINTERVAL_FOREVER;
}
|
| ︙ | ︙ | |||
984 985 986 987 988 989 990 |
TCL_UNUSED(ClientData))
{
}
/*
*----------------------------------------------------------------------
*
| | | | < < < < < < < | | | | | < < < < < < < < < < < < < | | 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 |
TCL_UNUSED(ClientData))
{
}
/*
*----------------------------------------------------------------------
*
* TclpServiceModeHook --
*
* This function is invoked whenever the service mode changes.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
void
TclpServiceModeHook(
int mode) /* Either TCL_SERVICE_ALL, or
* TCL_SERVICE_NONE. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (mode == TCL_SERVICE_ALL && !tsdPtr->runLoopTimer) {
if (!tsdPtr->runLoop) {
Tcl_Panic("Tcl_ServiceModeHook: Notifier not initialized");
}
tsdPtr->runLoopTimer = CFRunLoopTimerCreate(NULL,
CFAbsoluteTimeGetCurrent() + CF_TIMEINTERVAL_FOREVER,
CF_TIMEINTERVAL_FOREVER, 0, 0, TimerWakeUp, NULL);
if (tsdPtr->runLoopTimer) {
CFRunLoopAddTimer(tsdPtr->runLoop, tsdPtr->runLoopTimer,
kCFRunLoopCommonModes);
StartNotifierThread();
}
}
}
/*
*----------------------------------------------------------------------
*
* TclpCreateFileHandler --
*
* This function registers a file handler with the notifier.
*
* Results:
* None.
*
* Side effects:
* Creates a new file handler structure.
*
*----------------------------------------------------------------------
*/
void
TclpCreateFileHandler(
int fd, /* Handle of stream to watch. */
int mask, /* OR'ed combination of TCL_READABLE,
* TCL_WRITABLE, and TCL_EXCEPTION: indicates
* conditions under which proc should be
* called. */
Tcl_FileProc *proc, /* Function to call for each selected
* event. */
ClientData clientData) /* Arbitrary data to pass to proc. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL);
if (filePtr == NULL) {
filePtr = (FileHandler *) ckalloc(sizeof(FileHandler));
filePtr->fd = fd;
filePtr->readyMask = 0;
filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
tsdPtr->firstFileHandlerPtr = filePtr;
}
filePtr->proc = proc;
filePtr->clientData = clientData;
|
| ︙ | ︙ | |||
1109 1110 1111 1112 1113 1114 1115 |
}
UNLOCK_NOTIFIER_TSD;
}
/*
*----------------------------------------------------------------------
*
| | | | | < < < < < < < < < | | | < < < < | | | | 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 |
}
UNLOCK_NOTIFIER_TSD;
}
/*
*----------------------------------------------------------------------
*
* TclpDeleteFileHandler --
*
* Cancel a previously-arranged callback arrangement for a file.
*
* Results:
* None.
*
* Side effects:
* If a callback was previously registered on file, remove it.
*
*----------------------------------------------------------------------
*/
void
TclpDeleteFileHandler(
int fd) /* Stream id for which to remove callback
* function. */
{
FileHandler *filePtr, *prevPtr;
int i, numFdBits = -1;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* Find the entry for the given file (and return if there isn't one).
*/
filePtr = LookUpFileHandler(tsdPtr, fd, &prevPtr);
if (filePtr == NULL) {
return;
}
/*
* Find current max fd.
*/
if (fd + 1 == tsdPtr->numFdBits) {
numFdBits = 0;
for (i = fd - 1; i >= 0; i--) {
if (FD_ISSET(i, &tsdPtr->checkMasks.readable)
|| FD_ISSET(i, &tsdPtr->checkMasks.writable)
|| FD_ISSET(i, &tsdPtr->checkMasks.exceptional)) {
numFdBits = i + 1;
break;
}
}
}
LOCK_NOTIFIER_TSD;
if (numFdBits != -1) {
|
| ︙ | ︙ | |||
1246 1247 1248 1249 1250 1251 1252 |
* Search through the file handlers to find the one whose handle matches
* the event. We do this rather than keeping a pointer to the file handler
* directly in the event, so that the handler can be deleted while the
* event is queued without leaving a dangling pointer.
*/
tsdPtr = TCL_TSD_INIT(&dataKey);
| < | | < < < | 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 |
* Search through the file handlers to find the one whose handle matches
* the event. We do this rather than keeping a pointer to the file handler
* directly in the event, so that the handler can be deleted while the
* event is queued without leaving a dangling pointer.
*/
tsdPtr = TCL_TSD_INIT(&dataKey);
filePtr = LookUpFileHandler(tsdPtr, fileEvPtr->fd, NULL);
if (filePtr != NULL) {
/*
* The code is tricky for two reasons:
* 1. The file handler's desired events could have changed since the
* time when the event was queued, so AND the ready mask with the
* desired mask.
* 2. The file could have been closed and re-opened since the time
* when the event was queued. This is why the ready mask is stored
|
| ︙ | ︙ | |||
1280 1281 1282 1283 1284 1285 1286 |
}
if (mask & TCL_EXCEPTION) {
FD_CLR(filePtr->fd, &tsdPtr->readyMasks.exceptional);
}
UNLOCK_NOTIFIER_TSD;
filePtr->proc(filePtr->clientData, mask);
}
| < > > > > > > > > > > > > > > > > > > > > > > > | | < < < | 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 |
}
if (mask & TCL_EXCEPTION) {
FD_CLR(filePtr->fd, &tsdPtr->readyMasks.exceptional);
}
UNLOCK_NOTIFIER_TSD;
filePtr->proc(filePtr->clientData, mask);
}
}
return 1;
}
/*
*----------------------------------------------------------------------
*
* TclpNotifierData --
*
* This function returns a ClientData pointer to be associated
* with a Tcl_AsyncHandler.
*
* Results:
* On MacOSX, returns always NULL.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
ClientData
TclpNotifierData(void)
{
return NULL;
}
/*
*----------------------------------------------------------------------
*
* TclpWaitForEvent --
*
* This function is called by Tcl_DoOneEvent to wait for new events on
* the message queue. If the block time is 0, then Tcl_WaitForEvent just
* polls without blocking.
*
* Results:
* Returns 0 if a tcl event or timeout ocurred and 1 if a non-tcl
* CFRunLoop source was processed.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
TclpWaitForEvent(
const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
{
int result, polling, runLoopRunning;
CFTimeInterval waitTime;
SInt32 runLoopStatus;
ThreadSpecificData *tsdPtr;
result = -1;
polling = 0;
waitTime = CF_TIMEINTERVAL_FOREVER;
tsdPtr = TCL_TSD_INIT(&dataKey);
if (!tsdPtr->runLoop) {
Tcl_Panic("Tcl_WaitForEvent: Notifier not initialized");
|
| ︙ | ︙ | |||
1339 1340 1341 1342 1343 1344 1345 |
/*
* TIP #233 (Virtualized Time). Is virtual time in effect? And do we
* actually have something to scale? If yes to both then we call the
* handler to do this scaling.
*/
if (vTime.sec != 0 || vTime.usec != 0) {
| | < | | | 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 |
/*
* TIP #233 (Virtualized Time). Is virtual time in effect? And do we
* actually have something to scale? If yes to both then we call the
* handler to do this scaling.
*/
if (vTime.sec != 0 || vTime.usec != 0) {
TclScaleTime(&vTime);
waitTime = vTime.sec + 1.0e-6 * vTime.usec;
} else {
/*
* The max block time was set to 0.
*
* If we set the waitTime to 0, then the call to CFRunLoopInMode
* may return without processing all of its sources. The Apple
* documentation says that if the waitTime is 0 "only one pass is
* made through the run loop before returning; if multiple sources
* or timers are ready to fire immediately, only one (possibly two
* if one is a version 0 source) will be fired, regardless of the
* value of returnAfterSourceHandled." This can cause some chanio
* tests to fail. So we use a small positive waitTime unless
* there is another RunLoop running.
*/
polling = 1;
waitTime = tsdPtr->runLoopRunning ? 0 : 0.0001;
}
}
|
| ︙ | ︙ | |||
1427 1428 1429 1430 1431 1432 1433 |
static void
QueueFileEvents(
void *info)
{
SelectMasks readyMasks;
FileHandler *filePtr;
| | | 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 |
static void
QueueFileEvents(
void *info)
{
SelectMasks readyMasks;
FileHandler *filePtr;
ThreadSpecificData *tsdPtr = (ThreadSpecificData *) info;
/*
* Queue all detected file events.
*/
LOCK_NOTIFIER_TSD;
FD_COPY(&tsdPtr->readyMasks.readable, &readyMasks.readable);
|
| ︙ | ︙ | |||
1466 1467 1468 1469 1470 1471 1472 |
/*
* Don't bother to queue an event if the mask was previously non-zero
* since an event must still be on the queue.
*/
if (filePtr->readyMask == 0) {
| | > | | | > | 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 |
/*
* Don't bother to queue an event if the mask was previously non-zero
* since an event must still be on the queue.
*/
if (filePtr->readyMask == 0) {
FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)
ckalloc(sizeof(FileHandlerEvent));
fileEvPtr->header.proc = FileHandlerEventProc;
fileEvPtr->fd = filePtr->fd;
Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
}
filePtr->readyMask = mask;
}
}
/*
*----------------------------------------------------------------------
*
* UpdateWaitingListAndServiceEvents --
*
* CFRunLoopObserver callback for updating waitingList and servicing Tcl
* events.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static void
UpdateWaitingListAndServiceEvents(
TCL_UNUSED(CFRunLoopObserverRef),
CFRunLoopActivity activity,
void *info)
{
ThreadSpecificData *tsdPtr = (ThreadSpecificData *) info;
if (tsdPtr->sleeping) {
return;
}
switch (activity) {
case kCFRunLoopEntry:
tsdPtr->runLoopNestingLevel++;
if (tsdPtr->numFdBits > 0 || tsdPtr->polling) {
|
| ︙ | ︙ | |||
1622 1623 1624 1625 1626 1627 1628 |
/*
* TIP #233: Scale from virtual time to real-time.
*/
vdelay.sec = ms / 1000;
vdelay.usec = (ms % 1000) * 1000;
| < | | 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 |
/*
* TIP #233: Scale from virtual time to real-time.
*/
vdelay.sec = ms / 1000;
vdelay.usec = (ms % 1000) * 1000;
TclScaleTime(&vdelay);
if (tsdPtr->runLoop) {
CFTimeInterval waitTime;
CFRunLoopTimerRef runLoopTimer = tsdPtr->runLoopTimer;
CFAbsoluteTime nextTimerFire = 0, waitEnd, now;
SInt32 runLoopStatus;
|
| ︙ | ︙ | |||
1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 |
}
return result;
}
/*
*----------------------------------------------------------------------
*
* NotifierThreadProc --
*
* This routine is the initial (and only) function executed by the
* special notifier thread. Its job is to wait for file descriptors to
* become readable or writable or to have an exception condition and then
* to notify other threads who are interested in this information by
* signalling a condition variable. Other threads can signal this
* notifier thread of a change in their interests by writing a single
* byte to a special pipe that the notifier thread is monitoring.
*
* Result:
* None. Once started, this routine never exits. It dies with the overall
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | 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 |
}
return result;
}
/*
*----------------------------------------------------------------------
*
* TclAsyncNotifier --
*
* This procedure sets the async mark of an async handler to a
* given value, if it is called from the notifier thread.
*
* Result:
* True, when the handler will be marked, false otherwise.
*
* Side effetcs:
* The trigger pipe is written when called from the notifier
* thread.
*
*----------------------------------------------------------------------
*/
int
TclAsyncNotifier(
int sigNumber, /* Signal number. */
TCL_UNUSED(Tcl_ThreadId), /* Target thread. */
TCL_UNUSED(ClientData), /* Notifier data. */
int *flagPtr, /* Flag to mark. */
int value) /* Value of mark. */
{
#if TCL_THREADS
/*
* WARNING:
* This code most likely runs in a signal handler. Thus,
* only few async-signal-safe system calls are allowed,
* e.g. pthread_self(), sem_post(), write().
*/
if (pthread_equal(pthread_self(), (pthread_t) notifierThread)) {
if (notifierThreadRunning) {
*flagPtr = value;
if (!asyncPending) {
asyncPending = 1;
write(triggerPipe, "S", 1);
}
return 1;
}
return 0;
}
/*
* Re-send the signal to the notifier thread.
*/
pthread_kill((pthread_t) notifierThread, sigNumber);
#endif
return 0;
}
/*
*----------------------------------------------------------------------
*
* NotifierThreadProc --
*
* This routine is the initial (and only) function executed by the
* special notifier thread. Its job is to wait for file descriptors to
* become readable or writable or to have an exception condition and then
* to notify other threads who are interested in this information by
* signalling a condition variable. Other threads can signal this
* notifier thread of a change in their interests by writing a single
* byte to a special pipe that the notifier thread is monitoring.
*
* Result:
* None. Once started, this routine never exits. It dies with the overall
* process or terminates its own thread (on notifier termination).
*
* Side effects:
* The trigger pipe used to signal the notifier thread is created when
* the notifier thread first starts.
*
*----------------------------------------------------------------------
*/
static TCL_NORETURN void
NotifierThreadProc(
TCL_UNUSED(ClientData))
{
ThreadSpecificData *tsdPtr;
fd_set readableMask, writableMask, exceptionalMask;
int i, ret, numFdBits = 0, polling;
struct timeval poll = {0., 0.}, *timePtr;
char buf[2];
/*
* Look for file events and report them to interested threads.
*/
|
| ︙ | ︙ | |||
1917 1918 1919 1920 1921 1922 1923 |
*/
if (receivePipe >= numFdBits) {
numFdBits = receivePipe + 1;
}
FD_SET(receivePipe, &readableMask);
| > > > > > | | > > > > > > > > > > > > | 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 |
*/
if (receivePipe >= numFdBits) {
numFdBits = receivePipe + 1;
}
FD_SET(receivePipe, &readableMask);
/*
* Signals are unblocked only during select().
*/
pthread_sigmask(SIG_SETMASK, ¬ifierSigMask, NULL);
ret = select(numFdBits, &readableMask, &writableMask, &exceptionalMask,
timePtr);
pthread_sigmask(SIG_BLOCK, &allSigMask, NULL);
if (ret == -1) {
/*
* In case a signal was caught during select(),
* perform work on async handlers now.
*/
if (errno == EINTR && asyncPending) {
asyncPending = 0;
TclAsyncMarkFromNotifier();
}
/*
* Try again immediately on an error.
*/
continue;
}
|
| ︙ | ︙ | |||
2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 |
* Someone closed the write end of the pipe or sent us a Quit
* message [Bug: 4139] and then closed the write end of the
* pipe so we need to shut down the notifier thread.
*/
break;
}
}
}
pthread_exit(0);
}
#ifdef HAVE_PTHREAD_ATFORK
/*
| > > > > > | 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 |
* Someone closed the write end of the pipe or sent us a Quit
* message [Bug: 4139] and then closed the write end of the
* pipe so we need to shut down the notifier thread.
*/
break;
}
if (asyncPending) {
asyncPending = 0;
TclAsyncMarkFromNotifier();
}
}
}
pthread_exit(0);
}
#ifdef HAVE_PTHREAD_ATFORK
/*
|
| ︙ | ︙ | |||
2086 2087 2088 2089 2090 2091 2092 |
static void
AtForkChild(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
| | | | | > > | | | > > > | 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 |
static void
AtForkChild(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* If a child process unlocks an os_unfair_lock that was created in its
* parent the child will exit with an illegal instruction error. So we
* reinitialize the lock in the child rather than attempt to unlock it.
*/
#if defined(USE_OS_UNFAIR_LOCK)
notifierInitLock = OS_UNFAIR_LOCK_INIT;
notifierLock = OS_UNFAIR_LOCK_INIT;
tsdPtr->tsdLock = OS_UNFAIR_LOCK_INIT;
#else
UNLOCK_NOTIFIER_TSD;
UNLOCK_NOTIFIER;
UNLOCK_NOTIFIER_INIT;
#endif
asyncPending = 0;
if (tsdPtr->runLoop) {
tsdPtr->runLoop = NULL;
if (!noCFafterFork) {
CFRunLoopSourceInvalidate(tsdPtr->runLoopSource);
CFRelease(tsdPtr->runLoopSource);
if (tsdPtr->runLoopTimer) {
CFRunLoopTimerInvalidate(tsdPtr->runLoopTimer);
|
| ︙ | ︙ | |||
2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 |
* executed in the main thread of the parent, otherwise
* Tcl_AlertNotifier may break in the child.
*/
if (!noCFafterFork) {
Tcl_InitNotifier();
}
}
}
#endif /* HAVE_PTHREAD_ATFORK */
#else /* HAVE_COREFOUNDATION */
void
| > > > > > > | 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 |
* executed in the main thread of the parent, otherwise
* Tcl_AlertNotifier may break in the child.
*/
if (!noCFafterFork) {
Tcl_InitNotifier();
}
/*
* Restart the notifier thread for signal handling.
*/
StartNotifierThread();
}
}
#endif /* HAVE_PTHREAD_ATFORK */
#else /* HAVE_COREFOUNDATION */
void
|
| ︙ | ︙ |
Changes to tests/append.test.
| ︙ | ︙ | |||
11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 |
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
unset -nocomplain x
test append-1.1 {append command} {
unset -nocomplain x
list [append x 1 2 abc "long string"] $x
} {{12abclong string} {12abclong string}}
test append-1.2 {append command} {
set x ""
list [append x first] [append x second] [append x third] $x
| > > > > | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 |
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
unset -nocomplain x
catch [list package require -exact tcl::test [info patchlevel]]
testConstraint testbytestring [llength [info commands testbytestring]]
test append-1.1 {append command} {
unset -nocomplain x
list [append x 1 2 abc "long string"] $x
} {{12abclong string} {12abclong string}}
test append-1.2 {append command} {
set x ""
list [append x first] [append x second] [append x third] $x
|
| ︙ | ︙ | |||
49 50 51 52 53 54 55 56 57 58 59 60 61 62 |
set x ""
append x(0) 44
} -result {can't set "x(0)": variable isn't array}
test append-3.3 {append errors} -returnCodes error -body {
unset -nocomplain x
append x
} -result {can't read "x": no such variable}
test append-4.1 {lappend command} {
unset -nocomplain x
list [lappend x 1 2 abc "long string"] $x
} {{1 2 abc {long string}} {1 2 abc {long string}}}
test append-4.2 {lappend command} {
set x ""
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
set x ""
append x(0) 44
} -result {can't set "x(0)": variable isn't array}
test append-3.3 {append errors} -returnCodes error -body {
unset -nocomplain x
append x
} -result {can't read "x": no such variable}
test append-3.4 {append surrogates} -body {
set x \uD83D
append x \uDE02
} -result \uD83D\uDE02
test append-3.5 {append surrogates} -body {
set x \uD83D
set x $x\uDE02
} -result \uD83D\uDE02
test append-3.6 {append surrogates} -body {
set x \uDE02
set x \uD83D$x
} -result \uD83D\uDE02
test append-3.7 {append \xC0 \x80} -constraints testbytestring -body {
set x [testbytestring \xC0]
string length [append x [testbytestring \x80]]
} -result 2
test append-3.8 {append \xC0 \x80} -constraints testbytestring -body {
set x [testbytestring \xC0]
string length $x[testbytestring \x80]
} -result 2
test append-3.9 {append \xC0 \x80} -constraints testbytestring -body {
set x [testbytestring \x80]
string length [testbytestring \xC0]$x
} -result 2
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} {
unset -nocomplain x
list [lappend x 1 2 abc "long string"] $x
} {{1 2 abc {long string}} {1 2 abc {long string}}}
test append-4.2 {lappend command} {
set x ""
|
| ︙ | ︙ |
Changes to tests/async.test.
| ︙ | ︙ | |||
15 16 17 18 19 20 21 22 |
package require tcltest 2.5
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
testConstraint testasync [llength [info commands testasync]]
| > | | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 |
package require tcltest 2.5
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
testConstraint testasync [llength [info commands testasync]]
testConstraint knownMsvcBug [string match msvc-* [tcl::build-info compiler]]
proc async1 {result code} {
global aresult acode
set aresult $result
set acode $code
return "new result"
}
|
| ︙ | ︙ | |||
145 146 147 148 149 150 151 |
test async-3.1 {deleting handlers} testasync {
set x {}
list [catch {testasync mark $hm2 "foobar" 5} msg] $msg $x
} {3 del2 {0 0 0 del1 del2}}
test async-4.1 {async interrupting bytecode sequence} -constraints {
| | | 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 |
test async-3.1 {deleting handlers} testasync {
set x {}
list [catch {testasync mark $hm2 "foobar" 5} msg] $msg $x
} {3 del2 {0 0 0 del1 del2}}
test async-4.1 {async interrupting bytecode sequence} -constraints {
testasync thread
} -setup {
set hm [testasync create async3]
proc nothing {} {
# empty proc
}
} -body {
apply {{handle} {
|
| ︙ | ︙ | |||
174 175 176 177 178 179 180 |
} -result {test pattern} -cleanup {
# give other threads some time to go way so that valgrind doesn't pick up
# "still reachable" cases from early thread termination
after 100
testasync delete $hm
}
test async-4.2 {async interrupting straight bytecode sequence} -constraints {
| | | 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 |
} -result {test pattern} -cleanup {
# give other threads some time to go way so that valgrind doesn't pick up
# "still reachable" cases from early thread termination
after 100
testasync delete $hm
}
test async-4.2 {async interrupting straight bytecode sequence} -constraints {
testasync thread
} -setup {
set hm [testasync create async3]
} -body {
apply {{handle} {
global aresult
set aresult {Async event not delivered}
testasync marklater $handle
|
| ︙ | ︙ | |||
199 200 201 202 203 204 205 |
} -result {test pattern} -cleanup {
# give other threads some time to go way so that valgrind doesn't pick up
# "still reachable" cases from early thread termination
after 100
testasync delete $hm
}
test async-4.3 {async interrupting loop-less bytecode sequence} -constraints {
| | | 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 |
} -result {test pattern} -cleanup {
# give other threads some time to go way so that valgrind doesn't pick up
# "still reachable" cases from early thread termination
after 100
testasync delete $hm
}
test async-4.3 {async interrupting loop-less bytecode sequence} -constraints {
testasync thread knownMsvcBug
} -setup {
set hm [testasync create async3]
} -body {
apply [list {handle} [concat {
global aresult
set aresult {Async event not delivered}
testasync marklater $handle
|
| ︙ | ︙ |
Changes to tests/binary.test.
| ︙ | ︙ | |||
10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 |
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}]
testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}]
testConstraint testbytestring [llength [info commands testbytestring]]
# Big test for correct ordering of data in [expr]
proc testIEEE {} {
variable ieeeValues
binary scan [binary format dd -1.0 1.0] c* c
switch -exact -- $c {
{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
# little endian
| > > > | | | | | | | | | | | 10 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 |
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}]
testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}]
testConstraint testbytestring [llength [info commands testbytestring]]
# Big test for correct ordering of data in [expr]
proc testIEEE {} {
variable ieeeValues
binary scan [binary format dd -1.0 1.0] c* c
switch -exact -- $c {
{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
# little endian
binary scan \x00\x00\x00\x00\x00\x00\xF0\xFF d \
ieeeValues(-Infinity)
binary scan \x00\x00\x00\x00\x00\x00\xF0\xBF d \
ieeeValues(-Normal)
binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \
ieeeValues(-Subnormal)
binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \
ieeeValues(-0)
binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+0)
binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \
ieeeValues(+Subnormal)
binary scan \x00\x00\x00\x00\x00\x00\xF0\x3F d \
ieeeValues(+Normal)
binary scan \x00\x00\x00\x00\x00\x00\xF0\x7F d \
ieeeValues(+Infinity)
binary scan \x00\x00\x00\x00\x00\x00\xF8\x7F d \
ieeeValues(NaN)
set ieeeValues(littleEndian) 1
return 1
}
{-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} {
binary scan \xFF\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Infinity)
binary scan \xBF\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Normal)
binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Subnormal)
binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-0)
binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+0)
binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Subnormal)
binary scan \x3F\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Normal)
binary scan \x7F\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Infinity)
binary scan \x7F\xF8\x00\x00\x00\x00\x00\x00 d \
ieeeValues(NaN)
set ieeeValues(littleEndian) 0
return 1
}
default {
return 0
}
|
| ︙ | ︙ | |||
156 157 158 159 160 161 162 |
binary format B0 1
} {}
test binary-4.3 {Tcl_BinaryObjCmd: format} {
binary format B 1
} \x80
test binary-4.4 {Tcl_BinaryObjCmd: format} {
binary format B* 010011
| | | | | | 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 |
binary format B0 1
} {}
test binary-4.3 {Tcl_BinaryObjCmd: format} {
binary format B 1
} \x80
test binary-4.4 {Tcl_BinaryObjCmd: format} {
binary format B* 010011
} \x4C
test binary-4.5 {Tcl_BinaryObjCmd: format} {
binary format B8 01001101
} \x4D
test binary-4.6 {Tcl_BinaryObjCmd: format} {
binary format A2X2B9 oo 01001101
} \x4D\x00
test binary-4.7 {Tcl_BinaryObjCmd: format} {
binary format B9 010011011010
} \x4D\x80
test binary-4.8 {Tcl_BinaryObjCmd: format} {
binary format B2B3 10 010
} \x80\x40
test binary-4.9 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
binary format B1B5 1 foo
} -result {expected binary string but got "foo" instead}
|
| ︙ | ︙ | |||
187 188 189 190 191 192 193 |
binary format b 1
} \x01
test binary-5.4 {Tcl_BinaryObjCmd: format} {
binary format b* 010011
} 2
test binary-5.5 {Tcl_BinaryObjCmd: format} {
binary format b8 01001101
| | | | | | | | | | | 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 |
binary format b 1
} \x01
test binary-5.4 {Tcl_BinaryObjCmd: format} {
binary format b* 010011
} 2
test binary-5.5 {Tcl_BinaryObjCmd: format} {
binary format b8 01001101
} \xB2
test binary-5.6 {Tcl_BinaryObjCmd: format} {
binary format A2X2b9 oo 01001101
} \xB2\x00
test binary-5.7 {Tcl_BinaryObjCmd: format} {
binary format b9 010011011010
} \xB2\x01
test binary-5.8 {Tcl_BinaryObjCmd: format} {
binary format b17 1
} \x01\x00\x00
test binary-5.9 {Tcl_BinaryObjCmd: format} {
binary format b2b3 10 010
} \x01\x02
test binary-5.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
binary format b1b5 1 foo
} -result {expected binary string but got "foo" instead}
test binary-6.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
binary format h
} -result {not enough arguments for all format specifiers}
test binary-6.2 {Tcl_BinaryObjCmd: format} {
binary format h0 1
} {}
test binary-6.3 {Tcl_BinaryObjCmd: format} {
binary format h 1
} \x01
test binary-6.4 {Tcl_BinaryObjCmd: format} {
binary format h c
} \x0C
test binary-6.5 {Tcl_BinaryObjCmd: format} {
binary format h* baadf00d
} \xAB\xDA\x0F\xD0
test binary-6.6 {Tcl_BinaryObjCmd: format} {
binary format h4 c410
} \x4C\x01
test binary-6.7 {Tcl_BinaryObjCmd: format} {
binary format h6 c4102
} \x4C\x01\x02
test binary-6.8 {Tcl_BinaryObjCmd: format} {
binary format h5 c41020304
} \x4C\x01\x02
test binary-6.9 {Tcl_BinaryObjCmd: format} {
binary format a3X3h5 foo 2
} \x02\x00\x00
test binary-6.10 {Tcl_BinaryObjCmd: format} {
binary format h2h3 23 456
} \x32\x54\x06
test binary-6.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
|
| ︙ | ︙ | |||
249 250 251 252 253 254 255 |
binary format H0 1
} {}
test binary-7.3 {Tcl_BinaryObjCmd: format} {
binary format H 1
} \x10
test binary-7.4 {Tcl_BinaryObjCmd: format} {
binary format H c
| | | | | | | 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 |
binary format H0 1
} {}
test binary-7.3 {Tcl_BinaryObjCmd: format} {
binary format H 1
} \x10
test binary-7.4 {Tcl_BinaryObjCmd: format} {
binary format H c
} \xC0
test binary-7.5 {Tcl_BinaryObjCmd: format} {
binary format H* baadf00d
} \xBA\xAD\xF0\x0D
test binary-7.6 {Tcl_BinaryObjCmd: format} {
binary format H4 c410
} \xC4\x10
test binary-7.7 {Tcl_BinaryObjCmd: format} {
binary format H6 c4102
} \xC4\x10\x20
test binary-7.8 {Tcl_BinaryObjCmd: format} {
binary format H5 c41023304
} \xC4\x10\x20
test binary-7.9 {Tcl_BinaryObjCmd: format} {
binary format a3X3H5 foo 2
} \x20\x00\x00
test binary-7.10 {Tcl_BinaryObjCmd: format} {
binary format H2H3 23 456
} \x23\x45\x60
test binary-7.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
|
| ︙ | ︙ | |||
481 482 483 484 485 486 487 |
binary format f blat
} -result {expected floating-point number but got "blat"}
test binary-13.3 {Tcl_BinaryObjCmd: format} {
binary format f0 1.6
} {}
test binary-13.4 {Tcl_BinaryObjCmd: format} bigEndian {
binary format f 1.6
| | | | | | | | | | | | | | | | | | | | | | | | 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 |
binary format f blat
} -result {expected floating-point number but got "blat"}
test binary-13.3 {Tcl_BinaryObjCmd: format} {
binary format f0 1.6
} {}
test binary-13.4 {Tcl_BinaryObjCmd: format} bigEndian {
binary format f 1.6
} \x3F\xCC\xCC\xCD
test binary-13.5 {Tcl_BinaryObjCmd: format} littleEndian {
binary format f 1.6
} \xCD\xCC\xCC\x3F
test binary-13.6 {Tcl_BinaryObjCmd: format} bigEndian {
binary format f* {1.6 3.4}
} \x3F\xCC\xCC\xCD\x40\x59\x99\x9A
test binary-13.7 {Tcl_BinaryObjCmd: format} littleEndian {
binary format f* {1.6 3.4}
} \xCD\xCC\xCC\x3F\x9A\x99\x59\x40
test binary-13.8 {Tcl_BinaryObjCmd: format} bigEndian {
binary format f2 {1.6 3.4}
} \x3F\xCC\xCC\xCD\x40\x59\x99\x9A
test binary-13.9 {Tcl_BinaryObjCmd: format} littleEndian {
binary format f2 {1.6 3.4}
} \xCD\xCC\xCC\x3F\x9A\x99\x59\x40
test binary-13.10 {Tcl_BinaryObjCmd: format} bigEndian {
binary format f2 {1.6 3.4 5.6}
} \x3F\xCC\xCC\xCD\x40\x59\x99\x9A
test binary-13.11 {Tcl_BinaryObjCmd: format} littleEndian {
binary format f2 {1.6 3.4 5.6}
} \xCD\xCC\xCC\x3F\x9A\x99\x59\x40
test binary-13.12 {Tcl_BinaryObjCmd: float overflow} bigEndian {
binary format f -3.402825e+38
} \xFF\x7F\xFF\xFF
test binary-13.13 {Tcl_BinaryObjCmd: float overflow} littleEndian {
binary format f -3.402825e+38
} \xFF\xFF\x7F\xFF
test binary-13.14 {Tcl_BinaryObjCmd: float underflow} bigEndian {
binary format f -3.402825e-100
} \x80\x00\x00\x00
test binary-13.15 {Tcl_BinaryObjCmd: float underflow} littleEndian {
binary format f -3.402825e-100
} \x00\x00\x00\x80
test binary-13.16 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
binary format f2 {1.6}
} -result {number of elements in list does not match count}
test binary-13.17 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {1.6 3.4}
binary format f $a
} -result "expected floating-point number but got \"1.6 3.4\""
test binary-13.18 {Tcl_BinaryObjCmd: format} bigEndian {
set a {1.6 3.4}
binary format f1 $a
} \x3F\xCC\xCC\xCD
test binary-13.19 {Tcl_BinaryObjCmd: format} littleEndian {
set a {1.6 3.4}
binary format f1 $a
} \xCD\xCC\xCC\x3F
test binary-14.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
binary format d
} -result {not enough arguments for all format specifiers}
test binary-14.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
binary format d blat
} -result {expected floating-point number but got "blat"}
test binary-14.3 {Tcl_BinaryObjCmd: format} {
binary format d0 1.6
} {}
test binary-14.4 {Tcl_BinaryObjCmd: format} bigEndian {
binary format d 1.6
} \x3F\xF9\x99\x99\x99\x99\x99\x9A
test binary-14.5 {Tcl_BinaryObjCmd: format} littleEndian {
binary format d 1.6
} \x9A\x99\x99\x99\x99\x99\xF9\x3F
test binary-14.6 {Tcl_BinaryObjCmd: format} bigEndian {
binary format d* {1.6 3.4}
} \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33
test binary-14.7 {Tcl_BinaryObjCmd: format} littleEndian {
binary format d* {1.6 3.4}
} \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40
test binary-14.8 {Tcl_BinaryObjCmd: format} bigEndian {
binary format d2 {1.6 3.4}
} \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33
test binary-14.9 {Tcl_BinaryObjCmd: format} littleEndian {
binary format d2 {1.6 3.4}
} \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40
test binary-14.10 {Tcl_BinaryObjCmd: format} bigEndian {
binary format d2 {1.6 3.4 5.6}
} \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33
test binary-14.11 {Tcl_BinaryObjCmd: format} littleEndian {
binary format d2 {1.6 3.4 5.6}
} \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40
test binary-14.14 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
binary format d2 {1.6}
} -result {number of elements in list does not match count}
test binary-14.15 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {1.6 3.4}
binary format d $a
} -result "expected floating-point number but got \"1.6 3.4\""
test binary-14.16 {Tcl_BinaryObjCmd: format} bigEndian {
set a {1.6 3.4}
binary format d1 $a
} \x3F\xF9\x99\x99\x99\x99\x99\x9A
test binary-14.17 {Tcl_BinaryObjCmd: format} littleEndian {
set a {1.6 3.4}
binary format d1 $a
} \x9A\x99\x99\x99\x99\x99\xF9\x3F
test binary-14.18 {FormatNumber: Bug 1116542} {
binary scan [binary format d 1.25] d w
set w
} 1.25
test binary-15.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
binary format ax*a "y" "z"
|
| ︙ | ︙ | |||
870 871 872 873 874 875 876 |
} -result {2 01110 1000011100000101}
test binary-24.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
binary scan abc h
} -result {not enough arguments for all format specifiers}
test binary-24.2 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
| | | | | 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 |
} -result {2 01110 1000011100000101}
test binary-24.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
binary scan abc h
} -result {not enough arguments for all format specifiers}
test binary-24.2 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3 h* arg1] $arg1
} {1 253a}
test binary-24.3 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \xC2\xA3 h arg1] $arg1
} {1 2}
test binary-24.4 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x82\x53 h1 arg1] $arg1
} {1 2}
test binary-24.5 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\x53 h0 arg1] $arg1
} {1 {}}
test binary-24.6 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \xF2\x53 h2 arg1] $arg1
} {1 2f}
test binary-24.7 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\x53 h3 arg1] $arg1
} {1 253}
test binary-24.8 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
|
| ︙ | ︙ | |||
916 917 918 919 920 921 922 |
} -result {2 07 7850}
test binary-25.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
binary scan abc H
} -result {not enough arguments for all format specifiers}
test binary-25.2 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
| | | | | 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 |
} -result {2 07 7850}
test binary-25.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
binary scan abc H
} -result {not enough arguments for all format specifiers}
test binary-25.2 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3 H* arg1] $arg1
} {1 52a3}
test binary-25.3 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \xC2\xA3 H arg1] $arg1
} {1 c}
test binary-25.4 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x82\x53 H1 arg1] $arg1
} {1 8}
test binary-25.5 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\x53 H0 arg1] $arg1
} {1 {}}
test binary-25.6 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \xF2\x53 H2 arg1] $arg1
} {1 f2}
test binary-25.7 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\x53 H3 arg1] $arg1
} {1 525}
test binary-25.8 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
|
| ︙ | ︙ | |||
961 962 963 964 965 966 967 |
} {2 70 8705}
test binary-26.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
binary scan abc c
} -result {not enough arguments for all format specifiers}
test binary-26.2 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 |
} {2 70 8705}
test binary-26.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
binary scan abc c
} -result {not enough arguments for all format specifiers}
test binary-26.2 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3 c* arg1] $arg1
} {1 {82 -93}}
test binary-26.3 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3 c arg1] $arg1
} {1 82}
test binary-26.4 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3 c1 arg1] $arg1
} {1 82}
test binary-26.5 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3 c0 arg1] $arg1
} {1 {}}
test binary-26.6 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3 c2 arg1] $arg1
} {1 {82 -93}}
test binary-26.7 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \xFF c arg1] $arg1
} {1 -1}
test binary-26.8 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 c3 arg1] $arg1
} {0 foo}
test binary-26.9 {Tcl_BinaryObjCmd: scan} -setup {
unset -nocomplain arg1
} -returnCodes error -body {
set arg1 1
binary scan \x52\x53 c1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-26.10 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x70\x87\x05 c2c* arg1 arg2] $arg1 $arg2
} {2 {112 -121} 5}
test binary-26.11 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3 cu* arg1] $arg1
} {1 {82 163}}
test binary-26.12 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3 cu arg1] $arg1
} {1 82}
test binary-26.13 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \xFF cu arg1] $arg1
} {1 255}
test binary-26.14 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x80\x80 cuc arg1 arg2] $arg1 $arg2
} {2 128 -128}
test binary-26.15 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x80\x80 ccu arg1 arg2] $arg1 $arg2
} {2 -128 128}
test binary-27.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
binary scan abc s
} -result {not enough arguments for all format specifiers}
test binary-27.2 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54 s* arg1] $arg1
} {1 {-23726 21587}}
test binary-27.3 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54 s arg1] $arg1
} {1 -23726}
test binary-27.4 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3 s1 arg1] $arg1
} {1 -23726}
test binary-27.5 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3 s0 arg1] $arg1
} {1 {}}
test binary-27.6 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54 s2 arg1] $arg1
} {1 {-23726 21587}}
test binary-27.7 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 s1 arg1] $arg1
} {0 foo}
test binary-27.8 {Tcl_BinaryObjCmd: scan} -setup {
unset -nocomplain arg1
} -returnCodes error -body {
set arg1 1
binary scan \x52\x53 s1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-27.9 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x52\xA3\x53\x54\x05 s2c* arg1 arg2] $arg1 $arg2
} {2 {-23726 21587} 5}
test binary-27.10 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54 su* arg1] $arg1
} {1 {41810 21587}}
test binary-27.11 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \xFF\xFF\xFF\xFF sus arg1 arg2] $arg1 $arg2
} {2 65535 -1}
test binary-27.12 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \xFF\xFF\xFF\xFF ssu arg1 arg2] $arg1 $arg2
} {2 -1 65535}
test binary-28.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
binary scan abc S
} -result {not enough arguments for all format specifiers}
test binary-28.2 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54 S* arg1] $arg1
} {1 {21155 21332}}
test binary-28.3 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54 S arg1] $arg1
} {1 21155}
test binary-28.4 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3 S1 arg1] $arg1
} {1 21155}
test binary-28.5 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3 S0 arg1] $arg1
} {1 {}}
test binary-28.6 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54 S2 arg1] $arg1
} {1 {21155 21332}}
test binary-28.7 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 S1 arg1] $arg1
} {0 foo}
test binary-28.8 {Tcl_BinaryObjCmd: scan} -setup {
unset -nocomplain arg1
} -returnCodes error -body {
set arg1 1
binary scan \x52\x53 S1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-28.9 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x52\xA3\x53\x54\x05 S2c* arg1 arg2] $arg1 $arg2
} {2 {21155 21332} 5}
test binary-28.10 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54 Su* arg1] $arg1
} {1 {21155 21332}}
test binary-28.11 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \xA3\x52\x54\x53 Su* arg1] $arg1
} {1 {41810 21587}}
test binary-29.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
binary scan abc i
} -result {not enough arguments for all format specifiers}
test binary-29.2 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04 i* arg1] $arg1
} {1 {1414767442 67305985}}
test binary-29.3 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04 i arg1] $arg1
} {1 1414767442}
test binary-29.4 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54 i1 arg1] $arg1
} {1 1414767442}
test binary-29.5 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53 i0 arg1] $arg1
} {1 {}}
test binary-29.6 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04 i2 arg1] $arg1
} {1 {1414767442 67305985}}
test binary-29.7 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 i1 arg1] $arg1
} {0 foo}
test binary-29.8 {Tcl_BinaryObjCmd: scan} -setup {
unset -nocomplain arg1
} -returnCodes error -body {
set arg1 1
binary scan \x52\x53\x53\x54 i1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-29.9 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04\x05 i2c* arg1 arg2] $arg1 $arg2
} {2 {1414767442 67305985} 5}
test binary-29.10 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1 arg2
list [binary scan \xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF iui arg1 arg2] $arg1 $arg2
} {2 4294967295 -1}
test binary-29.11 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1 arg2
list [binary scan \xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF iiu arg1 arg2] $arg1 $arg2
} {2 -1 4294967295}
test binary-29.12 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1 arg2
list [binary scan \x80\x00\x00\x00\x00\x00\x00\x80 iuiu arg1 arg2] $arg1 $arg2
} {2 128 2147483648}
test binary-30.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
binary scan abc I
} -result {not enough arguments for all format specifiers}
test binary-30.2 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04 I* arg1] $arg1
} {1 {1386435412 16909060}}
test binary-30.3 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04 I arg1] $arg1
} {1 1386435412}
test binary-30.4 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54 I1 arg1] $arg1
} {1 1386435412}
test binary-30.5 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53 I0 arg1] $arg1
} {1 {}}
test binary-30.6 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04 I2 arg1] $arg1
} {1 {1386435412 16909060}}
test binary-30.7 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 I1 arg1] $arg1
} {0 foo}
test binary-30.8 {Tcl_BinaryObjCmd: scan} -setup {
unset -nocomplain arg1
} -returnCodes error -body {
set arg1 1
binary scan \x52\x53\x53\x54 I1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-30.9 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04\x05 I2c* arg1 arg2] $arg1 $arg2
} {2 {1386435412 16909060} 5}
test binary-30.10 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1 arg2
list [binary scan \xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF IuI arg1 arg2] $arg1 $arg2
} {2 4294967295 -1}
test binary-30.11 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1 arg2
list [binary scan \xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF IIu arg1 arg2] $arg1 $arg2
} {2 -1 4294967295}
test binary-30.12 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1 arg2
list [binary scan \x80\x00\x00\x00\x00\x00\x00\x80 IuIu arg1 arg2] $arg1 $arg2
} {2 2147483648 128}
test binary-31.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
binary scan abc f
} -result {not enough arguments for all format specifiers}
test binary-31.2 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x3F\xCC\xCC\xCD\x40\x59\x99\x9A f* arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-31.3 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \xCD\xCC\xCC\x3F\x9A\x99\x59\x40 f* arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-31.4 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x3F\xCC\xCC\xCD\x40\x59\x99\x9A f arg1] $arg1
} {1 1.600000023841858}
test binary-31.5 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \xCD\xCC\xCC\x3F\x9A\x99\x59\x40 f arg1] $arg1
} {1 1.600000023841858}
test binary-31.6 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x3F\xCC\xCC\xCD f1 arg1] $arg1
} {1 1.600000023841858}
test binary-31.7 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \xCD\xCC\xCC\x3F f1 arg1] $arg1
} {1 1.600000023841858}
test binary-31.8 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x3F\xCC\xCC\xCD f0 arg1] $arg1
} {1 {}}
test binary-31.9 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \xCD\xCC\xCC\x3F f0 arg1] $arg1
} {1 {}}
test binary-31.10 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x3F\xCC\xCC\xCD\x40\x59\x99\x9A f2 arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-31.11 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \xCD\xCC\xCC\x3F\x9A\x99\x59\x40 f2 arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-31.12 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 f1 arg1] $arg1
} {0 foo}
test binary-31.13 {Tcl_BinaryObjCmd: scan} -setup {
unset -nocomplain arg1
} -returnCodes error -body {
set arg1 1
binary scan \x3F\xCC\xCC\xCD f1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-31.14 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x3F\xCC\xCC\xCD\x40\x59\x99\x9A\x05 f2c* arg1 arg2] $arg1 $arg2
} {2 {1.600000023841858 3.4000000953674316} 5}
test binary-31.15 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \xCD\xCC\xCC\x3F\x9A\x99\x59\x40\x05 f2c* arg1 arg2] $arg1 $arg2
} {2 {1.600000023841858 3.4000000953674316} 5}
test binary-32.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
binary scan abc d
} -result {not enough arguments for all format specifiers}
test binary-32.2 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33 d* arg1] $arg1
} {1 {1.6 3.4}}
test binary-32.3 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40 d* arg1] $arg1
} {1 {1.6 3.4}}
test binary-32.4 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33 d arg1] $arg1
} {1 1.6}
test binary-32.5 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40 d arg1] $arg1
} {1 1.6}
test binary-32.6 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A d1 arg1] $arg1
} {1 1.6}
test binary-32.7 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \x9A\x99\x99\x99\x99\x99\xF9\x3F d1 arg1] $arg1
} {1 1.6}
test binary-32.8 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A d0 arg1] $arg1
} {1 {}}
test binary-32.9 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \x9A\x99\x99\x99\x99\x99\xF9\x3F d0 arg1] $arg1
} {1 {}}
test binary-32.10 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33 d2 arg1] $arg1
} {1 {1.6 3.4}}
test binary-32.11 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40 d2 arg1] $arg1
} {1 {1.6 3.4}}
test binary-32.12 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 d1 arg1] $arg1
} {0 foo}
test binary-32.13 {Tcl_BinaryObjCmd: scan} -setup {
unset -nocomplain arg1
} -returnCodes error -body {
set arg1 1
binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A d1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-32.14 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33\x05 d2c* arg1 arg2] $arg1 $arg2
} {2 {1.6 3.4} 5}
test binary-32.15 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40\x05 d2c* arg1 arg2] $arg1 $arg2
} {2 {1.6 3.4} 5}
test binary-33.1 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
unset -nocomplain arg2
list [binary scan abcdefg a2xa3 arg1 arg2] $arg1 $arg2
} {2 ab def}
|
| ︙ | ︙ | |||
1539 1540 1541 1542 1543 1544 1545 |
set x [binary format c1i1 1 1]
} \x01\x01\x00\x00\x00
test binary-38.4 {FormatNumber: word alignment} {
set x [binary format c1I1 1 1]
} \x01\x00\x00\x00\x01
test binary-38.5 {FormatNumber: word alignment} bigEndian {
set x [binary format c1d1 1 1.6]
| | | | | | | | | | 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 |
set x [binary format c1i1 1 1]
} \x01\x01\x00\x00\x00
test binary-38.4 {FormatNumber: word alignment} {
set x [binary format c1I1 1 1]
} \x01\x00\x00\x00\x01
test binary-38.5 {FormatNumber: word alignment} bigEndian {
set x [binary format c1d1 1 1.6]
} \x01\x3F\xF9\x99\x99\x99\x99\x99\x9A
test binary-38.6 {FormatNumber: word alignment} littleEndian {
set x [binary format c1d1 1 1.6]
} \x01\x9A\x99\x99\x99\x99\x99\xF9\x3F
test binary-38.7 {FormatNumber: word alignment} bigEndian {
set x [binary format c1f1 1 1.6]
} \x01\x3F\xCC\xCC\xCD
test binary-38.8 {FormatNumber: word alignment} littleEndian {
set x [binary format c1f1 1 1.6]
} \x01\xCD\xCC\xCC\x3F
test binary-39.1 {ScanNumber: sign extension} {
unset -nocomplain arg1
list [binary scan \x52\xA3 c2 arg1] $arg1
} {1 {82 -93}}
test binary-39.2 {ScanNumber: sign extension} {
unset -nocomplain arg1
list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 s4 arg1] $arg1
} {1 {513 -32511 386 -32127}}
test binary-39.3 {ScanNumber: sign extension} {
unset -nocomplain arg1
list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 S4 arg1] $arg1
} {1 {258 385 -32255 -32382}}
test binary-39.4 {ScanNumber: sign extension} {
unset -nocomplain arg1
list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 i5 arg1] $arg1
} {1 {33620225 16843137 16876033 25297153 -2130640639}}
test binary-39.5 {ScanNumber: sign extension} {
unset -nocomplain arg1
list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 I5 arg1] $arg1
} {1 {16843010 -2130640639 25297153 16876033 16843137}}
test binary-39.6 {ScanNumber: no sign extension} {
unset -nocomplain arg1
list [binary scan \x52\xA3 cu2 arg1] $arg1
} {1 {82 163}}
test binary-39.7 {ScanNumber: no sign extension} {
unset -nocomplain arg1
list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 su4 arg1] $arg1
} {1 {513 33025 386 33409}}
test binary-39.8 {ScanNumber: no sign extension} {
unset -nocomplain arg1
list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 Su4 arg1] $arg1
} {1 {258 385 33281 33154}}
test binary-39.9 {ScanNumber: no sign extension} {
unset -nocomplain arg1
list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 iu5 arg1] $arg1
} {1 {33620225 16843137 16876033 25297153 2164326657}}
test binary-39.10 {ScanNumber: no sign extension} {
unset -nocomplain arg1
list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 Iu5 arg1] $arg1
} {1 {16843010 2164326657 25297153 16876033 16843137}}
test binary-40.3 {ScanNumber: NaN} -body {
unset -nocomplain arg1
list [binary scan \xFF\xFF\xFF\xFF f1 arg1] $arg1
} -match glob -result {1 -NaN*}
test binary-40.4 {ScanNumber: NaN} -body {
unset -nocomplain arg1
list [binary scan \xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF d arg1] $arg1
} -match glob -result {1 -NaN*}
test binary-41.1 {ScanNumber: word alignment} -setup {
unset -nocomplain arg1 arg2
} -body {
list [binary scan \x01\x01\x00 c1s1 arg1 arg2] $arg1 $arg2
} -result {2 1 1}
|
| ︙ | ︙ | |||
1623 1624 1625 1626 1627 1628 1629 |
unset -nocomplain arg1 arg2
} -body {
list [binary scan \x01\x00\x00\x00\x01 c1I1 arg1 arg2] $arg1 $arg2
} -result {2 1 1}
test binary-41.5 {ScanNumber: word alignment} -setup {
unset -nocomplain arg1 arg2
} -constraints bigEndian -body {
| | | | | | 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 |
unset -nocomplain arg1 arg2
} -body {
list [binary scan \x01\x00\x00\x00\x01 c1I1 arg1 arg2] $arg1 $arg2
} -result {2 1 1}
test binary-41.5 {ScanNumber: word alignment} -setup {
unset -nocomplain arg1 arg2
} -constraints bigEndian -body {
list [binary scan \x01\x3F\xCC\xCC\xCD c1f1 arg1 arg2] $arg1 $arg2
} -result {2 1 1.600000023841858}
test binary-41.6 {ScanNumber: word alignment} -setup {
unset -nocomplain arg1 arg2
} -constraints littleEndian -body {
list [binary scan \x01\xCD\xCC\xCC\x3F c1f1 arg1 arg2] $arg1 $arg2
} -result {2 1 1.600000023841858}
test binary-41.7 {ScanNumber: word alignment} -setup {
unset -nocomplain arg1 arg2
} -constraints bigEndian -body {
list [binary scan \x01\x3F\xF9\x99\x99\x99\x99\x99\x9A c1d1 arg1 arg2] $arg1 $arg2
} -result {2 1 1.6}
test binary-41.8 {ScanNumber: word alignment} -setup {
unset -nocomplain arg1 arg2
} -constraints littleEndian -body {
list [binary scan \x01\x9A\x99\x99\x99\x99\x99\xF9\x3F c1d1 arg1 arg2] $arg1 $arg2
} -result {2 1 1.6}
test binary-42.1 {Tcl_BinaryObjCmd: bad arguments} -constraints {} -body {
binary ?
} -returnCodes error -match glob -result {unknown or ambiguous subcommand "?": *}
# Wide int (guaranteed at least 64-bit) handling
|
| ︙ | ︙ | |||
1709 1710 1711 1712 1713 1714 1715 |
} {66 64 -1 -1 -1 -1 -1 -1 -1 -1 65 76}
test binary-45.2 {Tcl_BinaryObjCmd: combined wide int handling} {
binary scan [binary format sWs 16450 0x7fffffff 19521] c* x
set x
} {66 64 0 0 0 0 127 -1 -1 -1 65 76}
test binary-46.1 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} {
| | | | | | | | | | | 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 |
} {66 64 -1 -1 -1 -1 -1 -1 -1 -1 65 76}
test binary-45.2 {Tcl_BinaryObjCmd: combined wide int handling} {
binary scan [binary format sWs 16450 0x7fffffff 19521] c* x
set x
} {66 64 0 0 0 0 127 -1 -1 -1 65 76}
test binary-46.1 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} {
binary format a* €
} \xAC
test binary-46.2 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} {
list [binary scan [binary format a* €₽] s x] $x
} {1 -16980}
test binary-46.3 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} {
set x {}
set y {}
set z {}
list [binary scan [binary format a* €₽] aaa x y z] $x $y $z
} "2 \xAC \xBD {}"
test binary-46.4 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} {
set x [encoding convertto iso8859-15 €]
set y [binary format a* $x]
list $x $y
} "\xA4 \xA4"
test binary-46.5 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} {
set x [binary scan \xA4 a* y]
list $x $y [encoding convertfrom iso8859-15 $y]
} "1 \xA4 €"
test binary-47.1 {Tcl_BinaryObjCmd: number cache reference count handling} {
# This test is only reliable when memory debugging is turned on, but
# without even memory debugging it should still generate the expected
# answers and might therefore still pick up memory corruption caused by
# [Bug 851747].
list [binary scan aba ccc x x x] $x
|
| ︙ | ︙ | |||
1894 1895 1896 1897 1898 1899 1900 |
binary format q blat
} -result {expected floating-point number but got "blat"}
test binary-51.3 {Tcl_BinaryObjCmd: format} {
binary format q0 1.6
} {}
test binary-51.4 {Tcl_BinaryObjCmd: format} {} {
binary format Q 1.6
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 |
binary format q blat
} -result {expected floating-point number but got "blat"}
test binary-51.3 {Tcl_BinaryObjCmd: format} {
binary format q0 1.6
} {}
test binary-51.4 {Tcl_BinaryObjCmd: format} {} {
binary format Q 1.6
} \x3F\xF9\x99\x99\x99\x99\x99\x9A
test binary-51.5 {Tcl_BinaryObjCmd: format} {} {
binary format q 1.6
} \x9A\x99\x99\x99\x99\x99\xF9\x3F
test binary-51.6 {Tcl_BinaryObjCmd: format} {} {
binary format Q* {1.6 3.4}
} \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33
test binary-51.7 {Tcl_BinaryObjCmd: format} {} {
binary format q* {1.6 3.4}
} \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40
test binary-51.8 {Tcl_BinaryObjCmd: format} {} {
binary format Q2 {1.6 3.4}
} \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33
test binary-51.9 {Tcl_BinaryObjCmd: format} {} {
binary format q2 {1.6 3.4}
} \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40
test binary-51.10 {Tcl_BinaryObjCmd: format} {} {
binary format Q2 {1.6 3.4 5.6}
} \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33
test binary-51.11 {Tcl_BinaryObjCmd: format} {} {
binary format q2 {1.6 3.4 5.6}
} \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40
test binary-51.14 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
binary format q2 {1.6}
} -result {number of elements in list does not match count}
test binary-51.15 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {1.6 3.4}
binary format q $a
} -result "expected floating-point number but got \"1.6 3.4\""
test binary-51.16 {Tcl_BinaryObjCmd: format} {} {
set a {1.6 3.4}
binary format Q1 $a
} \x3F\xF9\x99\x99\x99\x99\x99\x9A
test binary-51.17 {Tcl_BinaryObjCmd: format} {} {
set a {1.6 3.4}
binary format q1 $a
} \x9A\x99\x99\x99\x99\x99\xF9\x3F
# format R/r
test binary-53.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
binary format r
} -result {not enough arguments for all format specifiers}
test binary-53.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
binary format r blat
} -result {expected floating-point number but got "blat"}
test binary-53.3 {Tcl_BinaryObjCmd: format} {
binary format f0 1.6
} {}
test binary-53.4 {Tcl_BinaryObjCmd: format} {} {
binary format R 1.6
} \x3F\xCC\xCC\xCD
test binary-53.5 {Tcl_BinaryObjCmd: format} {} {
binary format r 1.6
} \xCD\xCC\xCC\x3F
test binary-53.6 {Tcl_BinaryObjCmd: format} {} {
binary format R* {1.6 3.4}
} \x3F\xCC\xCC\xCD\x40\x59\x99\x9A
test binary-53.7 {Tcl_BinaryObjCmd: format} {} {
binary format r* {1.6 3.4}
} \xCD\xCC\xCC\x3F\x9A\x99\x59\x40
test binary-53.8 {Tcl_BinaryObjCmd: format} {} {
binary format R2 {1.6 3.4}
} \x3F\xCC\xCC\xCD\x40\x59\x99\x9A
test binary-53.9 {Tcl_BinaryObjCmd: format} {} {
binary format r2 {1.6 3.4}
} \xCD\xCC\xCC\x3F\x9A\x99\x59\x40
test binary-53.10 {Tcl_BinaryObjCmd: format} {} {
binary format R2 {1.6 3.4 5.6}
} \x3F\xCC\xCC\xCD\x40\x59\x99\x9A
test binary-53.11 {Tcl_BinaryObjCmd: format} {} {
binary format r2 {1.6 3.4 5.6}
} \xCD\xCC\xCC\x3F\x9A\x99\x59\x40
test binary-53.12 {Tcl_BinaryObjCmd: float overflow} {} {
binary format R -3.402825e+38
} \xFF\x7F\xFF\xFF
test binary-53.13 {Tcl_BinaryObjCmd: float overflow} {} {
binary format r -3.402825e+38
} \xFF\xFF\x7F\xFF
test binary-53.14 {Tcl_BinaryObjCmd: float underflow} {} {
binary format R -3.402825e-100
} \x80\x00\x00\x00
test binary-53.15 {Tcl_BinaryObjCmd: float underflow} {} {
binary format r -3.402825e-100
} \x00\x00\x00\x80
test binary-53.16 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
binary format r2 {1.6}
} -result {number of elements in list does not match count}
test binary-53.17 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {1.6 3.4}
binary format r $a
} -result "expected floating-point number but got \"1.6 3.4\""
test binary-53.18 {Tcl_BinaryObjCmd: format} {} {
set a {1.6 3.4}
binary format R1 $a
} \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
# scan t (s)
test binary-54.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
binary scan abc t
} -result {not enough arguments for all format specifiers}
test binary-54.2 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54 t* arg1] $arg1
} {1 {-23726 21587}}
test binary-54.3 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54 t arg1] $arg1
} {1 -23726}
test binary-54.4 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \x52\xA3 t1 arg1] $arg1
} {1 -23726}
test binary-54.5 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \x52\xA3 t0 arg1] $arg1
} {1 {}}
test binary-54.6 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54 t2 arg1] $arg1
} {1 {-23726 21587}}
test binary-54.7 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 t1 arg1] $arg1
} {0 foo}
test binary-54.8 {Tcl_BinaryObjCmd: scan} -setup {
unset -nocomplain arg1
} -returnCodes error -body {
set arg1 1
binary scan \x52\x53 t1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-54.9 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x52\xA3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2
} {2 {-23726 21587} 5}
test binary-54.10 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x00\x80\x00\x80 tut arg1 arg2] $arg1 $arg2
} {2 32768 -32768}
test binary-54.11 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x00\x80\x00\x80 ttu arg1 arg2] $arg1 $arg2
} {2 -32768 32768}
# scan t (b)
test binary-55.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
binary scan abc t
} -result {not enough arguments for all format specifiers}
test binary-55.2 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54 t* arg1] $arg1
} {1 {21155 21332}}
test binary-55.3 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54 t arg1] $arg1
} {1 21155}
test binary-55.4 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x52\xA3 t1 arg1] $arg1
} {1 21155}
test binary-55.5 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x52\xA3 t0 arg1] $arg1
} {1 {}}
test binary-55.6 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54 t2 arg1] $arg1
} {1 {21155 21332}}
test binary-55.7 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 t1 arg1] $arg1
} {0 foo}
test binary-55.8 {Tcl_BinaryObjCmd: scan} -setup {
unset -nocomplain arg1
} -returnCodes error -body {
set arg1 1
binary scan \x52\x53 t1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-55.9 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x52\xA3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2
} {2 {21155 21332} 5}
test binary-55.10 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x80\x00\x80\x00 tut arg1 arg2] $arg1 $arg2
} {2 32768 -32768}
test binary-55.11 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x80\x00\x80\x00 ttu arg1 arg2] $arg1 $arg2
} {2 -32768 32768}
# scan n (s)
test binary-56.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
binary scan abc n
} -result {not enough arguments for all format specifiers}
test binary-56.2 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04 n* arg1] $arg1
} {1 {1414767442 67305985}}
test binary-56.3 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04 n arg1] $arg1
} {1 1414767442}
test binary-56.4 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54 n1 arg1] $arg1
} {1 1414767442}
test binary-56.5 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53 n0 arg1] $arg1
} {1 {}}
test binary-56.6 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04 n2 arg1] $arg1
} {1 {1414767442 67305985}}
test binary-56.7 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 n1 arg1] $arg1
} {0 foo}
test binary-56.8 {Tcl_BinaryObjCmd: scan} -setup {
unset -nocomplain arg1
} -returnCodes error -body {
set arg1 1
binary scan \x52\x53\x53\x54 n1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-56.9 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2
} {2 {1414767442 67305985} 5}
test binary-56.10 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x80\x00\x00\x00\x80\x00\x00\x00 nun arg1 arg2] $arg1 $arg2
} {2 128 128}
test binary-56.11 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x00\x00\x00\x80\x00\x00\x00\x80 nun arg1 arg2] $arg1 $arg2
} {2 2147483648 -2147483648}
# scan n (b)
test binary-57.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
binary scan abc n
} -result {not enough arguments for all format specifiers}
test binary-57.2 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04 n* arg1] $arg1
} {1 {1386435412 16909060}}
test binary-57.3 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04 n arg1] $arg1
} {1 1386435412}
test binary-57.4 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54 n1 arg1] $arg1
} {1 1386435412}
test binary-57.5 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53 n0 arg1] $arg1
} {1 {}}
test binary-57.6 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04 n2 arg1] $arg1
} {1 {1386435412 16909060}}
test binary-57.7 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 n1 arg1] $arg1
} {0 foo}
test binary-57.8 {Tcl_BinaryObjCmd: scan} -setup {
unset -nocomplain arg1
} -returnCodes error -body {
set arg1 1
binary scan \x52\x53\x53\x54 n1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-57.9 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2
} {2 {1386435412 16909060} 5}
test binary-57.10 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x80\x00\x00\x00\x80\x00\x00\x00 nun arg1 arg2] $arg1 $arg2
} {2 2147483648 -2147483648}
test binary-57.11 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x00\x00\x00\x80\x00\x00\x00\x80 nun arg1 arg2] $arg1 $arg2
} {2 128 128}
# scan Q/q
test binary-58.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
binary scan abc q
} -result {not enough arguments for all format specifiers}
test binary-58.2 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33 Q* arg1] $arg1
} {1 {1.6 3.4}}
test binary-58.3 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40 q* arg1] $arg1
} {1 {1.6 3.4}}
test binary-58.4 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33 Q arg1] $arg1
} {1 1.6}
test binary-58.5 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40 q arg1] $arg1
} {1 1.6}
test binary-58.6 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A Q1 arg1] $arg1
} {1 1.6}
test binary-58.7 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \x9A\x99\x99\x99\x99\x99\xF9\x3F q1 arg1] $arg1
} {1 1.6}
test binary-58.8 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A Q0 arg1] $arg1
} {1 {}}
test binary-58.9 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \x9A\x99\x99\x99\x99\x99\xF9\x3F q0 arg1] $arg1
} {1 {}}
test binary-58.10 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33 Q2 arg1] $arg1
} {1 {1.6 3.4}}
test binary-58.11 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40 q2 arg1] $arg1
} {1 {1.6 3.4}}
test binary-58.12 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 q1 arg1] $arg1
} {0 foo}
test binary-58.13 {Tcl_BinaryObjCmd: scan} -setup {
unset -nocomplain arg1
} -returnCodes error -body {
set arg1 1
binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A q1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-58.14 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33\x05 Q2c* arg1 arg2] $arg1 $arg2
} {2 {1.6 3.4} 5}
test binary-58.15 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x9A\x99\x99\x99\x99\x99\xF9\x3F\x33\x33\x33\x33\x33\x33\x0B\x40\x05 q2c* arg1 arg2] $arg1 $arg2
} {2 {1.6 3.4} 5}
# scan R/r
test binary-59.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
binary scan abc r
} -result {not enough arguments for all format specifiers}
test binary-59.2 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x3F\xCC\xCC\xCD\x40\x59\x99\x9A R* arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-59.3 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \xCD\xCC\xCC\x3F\x9A\x99\x59\x40 r* arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-59.4 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x3F\xCC\xCC\xCD\x40\x59\x99\x9A R arg1] $arg1
} {1 1.600000023841858}
test binary-59.5 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \xCD\xCC\xCC\x3F\x9A\x99\x59\x40 r arg1] $arg1
} {1 1.600000023841858}
test binary-59.6 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x3F\xCC\xCC\xCD R1 arg1] $arg1
} {1 1.600000023841858}
test binary-59.7 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \xCD\xCC\xCC\x3F r1 arg1] $arg1
} {1 1.600000023841858}
test binary-59.8 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x3F\xCC\xCC\xCD R0 arg1] $arg1
} {1 {}}
test binary-59.9 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \xCD\xCC\xCC\x3F r0 arg1] $arg1
} {1 {}}
test binary-59.10 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1
list [binary scan \x3F\xCC\xCC\xCD\x40\x59\x99\x9A R2 arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-59.11 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1
list [binary scan \xCD\xCC\xCC\x3F\x9A\x99\x59\x40 r2 arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-59.12 {Tcl_BinaryObjCmd: scan} {
unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 r1 arg1] $arg1
} {0 foo}
test binary-59.13 {Tcl_BinaryObjCmd: scan} -setup {
unset -nocomplain arg1
} -returnCodes error -body {
set arg1 1
binary scan \x3F\xCC\xCC\xCD r1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-59.14 {Tcl_BinaryObjCmd: scan} bigEndian {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x3F\xCC\xCC\xCD\x40\x59\x99\x9A\x05 R2c* arg1 arg2] $arg1 $arg2
} {2 {1.600000023841858 3.4000000953674316} 5}
test binary-59.15 {Tcl_BinaryObjCmd: scan} littleEndian {
unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \xCD\xCC\xCC\x3F\x9A\x99\x59\x40\x05 r2c* arg1 arg2] $arg1 $arg2
} {2 {1.600000023841858 3.4000000953674316} 5}
test binary-60.1 {[binary format] with NaN} -body {
binary scan [binary format dqQfrR NaN NaN NaN NaN NaN NaN] dqQfrR \
v1 v2 v3 v4 v5 v6
list $v1 $v2 $v3 $v4 $v5 $v6
} -match regexp -result {NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))?}
|
| ︙ | ︙ | |||
2492 2493 2494 2495 2496 2497 2498 |
test binary-70.3 {binary encode hex} -body {
binary encode hex {}
} -result {}
test binary-70.4 {binary encode hex} -body {
binary encode hex [string repeat a 20]
} -result [string repeat 61 20]
test binary-70.5 {binary encode hex} -body {
| | | | 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 |
test binary-70.3 {binary encode hex} -body {
binary encode hex {}
} -result {}
test binary-70.4 {binary encode hex} -body {
binary encode hex [string repeat a 20]
} -result [string repeat 61 20]
test binary-70.5 {binary encode hex} -body {
binary encode hex \x00\x01\x02\x03\x04\x00\x01\x02\x03\x04
} -result {00010203040001020304}
test binary-71.1 {binary decode hex} -body {
binary decode hex
} -returnCodes error -match glob -result "wrong # args: *"
test binary-71.2 {binary decode hex} -body {
binary decode hex 61
} -result {a}
test binary-71.3 {binary decode hex} -body {
binary decode hex {}
} -result {}
test binary-71.4 {binary decode hex} -body {
binary decode hex [string repeat 61 20]
} -result [string repeat a 20]
test binary-71.5 {binary decode hex} -body {
binary decode hex 00010203040001020304
} -result "\x00\x01\x02\x03\x04\x00\x01\x02\x03\x04"
test binary-71.6 {binary decode hex} -body {
binary decode hex "61 61"
} -result {aa}
test binary-71.7 {binary decode hex} -body {
binary decode hex "61\n\n\n61"
} -result {aa}
test binary-71.8 {binary decode hex} -match glob -body {
|
| ︙ | ︙ | |||
2568 2569 2570 2571 2572 2573 2574 |
test binary-72.3 {binary encode base64} -body {
binary encode base64 {}
} -result {}
test binary-72.4 {binary encode base64} -body {
binary encode base64 [string repeat abc 20]
} -result [string repeat YWJj 20]
test binary-72.5 {binary encode base64} -body {
| | | | | | | 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 |
test binary-72.3 {binary encode base64} -body {
binary encode base64 {}
} -result {}
test binary-72.4 {binary encode base64} -body {
binary encode base64 [string repeat abc 20]
} -result [string repeat YWJj 20]
test binary-72.5 {binary encode base64} -body {
binary encode base64 \x00\x01\x02\x03\x04\x00\x01\x02\x03
} -result {AAECAwQAAQID}
test binary-72.6 {binary encode base64} -body {
binary encode base64 \x00
} -result {AA==}
test binary-72.7 {binary encode base64} -body {
binary encode base64 \x00\x00
} -result {AAA=}
test binary-72.8 {binary encode base64} -body {
binary encode base64 \x00\x00\x00
} -result {AAAA}
test binary-72.9 {binary encode base64} -body {
binary encode base64 \x00\x00\x00\x00
} -result {AAAAAA==}
test binary-72.10 {binary encode base64} -body {
binary encode base64 -maxlen 0 -wrapchar : abcabcabc
} -result {YWJjYWJjYWJj}
test binary-72.11 {binary encode base64} -body {
binary encode base64 -maxlen 1 -wrapchar : abcabcabc
} -result {Y:W:J:j:Y:W:J:j:Y:W:J:j}
|
| ︙ | ︙ | |||
2640 2641 2642 2643 2644 2645 2646 |
test binary-72.27 {binary encode base64} -body {
binary encode base64 -maxlen 4 -wrapchar -*- abcabcabc
} -result {YWJj-*-YWJj-*-YWJj}
test binary-72.28 {binary encode base64} -body {
binary encode base64 -maxlen 6 -wrapchar 0123456789 abcabcabc
} -result {YWJjYW0123456789JjYWJj}
test binary-72.29 {binary encode base64} {
| | | | | | | | 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 |
test binary-72.27 {binary encode base64} -body {
binary encode base64 -maxlen 4 -wrapchar -*- abcabcabc
} -result {YWJj-*-YWJj-*-YWJj}
test binary-72.28 {binary encode base64} -body {
binary encode base64 -maxlen 6 -wrapchar 0123456789 abcabcabc
} -result {YWJjYW0123456789JjYWJj}
test binary-72.29 {binary encode base64} {
string length [binary encode base64 -maxlen 3 -wrapchar \xCA abc]
} 5
test binary-73.1 {binary decode base64} -body {
binary decode base64
} -returnCodes error -match glob -result "wrong # args: *"
test binary-73.2 {binary decode base64} -body {
binary decode base64 YWJj
} -result {abc}
test binary-73.3 {binary decode base64} -body {
binary decode base64 {}
} -result {}
test binary-73.4 {binary decode base64} -body {
binary decode base64 [string repeat YWJj 20]
} -result [string repeat abc 20]
test binary-73.5 {binary decode base64} -body {
binary decode base64 AAECAwQAAQID
} -result "\x00\x01\x02\x03\x04\x00\x01\x02\x03"
test binary-73.6 {binary decode base64} -body {
binary decode base64 AA==
} -result "\x00"
test binary-73.7 {binary decode base64} -body {
binary decode base64 AAA=
} -result "\x00\x00"
test binary-73.8 {binary decode base64} -body {
binary decode base64 AAAA
} -result "\x00\x00\x00"
test binary-73.9 {binary decode base64} -body {
binary decode base64 AAAAAA==
} -result "\x00\x00\x00\x00"
test binary-73.10 {binary decode base64} -body {
set s "[string repeat YWJj 10]\n[string repeat YWJj 10]"
binary decode base64 $s
} -result [string repeat abc 20]
test binary-73.11 {binary decode base64} -body {
set s "[string repeat YWJj 10]\n [string repeat YWJj 10]"
binary decode base64 $s
|
| ︙ | ︙ | |||
2787 2788 2789 2790 2791 2792 2793 |
test binary-74.3 {binary encode uuencode} -body {
binary encode uuencode {}
} -result {}
test binary-74.4 {binary encode uuencode} -body {
binary encode uuencode [string repeat abc 20]
} -result "M[string repeat 86)C 15]\n/[string repeat 86)C 5]\n"
test binary-74.5 {binary encode uuencode} -body {
| | | | | | 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 |
test binary-74.3 {binary encode uuencode} -body {
binary encode uuencode {}
} -result {}
test binary-74.4 {binary encode uuencode} -body {
binary encode uuencode [string repeat abc 20]
} -result "M[string repeat 86)C 15]\n/[string repeat 86)C 5]\n"
test binary-74.5 {binary encode uuencode} -body {
binary encode uuencode \x00\x01\x02\x03\x04\x00\x01\x02\x03
} -result ")``\$\"`P0``0(#\n"
test binary-74.6 {binary encode uuencode} -body {
binary encode uuencode \0
} -result {!``
}
test binary-74.7 {binary encode uuencode} -body {
binary encode uuencode \x00\x00
} -result "\"```
"
test binary-74.8 {binary encode uuencode} -body {
binary encode uuencode \x00\x00\x00
} -result {#````
}
test binary-74.9 {binary encode uuencode} -body {
binary encode uuencode \x00\x00\x00\x00
} -result {$``````
}
test binary-74.10 {binary encode uuencode} -returnCodes error -body {
binary encode uuencode -foo 30 abcabcabc
} -result {bad option "-foo": must be -maxlen or -wrapchar}
test binary-74.11 {binary encode uuencode} -returnCodes error -body {
binary encode uuencode -maxlen 4 abcabcabc
|
| ︙ | ︙ | |||
2838 2839 2840 2841 2842 2843 2844 |
binary decode uuencode `\n
} -result {}
test binary-75.4 {binary decode uuencode} -body {
binary decode uuencode "M[string repeat 86)C 15]\n/[string repeat 86)C 5]\n"
} -result [string repeat abc 20]
test binary-75.5 {binary decode uuencode} -body {
binary decode uuencode ")``\$\"`P0``0(#"
| | | 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 |
binary decode uuencode `\n
} -result {}
test binary-75.4 {binary decode uuencode} -body {
binary decode uuencode "M[string repeat 86)C 15]\n/[string repeat 86)C 5]\n"
} -result [string repeat abc 20]
test binary-75.5 {binary decode uuencode} -body {
binary decode uuencode ")``\$\"`P0``0(#"
} -result "\x00\x01\x02\x03\x04\x00\x01\x02\x03"
test binary-75.6 {binary decode uuencode} -body {
string length [binary decode uuencode "`\n"]
} -result 0
test binary-75.7 {binary decode uuencode} -body {
string length [binary decode uuencode "!`\n"]
} -result 1
test binary-75.8 {binary decode uuencode} -body {
|
| ︙ | ︙ | |||
2944 2945 2946 2947 2948 2949 2950 |
testConstraint testsetbytearraylength \
[expr {"testsetbytearraylength" in [info commands]}]
test binary-79.1 {Tcl_SetByteArrayLength} testsetbytearraylength {
testsetbytearraylength [string cat A B C] 1
} A
test binary-79.2 {Tcl_SetByteArrayLength} testsetbytearraylength {
| | | | | | | 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 |
testConstraint testsetbytearraylength \
[expr {"testsetbytearraylength" in [info commands]}]
test binary-79.1 {Tcl_SetByteArrayLength} testsetbytearraylength {
testsetbytearraylength [string cat A B C] 1
} A
test binary-79.2 {Tcl_SetByteArrayLength} testsetbytearraylength {
testsetbytearraylength [string cat Ł B C] 1
} A
test binary-80.1 {TclGetBytesFromObj} -constraints testbytestring -returnCodes 1 -body {
testbytestring "乎"
} -result "expected byte sequence but character 0 was '乎' (U+004E4E)"
test binary-80.2 {TclGetBytesFromObj} -constraints testbytestring -returnCodes 1 -body {
testbytestring [testbytestring "\x00\xA0\xA0\xA0\xE4\xB9\x8E"]
} -result "expected byte sequence but character 4 was '乎' (U+004E4E)"
test binary-80.3 {TclGetBytesFromObj} -constraints testbytestring -returnCodes 1 -body {
testbytestring [testbytestring "\xC0\x80\xA0\xA0\xA0\xE4\xB9\x8E"]
} -result "expected byte sequence but character 4 was '乎' (U+004E4E)"
test binary-80.4 {TclGetBytesFromObj} -constraints testbytestring -returnCodes 1 -body {
testbytestring [testbytestring "\xC0\x80\xA0\xA0\xA0\xF0\x9F\x98\x81"]
} -result "expected byte sequence but character 4 was '\U01F601' (U+01F601)"
# ----------------------------------------------------------------------
# cleanup
::tcltest::cleanupTests
return
# Local Variables:
# mode: tcl
# End:
|
Changes to tests/chan.test.
| ︙ | ︙ | |||
44 45 46 47 48 49 50 |
} -cleanup {
close $chan
} -returnCodes error -result "Half-close of write-side not possible, side not opened or already closed"
test chan-4.1 {chan command: configure subcommand} -body {
chan configure
} -returnCodes error -result "wrong # args: should be \"chan configure channelId ?-option value ...?\""
test chan-4.2 {chan command: [Bug 800753]} -body {
| | | | 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 |
} -cleanup {
close $chan
} -returnCodes error -result "Half-close of write-side not possible, side not opened or already closed"
test chan-4.1 {chan command: configure subcommand} -body {
chan configure
} -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 -match glob -result {bad value*}
test chan-4.3 {chan command: [Bug 800753]} -body {
chan configure stdout -eofchar \x00
} -returnCodes error -match glob -result {bad value*}
test chan-4.4 {chan command: check valid inValue, no outValue} -body {
chan configure stdout -eofchar [list \x27 {}]
} -returnCodes ok -result {}
test chan-4.5 {chan command: check valid inValue, invalid outValue} -body {
chan configure stdout -eofchar [list \x27 \x80]
} -returnCodes error -match glob -result {bad value for -eofchar:*}
|
| ︙ | ︙ |
Changes to tests/chanio.test.
| ︙ | ︙ | |||
46 47 48 49 50 51 52 53 54 55 56 57 58 59 |
testConstraint testfevent [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread [llength [info commands testmainthread]]
testConstraint testservicemode [llength [info commands testservicemode]]
testConstraint notWinCI [expr {
$::tcl_platform(platform) ne "windows" || ![info exists ::env(CI)]}]
testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}]
# You need a *very* special environment to do some tests. In particular,
# many file systems do not support large-files...
testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}]
# some tests can only be run is umask is 2 if "umask" cannot be run, the
# tests will be skipped.
| > | 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 |
testConstraint testfevent [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread [llength [info commands testmainthread]]
testConstraint testservicemode [llength [info commands testservicemode]]
testConstraint notWinCI [expr {
$::tcl_platform(platform) ne "windows" || ![info exists ::env(CI)]}]
testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}]
testConstraint specialfiles [expr {[file exists /dev/zero] || [file exists NUL]}]
# You need a *very* special environment to do some tests. In particular,
# many file systems do not support large-files...
testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}]
# some tests can only be run is umask is 2 if "umask" cannot be run, the
# tests will be skipped.
|
| ︙ | ︙ | |||
75 76 77 78 79 80 81 |
chan close $f
set path(cat) [makeFile {
set f stdin
if {$argv != ""} {
set f [open [lindex $argv 0]]
}
| | | 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 |
chan close $f
set path(cat) [makeFile {
set f stdin
if {$argv != ""} {
set f [open [lindex $argv 0]]
}
chan configure $f -encoding binary -translation lf -blocking 0 -eofchar \x1A
chan configure stdout -encoding binary -translation lf -buffering none
chan event $f readable "foo $f"
proc foo {f} {
set x [chan read $f]
catch {chan puts -nonewline $x}
if {[chan eof $f]} {
chan close $f
|
| ︙ | ︙ | |||
111 112 113 114 115 116 117 |
test chan-io-1.5 {Tcl_WriteChars: CheckChannelErrors} {emptyTest} {
# no test, need to cause an async error.
} {}
set path(test1) [makeFile {} test1]
test chan-io-1.6 {Tcl_WriteChars: WriteBytes} {
set f [open $path(test1) w]
chan configure $f -encoding binary
| | | | | | | 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 |
test chan-io-1.5 {Tcl_WriteChars: CheckChannelErrors} {emptyTest} {
# no test, need to cause an async error.
} {}
set path(test1) [makeFile {} test1]
test chan-io-1.6 {Tcl_WriteChars: WriteBytes} {
set f [open $path(test1) w]
chan configure $f -encoding binary
chan puts -nonewline $f "a乍\x00"
chan close $f
contents $path(test1)
} "aM\x00"
test chan-io-1.7 {Tcl_WriteChars: WriteChars} {
set f [open $path(test1) w]
chan configure $f -encoding shiftjis
chan puts -nonewline $f "a乍\x00"
chan close $f
contents $path(test1)
} "a\x93\xE1\x00"
set path(test2) [makeFile {} test2]
test chan-io-1.8 {Tcl_WriteChars: WriteChars} {
# This test written for SF bug #506297.
#
# Executing this test without the fix for the referenced bug applied to
# tcl will cause tcl, more specifically WriteChars, to go into an infinite
# loop.
set f [open $path(test2) w]
chan configure $f -encoding iso2022-jp
chan puts -nonewline $f [format %s%c [string repeat " " 4] 12399]
chan close $f
contents $path(test2)
} " \x1B\$B\$O\x1B(B"
test chan-io-1.9 {Tcl_WriteChars: WriteChars} {
# When closing a channel with an encoding that appends escape bytes, check
# for the case where the escape bytes overflow the current IO buffer. The
# bytes should be moved into a new buffer.
set data "1234567890 [format %c 12399]"
set sizes [list]
# With default buffer size
|
| ︙ | ︙ | |||
269 270 271 272 273 274 275 |
lappend x [contents $path(test1)]
} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test chan-io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
# One incomplete UTF-8 character at end of staging buffer. Backup in src
# to the beginning of that UTF-8 character and try again.
#
# Translate the first 16 bytes, produce 14 bytes of output, 2 left over
| | | | | 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 |
lappend x [contents $path(test1)]
} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test chan-io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
# One incomplete UTF-8 character at end of staging buffer. Backup in src
# to the beginning of that UTF-8 character and try again.
#
# Translate the first 16 bytes, produce 14 bytes of output, 2 left over
# (first two bytes of A in UTF-8). Given those two bytes try
# translating them again, find that no bytes are read produced, and break
# to outer loop where those two bytes will have the remaining 4 bytes (the
# last byte of A plus the all of B) appended.
set f [open $path(test1) w]
chan configure $f -encoding shiftjis -buffersize 16
chan puts -nonewline $f "12345678901234AB"
set x [list [contents $path(test1)]]
chan close $f
lappend x [contents $path(test1)]
} [list "12345678901234\x82\x60" "12345678901234\x82\x60\x82\x61"]
test chan-io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} {
# When translating UTF-8 to external, the produced bytes went past end of
# the channel buffer. This is done on purpose - we then truncate the bytes
|
| ︙ | ︙ | |||
417 418 419 420 421 422 423 |
list [chan tell $f] [chan gets $f line] [chan tell $f] [chan gets $f line] $line
} -cleanup {
chan close $f
} -result {0 3 5 4 defg}
test chan-io-6.4 {Tcl_GetsObj: encoding == NULL} -body {
set f [open $path(test1) w]
chan configure $f -translation binary
| | | | | 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 |
list [chan tell $f] [chan gets $f line] [chan tell $f] [chan gets $f line] $line
} -cleanup {
chan close $f
} -result {0 3 5 4 defg}
test chan-io-6.4 {Tcl_GetsObj: encoding == NULL} -body {
set f [open $path(test1) w]
chan configure $f -translation binary
chan puts $f "\x81\u1234\x00"
chan close $f
set f [open $path(test1)]
chan configure $f -translation binary
list [chan gets $f line] $line
} -cleanup {
chan close $f
} -result [list 3 "\x81\x34\x00"]
test chan-io-6.5 {Tcl_GetsObj: encoding != NULL} -body {
set f [open $path(test1) w]
chan configure $f -translation binary
chan puts $f "\x88\xEA\x92\x9A"
chan close $f
set f [open $path(test1)]
chan configure $f -encoding shiftjis
list [chan gets $f line] $line
} -cleanup {
chan close $f
} -result [list 2 "一丁"]
set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
append a $a
append a $a
test chan-io-6.6 {Tcl_GetsObj: loop test} -body {
# if (dst >= dstEnd)
set f [open $path(test1) w]
chan puts $f $a
|
| ︙ | ︙ | |||
463 464 465 466 467 468 469 |
chan configure $f -blocking 0
chan gets $f line
} -cleanup {
chan close $f
} -result {-1}
test chan-io-6.8 {Tcl_GetsObj: remember if EOF is seen} -body {
set f [open $path(test1) w]
| | | | | | 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 |
chan configure $f -blocking 0
chan gets $f line
} -cleanup {
chan close $f
} -result {-1}
test chan-io-6.8 {Tcl_GetsObj: remember if EOF is seen} -body {
set f [open $path(test1) w]
chan puts $f "abcdef\x1Aghijk\nwombat"
chan close $f
set f [open $path(test1)]
chan configure $f -eofchar \x1A
list [chan gets $f line] $line [chan gets $f line] $line
} -cleanup {
chan close $f
} -result {6 abcdef -1 {}}
test chan-io-6.9 {Tcl_GetsObj: remember if EOF is seen} -body {
set f [open $path(test1) w]
chan puts $f "abcdefghijk\nwom\x1Abat"
chan close $f
set f [open $path(test1)]
chan configure $f -eofchar \x1A
list [chan gets $f line] $line [chan gets $f line] $line
} -cleanup {
chan close $f
} -result {11 abcdefghijk 3 wom}
# Comprehensive tests
test chan-io-6.10 {Tcl_GetsObj: lf mode: no chars} -body {
set f [open $path(test1) w]
|
| ︙ | ︙ | |||
861 862 863 864 865 866 867 |
chan configure $f -translation {auto lf} -buffering none
chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
chan configure $f -buffersize 16
lappend x [chan gets $f]
chan configure $f -blocking 0
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
chan configure $f -blocking 1
| | | | 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 |
chan configure $f -translation {auto lf} -buffering none
chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
chan configure $f -buffersize 16
lappend x [chan gets $f]
chan configure $f -blocking 0
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
chan configure $f -blocking 1
chan puts -nonewline $f "\nabcd\refg\x1A"
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
lappend x [chan gets $f line] $line
} -cleanup {
chan close $f
} -result {bbbbbbbbbbbbbbb 15 123456789abcdef 1 4 abcd 0 3 efg}
test chan-io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} -setup {
set x ""
} -constraints {stdio testchannel fileevent} -body {
# not (*eol == '\n')
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto lf} -buffering none
chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
chan configure $f -buffersize 16
lappend x [chan gets $f]
chan configure $f -blocking 0
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
chan configure $f -blocking 1
chan puts -nonewline $f "abcd\refg\x1A"
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
lappend x [chan gets $f line] $line
} -cleanup {
chan close $f
} -result {bbbbbbbbbbbbbbb 15 123456789abcdef 1 4 abcd 0 3 efg}
test chan-io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} -setup {
set x ""
|
| ︙ | ︙ | |||
915 916 917 918 919 920 921 |
chan configure $f -translation {auto lf} -buffering none
chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
chan configure $f -buffersize 16
chan gets $f
chan configure $f -blocking 0
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
chan configure $f -blocking 1
| | | 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 |
chan configure $f -translation {auto lf} -buffering none
chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
chan configure $f -buffersize 16
chan gets $f
chan configure $f -blocking 0
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
chan configure $f -blocking 1
chan puts -nonewline $f "\n\x1A"
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
} -cleanup {
chan close $f
} -result {15 123456789abcdef 1 -1 {} 0}
test chan-io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} -constraints {testchannel} -body {
# (eol == dstEnd)
set f [open $path(test1) w]
|
| ︙ | ︙ | |||
981 982 983 984 985 986 987 |
} -cleanup {
chan close $f
} -result {123456 7 78901}
test chan-io-6.52 {Tcl_GetsObj: saw EOF character} -constraints {testchannel} -body {
# if (eof != NULL)
set f [open $path(test1) w]
chan configure $f -translation lf
| | | | 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 |
} -cleanup {
chan close $f
} -result {123456 7 78901}
test chan-io-6.52 {Tcl_GetsObj: saw EOF character} -constraints {testchannel} -body {
# if (eof != NULL)
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "123456\x1Ak9012345\r"
chan close $f
set f [open $path(test1)]
chan configure $f -eofchar \x1A
list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]
} -cleanup {
chan close $f
} -result {123456 0 6 {}}
test chan-io-6.53 {Tcl_GetsObj: device EOF} -body {
# didn't produce any bytes
set f [open $path(test1) w]
|
| ︙ | ︙ | |||
1012 1013 1014 1015 1016 1017 1018 |
} -cleanup {
chan close $f
} -result {3 abc 1}
test chan-io-6.55 {Tcl_GetsObj: overconverted} -body {
# Tcl_ExternalToUtf(), make sure state updated
set f [open $path(test1) w]
chan configure $f -encoding iso2022-jp
| | | | 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 |
} -cleanup {
chan close $f
} -result {3 abc 1}
test chan-io-6.55 {Tcl_GetsObj: overconverted} -body {
# Tcl_ExternalToUtf(), make sure state updated
set f [open $path(test1) w]
chan configure $f -encoding iso2022-jp
chan puts $f "there一ok\n丁more bytes\nhere"
chan close $f
set f [open $path(test1)]
chan configure $f -encoding iso2022-jp
list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line
} -cleanup {
chan close $f
} -result [list 8 "there一ok" 11 "丁more bytes" 4 "here"]
test chan-io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} -setup {
update
variable x {}
} -constraints {stdio fileevent} -body {
set f [openpipe w+ $path(cat)]
chan configure $f -buffering none
chan puts -nonewline $f "foobar"
|
| ︙ | ︙ | |||
1053 1054 1055 1056 1057 1058 1059 |
chan close $f
} -result {{} timeout foobarbaz timeout}
test chan-io-7.1 {FilterInputBytes: split up character at end of buffer} -body {
# (result == TCL_CONVERT_MULTIBYTE)
set f [open $path(test1) w]
chan configure $f -encoding shiftjis
| | | | | | | | | 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 |
chan close $f
} -result {{} timeout foobarbaz timeout}
test chan-io-7.1 {FilterInputBytes: split up character at end of buffer} -body {
# (result == TCL_CONVERT_MULTIBYTE)
set f [open $path(test1) w]
chan configure $f -encoding shiftjis
chan puts $f "123456789012301234\nend"
chan close $f
set f [open $path(test1)]
chan configure $f -encoding shiftjis -buffersize 16
chan gets $f
} -cleanup {
chan close $f
} -result "123456789012301234"
test chan-io-7.2 {FilterInputBytes: split up character in middle of buffer} -body {
# (bufPtr->nextAdded < bufPtr->bufLength)
set f [open $path(test1) w]
chan configure $f -encoding binary
chan puts -nonewline $f "1234567890\n123\x82\x4F\x82\x50\x82"
chan close $f
set f [open $path(test1)]
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
lappend x [chan gets $f line] $line
lappend x [chan tell $f] [testchannel inputbuffered $f] [chan eof $f]
lappend x [chan gets $f line] $line
} -cleanup {
chan close $f
} -result [list 15 "123456789012301" 18 0 1 -1 ""]
test chan-io-7.4 {FilterInputBytes: recover from split up character} -setup {
variable x ""
} -constraints {stdio fileevent} -body {
set f [openpipe w+ $path(cat)]
chan configure $f -encoding binary -buffering none
chan puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
chan configure $f -encoding shiftjis -blocking 0
chan event $f read [namespace code {
lappend x [chan gets $f line] $line [chan blocked $f]
}]
vwait [namespace which -variable x]
chan configure $f -encoding binary -blocking 1
chan puts $f "\x51\x82\x52"
chan configure $f -encoding shiftjis
vwait [namespace which -variable x]
return $x
} -cleanup {
chan close $f
} -result [list -1 "" 1 17 "12345678901230123" 0]
test chan-io-8.1 {PeekAhead: only go to device if no more cached data} -constraints {testchannel} -body {
# (bufPtr->nextPtr == NULL)
set f [open $path(test1) w]
chan configure $f -encoding ascii -translation lf
chan puts -nonewline $f "123456789012345\r\n2345678"
chan close $f
|
| ︙ | ︙ | |||
1201 1202 1203 1204 1205 1206 1207 |
} -constraints {stdio testchannel fileevent} -body {
# Make sure bytes are removed from buffer.
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto binary} -buffering none
chan puts -nonewline $f "abcdefghijklmno\r"
# here
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
| | | 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 |
} -constraints {stdio testchannel fileevent} -body {
# Make sure bytes are removed from buffer.
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto binary} -buffering none
chan puts -nonewline $f "abcdefghijklmno\r"
# here
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
chan puts -nonewline $f "\x1A"
lappend x [chan gets $f line] $line
} -cleanup {
chan close $f
} -result {15 abcdefghijklmno 1 -1 {}}
test chan-io-9.1 {CommonGetsCleanup} emptyTest {
} {}
|
| ︙ | ︙ | |||
1357 1358 1359 1360 1361 1362 1363 |
chan configure $f -encoding shiftjis -blocking 0
chan event $f read [namespace code {
lappend x [chan read $f] [testchannel inputbuffered $f]
}]
chan configure $f -encoding shiftjis
vwait [namespace which -variable x]
chan configure $f -encoding binary -blocking 1
| | | | | | 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 |
chan configure $f -encoding shiftjis -blocking 0
chan event $f read [namespace code {
lappend x [chan read $f] [testchannel inputbuffered $f]
}]
chan configure $f -encoding shiftjis
vwait [namespace which -variable x]
chan configure $f -encoding binary -blocking 1
chan puts -nonewline $f "\x7B"
after 500 ;# Give the cat process time to catch up
chan configure $f -encoding shiftjis -blocking 0
vwait [namespace which -variable x]
return $x
} -cleanup {
chan close $f
} -result [list "123456789012345" 1 "本" 0]
test chan-io-12.5 {ReadChars: chan events on partial characters} -setup {
variable x {}
} -constraints {stdio fileevent} -body {
set path(test1) [makeFile {
chan configure stdout -encoding binary -buffering none
chan gets stdin; chan puts -nonewline "\xE7"
chan gets stdin; chan puts -nonewline "\x89"
chan gets stdin; chan puts -nonewline "\xA6"
} test1]
set f [openpipe r+ $path(test1)]
chan event $f readable [namespace code {
lappend x [chan read $f]
if {[chan eof $f]} {
lappend x eof
}
|
| ︙ | ︙ | |||
1397 1398 1399 1400 1401 1402 1403 |
after 500 [namespace code { lappend x timeout }]
vwait [namespace which -variable x]
chan puts $f "go3"
chan flush $f
vwait [namespace which -variable x]
vwait [namespace which -variable x]
lappend x [catch {chan close $f} msg] $msg
| | | 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 |
after 500 [namespace code { lappend x timeout }]
vwait [namespace which -variable x]
chan puts $f "go3"
chan flush $f
vwait [namespace which -variable x]
vwait [namespace which -variable x]
lappend x [catch {chan close $f} msg] $msg
} -result "{} timeout {} timeout 牦 {} eof 0 {}"
test chan-io-13.1 {TranslateInputEOL: cr mode} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "abcd\rdef\r"
chan close $f
set f [open $path(test1)]
|
| ︙ | ︙ | |||
1526 1527 1528 1529 1530 1531 1532 |
set f [open $path(test1)]
chan configure $f -translation auto
chan read $f
} -cleanup {
chan close $f
} -result "abcd\ndef"
test chan-io-13.11 {TranslateInputEOL: EOF char} -body {
| | | | 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 |
set f [open $path(test1)]
chan configure $f -translation auto
chan read $f
} -cleanup {
chan close $f
} -result "abcd\ndef"
test chan-io-13.11 {TranslateInputEOL: EOF char} -body {
# (*chanPtr->inEofChar != '\x00')
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "abcd\ndefgh"
chan close $f
set f [open $path(test1)]
chan configure $f -translation auto -eofchar e
chan read $f
} -cleanup {
chan close $f
} -result "abcd\nd"
test chan-io-13.12 {TranslateInputEOL: find EOF char in src} -body {
# (*chanPtr->inEofChar != '\x00')
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "\r\n\r\n\r\nab\r\n\r\ndef\r\n\r\n\r\n"
chan close $f
set f [open $path(test1)]
chan configure $f -translation auto -eofchar e
chan read $f
|
| ︙ | ︙ | |||
1874 1875 1876 1877 1878 1879 1880 |
chan close $a
} -result {ascii}
test chan-io-20.2 {Tcl_CreateChannel: initial settings} -constraints {win} -body {
set f [open $path(test1) w+]
list [chan configure $f -eofchar] [chan configure $f -translation]
} -cleanup {
chan close $f
| | | 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 |
chan close $a
} -result {ascii}
test chan-io-20.2 {Tcl_CreateChannel: initial settings} -constraints {win} -body {
set f [open $path(test1) w+]
list [chan configure $f -eofchar] [chan configure $f -translation]
} -cleanup {
chan close $f
} -result [list [list \x1A ""] {auto crlf}]
test chan-io-20.3 {Tcl_CreateChannel: initial settings} -constraints {unix} -body {
set f [open $path(test1) w+]
list [chan configure $f -eofchar] [chan configure $f -translation]
} -cleanup {
chan close $f
} -result {{{} {}} {auto lf}}
test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} -setup {
|
| ︙ | ︙ | |||
3087 3088 3089 3090 3091 3092 3093 |
here
}
test chan-io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
| | | | | | | | 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 |
here
}
test chan-io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f hello\nthere\nand\rhere\n\x1A
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
chan read $f
} -cleanup {
chan close $f
} -result {hello
there
and
here
}
test chan-io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} -setup {
file delete $path(test1)
} -constraints {win} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar \x1A
chan puts $f hello\nthere\nand\rhere
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
chan read $f
} -cleanup {
chan close $f
} -result {hello
there
and
here
}
test chan-io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
set s [format "abc\ndef\n%cghi\nqrs" 26]
chan puts $f $s
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
set l ""
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
} -cleanup {
chan close $f
} -result {abc def 0 {} 1 {} 1}
test chan-io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
set s [format "abc\ndef\n%cghi\nqrs" 26]
chan puts $f $s
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
set l ""
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
|
| ︙ | ︙ | |||
3179 3180 3181 3182 3183 3184 3185 |
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
} -cleanup {
chan close $f
| | | | | | | | | | | 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 |
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
} -cleanup {
chan close $f
} -result "abc def 0 \x1Aghi 0 qrs 0 {} 1"
test chan-io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} -setup {
file delete $path(test1)
set l ""
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar {}
chan puts $f [format "abc\ndef\n%cghi\nqrs" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation cr -eofchar {}
set x [chan gets $f]
lappend l [string equal $x "abc\ndef\n\x1Aghi\nqrs\n"]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
} -cleanup {
chan close $f
} -result {1 1 {} 1}
test chan-io-30.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} -setup {
file delete $path(test1)
set l ""
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar {}
chan puts $f [format "abc\ndef\n%cghi\nqrs" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation crlf -eofchar {}
set x [chan gets $f]
lappend l [string equal $x "abc\ndef\n\x1Aghi\nqrs\n"]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
} -cleanup {
chan close $f
} -result {1 1 {} 1}
test chan-io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts $f [format abc\ndef\n%cqrs\ntuv 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
list [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
} -result {8 1}
test chan-io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
set c [format abc\ndef\n%cqrs\ntuv 26]
chan puts $f $c
chan close $f
set f [open $path(test1) r]
chan configure $f -translation lf -eofchar \x1A
list [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
} -result {8 1}
test chan-io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation cr
set c [format abc\ndef\n%cqrs\ntuv 26]
chan puts $f $c
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
list [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
} -result {8 1}
test chan-io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation cr
set c [format abc\ndef\n%cqrs\ntuv 26]
chan puts $f $c
chan close $f
set f [open $path(test1) r]
chan configure $f -translation cr -eofchar \x1A
list [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
} -result {8 1}
test chan-io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
set c [format abc\ndef\n%cqrs\ntuv 26]
chan puts $f $c
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
list [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
} -result {8 1}
test chan-io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
set c [format abc\ndef\n%cqrs\ntuv 26]
chan puts $f $c
chan close $f
set f [open $path(test1) r]
chan configure $f -translation crlf -eofchar \x1A
list [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
} -result {8 1}
# Test end of line translations. Functions tested are Tcl_Write and
# Tcl_Gets.
|
| ︙ | ︙ | |||
3645 3646 3647 3648 3649 3650 3651 |
set l ""
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts $f [format "hello\nthere\nand\rhere\n\%c" 26]
chan close $f
set f [open $path(test1) r]
| | | | < | | | 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 |
set l ""
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts $f [format "hello\nthere\nand\rhere\n\%c" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
} -cleanup {
chan close $f
} -result {hello there and here 0 {} 1}
test chan-io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} -setup {
file delete $path(test1)
set l ""
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar \x1A
chan puts $f hello\nthere\nand\rhere
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
} -cleanup {
chan close $f
} -result {hello there and here 0 {} 1}
test chan-io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} -setup {
file delete $path(test1)
set l ""
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
} -cleanup {
chan close $f
} -result {abc def 0 {} 1}
test chan-io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} -setup {
file delete $path(test1)
set l ""
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
} -cleanup {
chan close $f
|
| ︙ | ︙ | |||
3734 3735 3736 3737 3738 3739 3740 |
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
} -cleanup {
chan close $f
| | | 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 |
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
} -cleanup {
chan close $f
} -result "abc def 0 \x1Aqrs 0 tuv 0 {} 1"
test chan-io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} -setup {
file delete $path(test1)
set l ""
} -body {
set f [open $path(test1) w]
chan configure $f -translation cr -eofchar {}
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
|
| ︙ | ︙ | |||
3756 3757 3758 3759 3760 3761 3762 |
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
} -cleanup {
chan close $f
| | | 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 |
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
} -cleanup {
chan close $f
} -result "abc def 0 \x1Aqrs 0 tuv 0 {} 1"
test chan-io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} -setup {
file delete $path(test1)
set l ""
} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf -eofchar {}
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
|
| ︙ | ︙ | |||
3778 3779 3780 3781 3782 3783 3784 |
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
} -cleanup {
chan close $f
| | | | | | | | | 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 |
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
} -cleanup {
chan close $f
} -result "abc def 0 \x1Aqrs 0 tuv 0 {} 1"
test chan-io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} -setup {
file delete $path(test1)
set l ""
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
} -cleanup {
chan close $f
} -result {abc def 0 {} 1}
test chan-io-31.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} -setup {
file delete $path(test1)
set l ""
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation lf -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
} -cleanup {
chan close $f
} -result {abc def 0 {} 1}
test chan-io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} -setup {
file delete $path(test1)
set l ""
} -body {
set f [open $path(test1) w]
chan configure $f -translation cr -eofchar {}
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
} -cleanup {
chan close $f
} -result {abc def 0 {} 1}
test chan-io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} -setup {
file delete $path(test1)
set l ""
} -body {
set f [open $path(test1) w]
chan configure $f -translation cr -eofchar {}
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation cr -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
} -cleanup {
chan close $f
} -result {abc def 0 {} 1}
test chan-io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} -setup {
file delete $path(test1)
set l ""
} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf -eofchar {}
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
} -cleanup {
chan close $f
} -result {abc def 0 {} 1}
test chan-io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} -setup {
file delete $path(test1)
set l ""
} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf -eofchar {}
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation crlf -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
} -cleanup {
chan close $f
|
| ︙ | ︙ | |||
4634 4635 4636 4637 4638 4639 4640 |
} -cleanup {
chan close $f
} -result {{} 1}
test chan-io-35.6 {Tcl_Eof, eof char, lf write, auto read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
| | | | | | | | | | | | | | | | | | | | 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 4649 4650 4651 4652 4653 4654 4655 4656 4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 4706 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 4750 4751 4752 4753 4754 4755 4756 4757 4758 4759 4760 4761 4762 4763 4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 4781 4782 4783 4784 4785 4786 4787 4788 4789 4790 4791 4792 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 4807 |
} -cleanup {
chan close $f
} -result {{} 1}
test chan-io-35.6 {Tcl_Eof, eof char, lf write, auto read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar \x1A
chan puts $f abc\ndef
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
} -result {9 8 1}
test chan-io-35.7 {Tcl_Eof, eof char, lf write, lf read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar \x1A
chan puts $f abc\ndef
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation lf -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
} -result {9 8 1}
test chan-io-35.8 {Tcl_Eof, eof char, cr write, auto read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation cr -eofchar \x1A
chan puts $f abc\ndef
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
} -result {9 8 1}
test chan-io-35.9 {Tcl_Eof, eof char, cr write, cr read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation cr -eofchar \x1A
chan puts $f abc\ndef
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation cr -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
} -result {9 8 1}
test chan-io-35.10 {Tcl_Eof, eof char, crlf write, auto read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf -eofchar \x1A
chan puts $f abc\ndef
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
} -result {11 8 1}
test chan-io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf -eofchar \x1A
chan puts $f abc\ndef
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation crlf -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
} -result {11 8 1}
test chan-io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar {}
chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
chan close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
} -result {17 8 1}
test chan-io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar {}
chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
chan close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation lf -eofchar \x1A
list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
} -result {17 8 1}
test chan-io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation cr -eofchar {}
chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
chan close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
} -result {17 8 1}
test chan-io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation cr -eofchar {}
chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
chan close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation cr -eofchar \x1A
list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
} -result {17 8 1}
test chan-io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf -eofchar {}
chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
chan close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
} -result {21 8 1}
test chan-io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf -eofchar {}
chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
chan close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation crlf -eofchar \x1A
list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
} -result {21 8 1}
# Test Tcl_InputBlocked
|
| ︙ | ︙ | |||
5163 5164 5165 5166 5167 5168 5169 |
chan close $f
} -result 40000
test chan-io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -encoding {}
| | | | | | | | 5163 5164 5165 5166 5167 5168 5169 5170 5171 5172 5173 5174 5175 5176 5177 5178 5179 5180 5181 5182 5183 5184 5185 5186 5187 5188 5189 5190 5191 5192 5193 5194 5195 5196 5197 5198 5199 5200 5201 5202 5203 5204 5205 5206 5207 5208 5209 5210 5211 5212 5213 5214 5215 5216 5217 5218 5219 5220 5221 5222 5223 5224 5225 5226 5227 5228 5229 |
chan close $f
} -result 40000
test chan-io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -encoding {}
chan puts -nonewline $f \xE7\x89\xA6
chan close $f
set f [open $path(test1) r]
chan configure $f -encoding utf-8
chan read $f
} -cleanup {
chan close $f
} -result 牦
test chan-io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -encoding binary
chan puts -nonewline $f \xE7\x89\xA6
chan close $f
set f [open $path(test1) r]
chan configure $f -encoding utf-8
chan read $f
} -cleanup {
chan close $f
} -result 牦
test chan-io-39.16 {Tcl_SetChannelOption: -encoding, errors} -setup {
file delete $path(test1)
set f [open $path(test1) w]
} -body {
chan configure $f -encoding foobar
} -returnCodes error -cleanup {
chan close $f
} -result {unknown encoding "foobar"}
test chan-io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} -setup {
variable x {}
} -constraints {stdio fileevent} -body {
set f [openpipe r+ $path(cat)]
chan configure $f -encoding binary
chan puts -nonewline $f "\xE7"
chan flush $f
chan configure $f -encoding utf-8 -blocking 0
chan event $f readable [namespace code { lappend x [chan read $f] }]
vwait [namespace which -variable x]
after 300 [namespace code { lappend x timeout }]
vwait [namespace which -variable x]
chan configure $f -encoding utf-8
vwait [namespace which -variable x]
after 300 [namespace code { lappend x timeout }]
vwait [namespace which -variable x]
chan configure $f -encoding binary
vwait [namespace which -variable x]
after 300 [namespace code { lappend x timeout }]
vwait [namespace which -variable x]
return $x
} -cleanup {
chan close $f
} -result "{} timeout {} timeout \xE7 timeout"
test chan-io-39.18 {Tcl_SetChannelOption, setting read mode independently} \
-constraints {socket} -body {
proc accept {s a p} {chan close $s}
set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
set port [lindex [chan configure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
|
| ︙ | ︙ | |||
5506 5507 5508 5509 5510 5511 5512 5513 5514 5515 5516 5517 5518 5519 |
test chan-io-41.4 {Tcl_FileeventCmd: errors} -constraints fileevent -body {
chan event gorp writable
} -returnCodes error -result {can not find channel named "gorp"}
test chan-io-41.5 {Tcl_FileeventCmd: errors} -constraints fileevent -body {
chan event gorp who-knows
} -returnCodes error -result {bad event name "who-knows": must be readable or writable}
#
# Test chan event on a file
#
set path(foo) [makeFile {} foo]
set f [open $path(foo) w+]
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 5506 5507 5508 5509 5510 5511 5512 5513 5514 5515 5516 5517 5518 5519 5520 5521 5522 5523 5524 5525 5526 5527 5528 5529 5530 5531 5532 5533 5534 5535 5536 5537 5538 5539 5540 5541 5542 5543 5544 5545 5546 5547 5548 5549 5550 5551 5552 5553 5554 5555 5556 5557 5558 5559 5560 5561 5562 5563 5564 5565 5566 5567 5568 5569 5570 5571 5572 5573 |
test chan-io-41.4 {Tcl_FileeventCmd: errors} -constraints fileevent -body {
chan event gorp writable
} -returnCodes error -result {can not find channel named "gorp"}
test chan-io-41.5 {Tcl_FileeventCmd: errors} -constraints fileevent -body {
chan event gorp who-knows
} -returnCodes error -result {bad event name "who-knows": must be readable or writable}
test chan-io-41.6 {Tcl_FileeventCmd: directory} -constraints {fileevent unix} -setup {
set tempdir [::tcltests::tempdir]
} -body {
set chan [open $tempdir]
chan event $chan readable [list ::apply [list {} {
variable success
set success 1
} [namespace current]]]
vwait [namespace current]::success
return $success
} -cleanup {
close $chan
file delete -force tempdir
} -result 1
test chan-io-41.7 {Tcl_FileeventCmd: special} -constraints {
fileevent specialfiles
} -body {
set special /dev/zero
if {![file exists $special]} {
set special NUL
}
set chan [open $special]
chan event $chan readable [list ::apply [list {} {
variable success
set success 1
} [namespace current]]]
vwait [namespace current]::success
return $success
} -cleanup {
close $chan
} -result 1
test chan-io-41.8 {Tcl_FileeventCmd: symbolic link} -constraints {fileevent unix} -setup {
set tempdir [::tcltests::tempdir]
} -body {
set target [makeFile {not again} thefile $tempdir]
set link [file join $tempdir thelin]
file link -symbolic $link $target
set chan [open $link]
chan event $chan readable [list ::apply [list {} {
variable success
set success 1
} [namespace current]]]
vwait [namespace current]::success
return $success
} -cleanup {
close $chan
file delete -force $tempdir
} -result 1
#
# Test chan event on a file
#
set path(foo) [makeFile {} foo]
set f [open $path(foo) w+]
|
| ︙ | ︙ | |||
5529 5530 5531 5532 5533 5534 5535 |
chan event $f r "yet another"
lappend result [chan event $f readable]
chan event $f r ""
lappend result [chan event $f readable]
} {{first script} {new script} {yet another} {}}
test chan-io-42.3 {Tcl_FileeventCmd: replacing, with NULL chars in script} {fileevent} {
set result {}
| | | | | 5583 5584 5585 5586 5587 5588 5589 5590 5591 5592 5593 5594 5595 5596 5597 5598 5599 5600 5601 |
chan event $f r "yet another"
lappend result [chan event $f readable]
chan event $f r ""
lappend result [chan event $f readable]
} {{first script} {new script} {yet another} {}}
test chan-io-42.3 {Tcl_FileeventCmd: replacing, with NULL chars in script} {fileevent} {
set result {}
chan event $f r "first scr\x00ipt"
lappend result [string length [chan event $f readable]]
chan event $f r "new scr\x00ipt"
lappend result [string length [chan event $f readable]]
chan event $f r "yet ano\x00ther"
lappend result [string length [chan event $f readable]]
chan event $f r ""
lappend result [chan event $f readable]
} {13 11 12 {}}
test chan-io-43.1 {Tcl_FileeventCmd: creating, deleting, querying} {stdio unixExecs fileevent} {
set result {}
|
| ︙ | ︙ | |||
5979 5980 5981 5982 5983 5984 5985 |
set l ""
} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
set f [open $path(test1) r]
| | | 6033 6034 6035 6036 6037 6038 6039 6040 6041 6042 6043 6044 6045 6046 6047 |
set l ""
} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
chan close $f
} else {
lappend l [chan gets $f]
incr c
|
| ︙ | ︙ | |||
6003 6004 6005 6006 6007 6008 6009 |
set l ""
} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
set f [open $path(test1) r]
| | | 6057 6058 6059 6060 6061 6062 6063 6064 6065 6066 6067 6068 6069 6070 6071 |
set l ""
} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
chan close $f
} else {
lappend l [chan gets $f]
incr c
|
| ︙ | ︙ | |||
6027 6028 6029 6030 6031 6032 6033 |
set l ""
} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation cr
chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
set f [open $path(test1) r]
| | | 6081 6082 6083 6084 6085 6086 6087 6088 6089 6090 6091 6092 6093 6094 6095 |
set l ""
} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation cr
chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
chan close $f
} else {
lappend l [chan gets $f]
incr c
|
| ︙ | ︙ | |||
6051 6052 6053 6054 6055 6056 6057 |
set l ""
} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation cr
chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
set f [open $path(test1) r]
| | | 6105 6106 6107 6108 6109 6110 6111 6112 6113 6114 6115 6116 6117 6118 6119 |
set l ""
} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation cr
chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
chan close $f
} else {
lappend l [chan gets $f]
incr c
|
| ︙ | ︙ | |||
6075 6076 6077 6078 6079 6080 6081 |
set l ""
} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
set f [open $path(test1) r]
| | | 6129 6130 6131 6132 6133 6134 6135 6136 6137 6138 6139 6140 6141 6142 6143 |
set l ""
} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
chan close $f
} else {
lappend l [chan gets $f]
incr c
|
| ︙ | ︙ | |||
6099 6100 6101 6102 6103 6104 6105 |
set l ""
} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
set f [open $path(test1) r]
| | | 6153 6154 6155 6156 6157 6158 6159 6160 6161 6162 6163 6164 6165 6166 6167 |
set l ""
} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
chan close $f
} else {
lappend l [chan gets $f]
incr c
|
| ︙ | ︙ | |||
6123 6124 6125 6126 6127 6128 6129 |
set l ""
} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
set f [open $path(test1) r]
| | | 6177 6178 6179 6180 6181 6182 6183 6184 6185 6186 6187 6188 6189 6190 6191 |
set l ""
} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation lf -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
chan close $f
} else {
lappend l [chan gets $f]
incr c
|
| ︙ | ︙ | |||
6147 6148 6149 6150 6151 6152 6153 |
set l ""
} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
set f [open $path(test1) r]
| | | 6201 6202 6203 6204 6205 6206 6207 6208 6209 6210 6211 6212 6213 6214 6215 |
set l ""
} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation lf -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
chan close $f
} else {
lappend l [chan gets $f]
incr c
|
| ︙ | ︙ | |||
6171 6172 6173 6174 6175 6176 6177 |
set l ""
} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation cr
chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
set f [open $path(test1) r]
| | | 6225 6226 6227 6228 6229 6230 6231 6232 6233 6234 6235 6236 6237 6238 6239 |
set l ""
} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation cr
chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation cr -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
chan close $f
} else {
lappend l [chan gets $f]
incr c
|
| ︙ | ︙ | |||
6195 6196 6197 6198 6199 6200 6201 |
set l ""
} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation cr
chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
set f [open $path(test1) r]
| | | 6249 6250 6251 6252 6253 6254 6255 6256 6257 6258 6259 6260 6261 6262 6263 |
set l ""
} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation cr
chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation cr -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
chan close $f
} else {
lappend l [chan gets $f]
incr c
|
| ︙ | ︙ | |||
6219 6220 6221 6222 6223 6224 6225 |
set l ""
} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
set f [open $path(test1) r]
| | | 6273 6274 6275 6276 6277 6278 6279 6280 6281 6282 6283 6284 6285 6286 6287 |
set l ""
} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation crlf -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
chan close $f
} else {
lappend l [chan gets $f]
incr c
|
| ︙ | ︙ | |||
6243 6244 6245 6246 6247 6248 6249 |
set l ""
} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
set f [open $path(test1) r]
| | | 6297 6298 6299 6300 6301 6302 6303 6304 6305 6306 6307 6308 6309 6310 6311 |
set l ""
} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation crlf -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
chan close $f
} else {
lappend l [chan gets $f]
incr c
|
| ︙ | ︙ | |||
6780 6781 6782 6783 6784 6785 6786 |
# 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
| | | 6834 6835 6836 6837 6838 6839 6840 6841 6842 6843 6844 6845 6846 6847 6848 |
# 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
chan puts $out "АА"
chan close $out
test chan-io-52.9 {TclCopyChannel & encodings} {fcopy} {
# Copy kyrillic to UTF-8, using chan copy.
set in [open $path(kyrillic.txt) r]
set out [open $path(utf8-fcopy.txt) w]
chan configure $in -encoding koi8-r -translation lf
chan configure $out -encoding utf-8 -translation lf
|
| ︙ | ︙ | |||
6818 6819 6820 6821 6822 6823 6824 |
chan close $in
chan close $out
file size $path(utf8-fcopy.txt)
} 5
test chan-io-52.11 {TclCopyChannel & encodings} -setup {
set f [open $path(utf8-fcopy.txt) w]
fconfigure $f -encoding utf-8 -translation lf
| | | 6872 6873 6874 6875 6876 6877 6878 6879 6880 6881 6882 6883 6884 6885 6886 |
chan close $in
chan close $out
file size $path(utf8-fcopy.txt)
} 5
test chan-io-52.11 {TclCopyChannel & encodings} -setup {
set f [open $path(utf8-fcopy.txt) w]
fconfigure $f -encoding utf-8 -translation lf
puts $f "АА"
close $f
} -constraints {fcopy} -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]
# -translation binary is also -encoding binary
|
| ︙ | ︙ | |||
7492 7493 7494 7495 7496 7497 7498 |
} {1}
test chan-io-60.1 {writing illegal utf sequences} {fileevent testbytestring} {
# This test will hang in older revisions of the core.
set out [open $path(script) w]
chan puts $out "catch {load $::tcltestlib Tcltest}"
chan puts $out {
| | | 7546 7547 7548 7549 7550 7551 7552 7553 7554 7555 7556 7557 7558 7559 7560 |
} {1}
test chan-io-60.1 {writing illegal utf sequences} {fileevent testbytestring} {
# This test will hang in older revisions of the core.
set out [open $path(script) w]
chan puts $out "catch {load $::tcltestlib Tcltest}"
chan puts $out {
chan puts [testbytestring \xE2]
exit 1
}
proc readit {pipe} {
variable x
variable result
if {[chan eof $pipe]} {
set x [catch {chan close $pipe} line]
|
| ︙ | ︙ | |||
7515 7516 7517 7518 7519 7520 7521 |
chan event $pipe readable [namespace code [list readit $pipe]]
variable x ""
set result ""
vwait [namespace which -variable x]
# cut of the remainder of the error stack, especially the filename
set result [lreplace $result 3 3 [lindex [split [lindex $result 3] \n] 0]]
list $x $result
| | | 7569 7570 7571 7572 7573 7574 7575 7576 7577 7578 7579 7580 7581 7582 7583 |
chan event $pipe readable [namespace code [list readit $pipe]]
variable x ""
set result ""
vwait [namespace which -variable x]
# cut of the remainder of the error stack, especially the filename
set result [lreplace $result 3 3 [lindex [split [lindex $result 3] \n] 0]]
list $x $result
} {1 {gets {} catch {error writing "stdout": illegal byte sequence}}}
test chan-io-61.1 {Reset eof state after changing the eof char} -setup {
set datafile [makeFile {} eofchar]
set f [open $datafile w]
chan configure $f -translation binary
chan puts -nonewline $f [string repeat "Ho hum\n" 11]
chan puts $f =
|
| ︙ | ︙ |
Changes to tests/clock.test.
| ︙ | ︙ | |||
230 231 232 233 234 235 236 | sLongDate "'the' dd''' day of' MMMM yyyy" \ sTimeFormat "h:mm:ss tt"] \ HKEY_LOCAL_MACHINE\\System\\CurrentControlSet\\Control\\TimeZoneInformation \ [dict create \ Bias 300 \ StandardBias 0 \ DaylightBias -60 \ | | | 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 |
sLongDate "'the' dd''' day of' MMMM yyyy" \
sTimeFormat "h:mm:ss tt"] \
HKEY_LOCAL_MACHINE\\System\\CurrentControlSet\\Control\\TimeZoneInformation \
[dict create \
Bias 300 \
StandardBias 0 \
DaylightBias -60 \
StandardStart \x00\x00\x0B\x00\x01\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00 \
DaylightStart \x00\x00\x03\x00\x02\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00]]
}
proc ::testClock::registry { cmd path key } {
variable reg
if { $cmd ne {get} } {
|
| ︙ | ︙ | |||
36785 36786 36787 36788 36789 36790 36791 |
}
return $retval
}
}
-body {
set trouble {}
foreach {date jdate} {
| | | | | | | | | | | | 36785 36786 36787 36788 36789 36790 36791 36792 36793 36794 36795 36796 36797 36798 36799 36800 36801 36802 36803 36804 36805 36806 36807 36808 |
}
return $retval
}
}
-body {
set trouble {}
foreach {date jdate} {
1872-12-31 西暦1872年12月31日
1873-01-01 明治06年01月01日
1912-07-29 明治45年07月29日
1912-07-30 大正01年07月30日
1926-12-24 大正15年12月24日
1926-12-25 昭和01年12月25日
1989-01-07 昭和64年01月07日
1989-01-08 平成01年01月08日
2019-04-30 平成31年04月30日
2019-05-01 令和01年05月01日
} {
set status [catch {
set secs [clock scan $date \
-timezone +0900 \
-locale ja_JP \
-format %Y-%m-%d]
set jda [clock format $secs \
|
| ︙ | ︙ |
Changes to tests/cmdAH.test.
| ︙ | ︙ | |||
145 146 147 148 149 150 151 |
pwd
} -cleanup {
cd $dir
} -result {/}
test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -setup {
set dir [pwd]
} -returnCodes error -body {
| | | | 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 |
pwd
} -cleanup {
cd $dir
} -result {/}
test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -setup {
set dir [pwd]
} -returnCodes error -body {
cd .\x00
} -cleanup {
cd $dir
} -match glob -result "couldn't change working directory to \".\x00\": *"
test cmdAH-2.7 {Tcl_ConcatObjCmd} {
concat
} {}
test cmdAH-2.8 {Tcl_ConcatObjCmd} {
concat a
} a
test cmdAH-2.9 {Tcl_ConcatObjCmd} {
|
| ︙ | ︙ | |||
182 183 184 185 186 187 188 |
test cmdAH-4.4 {Tcl_EncodingObjCmd} -returnCodes error -body {
encoding convertto foo bar
} -result {unknown encoding "foo"}
test cmdAH-4.5 {Tcl_EncodingObjCmd} -setup {
set system [encoding system]
} -body {
encoding system jis0208
| | | | | | 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 |
test cmdAH-4.4 {Tcl_EncodingObjCmd} -returnCodes error -body {
encoding convertto foo bar
} -result {unknown encoding "foo"}
test cmdAH-4.5 {Tcl_EncodingObjCmd} -setup {
set system [encoding system]
} -body {
encoding system jis0208
encoding convertto 乎
} -cleanup {
encoding system $system
} -result 8C
test cmdAH-4.6 {Tcl_EncodingObjCmd} -setup {
set system [encoding system]
} -body {
encoding system iso8859-1
encoding convertto jis0208 乎
} -cleanup {
encoding system $system
} -result 8C
test cmdAH-4.7 {Tcl_EncodingObjCmd} -returnCodes error -body {
encoding convertfrom
} -result {wrong # args: should be "encoding convertfrom ?encoding? data"}
test cmdAH-4.8 {Tcl_EncodingObjCmd} -returnCodes error -body {
encoding convertfrom foo bar
} -result {unknown encoding "foo"}
test cmdAH-4.9 {Tcl_EncodingObjCmd} -setup {
set system [encoding system]
} -body {
encoding system jis0208
encoding convertfrom 8C
} -cleanup {
encoding system $system
} -result 乎
test cmdAH-4.10 {Tcl_EncodingObjCmd} -setup {
set system [encoding system]
} -body {
encoding system iso8859-1
encoding convertfrom jis0208 8C
} -cleanup {
encoding system $system
} -result 乎
test cmdAH-4.11 {Tcl_EncodingObjCmd} -returnCodes error -body {
encoding names foo
} -result {wrong # args: should be "encoding names"}
test cmdAH-4.12 {Tcl_EncodingObjCmd} -returnCodes error -body {
encoding system foo bar
} -result {wrong # args: should be "encoding system ?encoding?"}
test cmdAH-4.13 {Tcl_EncodingObjCmd} -setup {
|
| ︙ | ︙ | |||
1217 1218 1219 1220 1221 1222 1223 |
set modmtime [file mtime $file $newmtime]
expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"}
} 1
test cmdAH-24.9 {Tcl_FileObjCmd: mtime touch with non-ascii chars} -setup {
set oldfile $file
} -constraints unix -body {
# introduce some non-ascii characters.
| | | 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 |
set modmtime [file mtime $file $newmtime]
expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"}
} 1
test cmdAH-24.9 {Tcl_FileObjCmd: mtime touch with non-ascii chars} -setup {
set oldfile $file
} -constraints unix -body {
# introduce some non-ascii characters.
append file •
file delete -force $file
file rename $oldfile $file
set mtime [file mtime $file]
after 1100; # pause a sec to notice change in mtime
set newmtime [clock seconds]
set modmtime [file mtime $file $newmtime]
expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"}
|
| ︙ | ︙ | |||
1242 1243 1244 1245 1246 1247 1248 |
expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"}
} -result 1
test cmdAH-24.11 {Tcl_FileObjCmd: mtime touch with non-ascii chars} -setup {
waitForEvenSecondForFAT
set oldfile $file
} -constraints win -body {
# introduce some non-ascii characters.
| | | 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 |
expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"}
} -result 1
test cmdAH-24.11 {Tcl_FileObjCmd: mtime touch with non-ascii chars} -setup {
waitForEvenSecondForFAT
set oldfile $file
} -constraints win -body {
# introduce some non-ascii characters.
append file •
file delete -force $file
file rename $oldfile $file
set mtime [file mtime $file]
after 2100; # pause two secs to notice change in mtime on FAT fs'es
set newmtime [clock seconds]
set modmtime [file mtime $file $newmtime]
expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"}
|
| ︙ | ︙ |
Changes to tests/cmdIL.test.
| ︙ | ︙ | |||
147 148 149 150 151 152 153 |
test cmdIL-1.36 {lsort -stride and -index: Bug 2918962} {
lsort -stride 2 -index {0 1} {
{{c o d e} 54321} {{b l a h} 94729}
{{b i g} 12345} {{d e m o} 34512}
}
} {{{b i g} 12345} {{d e m o} 34512} {{c o d e} 54321} {{b l a h} 94729}}
test cmdIL-1.37 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
| | | | | | | | | | | 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 |
test cmdIL-1.36 {lsort -stride and -index: Bug 2918962} {
lsort -stride 2 -index {0 1} {
{{c o d e} 54321} {{b l a h} 94729}
{{b i g} 12345} {{d e m o} 34512}
}
} {{{b i g} 12345} {{d e m o} 34512} {{c o d e} 54321} {{b l a h} 94729}}
test cmdIL-1.37 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
lsort -ascii [list \x00 \x7F \x80 \uFFFF]
} [list \x00 \x7F \x80 \uFFFF]
test cmdIL-1.38 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
lsort -ascii -nocase [list \x00 \x7F \x80 \uFFFF]
} [list \x00 \x7F \x80 \uFFFF]
test cmdIL-1.39 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
lsort -ascii [list \x00 \x7F \x80 \U01ffff \uFFFF]
} [list \x00 \x7F \x80 \uFFFF \U01ffff]
test cmdIL-1.40 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
lsort -ascii -nocase [list \x00 \x7F \x80 \U01ffff \uFFFF]
} [list \x00 \x7F \x80 \uFFFF \U01FFFF]
test cmdIL-1.41 {lsort -stride and -index} -body {
lsort -stride 2 -index -2 {a 2 b 1}
} -returnCodes error -result {index "-2" out of range}
test cmdIL-1.42 {lsort -stride and-index} -body {
lsort -stride 2 -index -1-1 {a 2 b 1}
} -returnCodes error -result {index "-1-1" out of range}
# Can't think of any good tests for the MergeSort and MergeLists procedures,
# except a bunch of random lists to sort.
test cmdIL-2.1 {MergeSort and MergeLists procedures} -setup {
set result {}
set r 1435753299
proc rand {} {
global r
set r [expr {(16807 * $r) % (0x7FFFFFFF)}]
}
} -body {
for {set i 0} {$i < 150} {incr i} {
set x {}
for {set j 0} {$j < $i} {incr j} {
lappend x [expr {[rand] & 0xfff}]
}
|
| ︙ | ︙ | |||
392 393 394 395 396 397 398 |
lsort -dictionary {ABcd aBCd}
} {ABcd aBCd}
test cmdIL-4.23 {DictionaryCompare procedure, case} {
lsort -dictionary {ABcd AbCd}
} {ABcd AbCd}
test cmdIL-4.24 {DictionaryCompare procedure, international characters} {hasIsoLocale} {
::tcltest::set_iso8859_1_locale
| | | | | | 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 |
lsort -dictionary {ABcd aBCd}
} {ABcd aBCd}
test cmdIL-4.23 {DictionaryCompare procedure, case} {
lsort -dictionary {ABcd AbCd}
} {ABcd AbCd}
test cmdIL-4.24 {DictionaryCompare procedure, international characters} {hasIsoLocale} {
::tcltest::set_iso8859_1_locale
set result [lsort -dictionary "a b c A B C ã Ä"]
::tcltest::restore_locale
set result
} "A a B b C c ã Ä"
test cmdIL-4.25 {DictionaryCompare procedure, international characters} {hasIsoLocale} {
::tcltest::set_iso8859_1_locale
set result [lsort -dictionary "a23ã a23Å a23ä"]
::tcltest::restore_locale
set result
} "a23ã a23ä a23Å"
test cmdIL-4.26 {DefaultCompare procedure, signed characters} {
set l [lsort [list "abc\200" "abc"]]
set viewlist {}
foreach s $l {
set viewelem ""
set len [string length $s]
for {set i 0} {$i < $len} {incr i} {
|
| ︙ | ︙ | |||
468 469 470 471 472 473 474 |
test cmdIL-4.35 {SortCompare procedure, -ascii option with -nocase option} {
lsort -ascii -nocase {d E c B a D35 d300 100 20}
} {100 20 a B c d d300 D35 E}
test cmdIL-4.36 {SortCompare procedure, UTF-8 with -nocase option} {
scan [lsort -ascii -nocase [list \u101 \u100]] %c%c%c
} {257 32 256}
test cmdIL-4.37 {SortCompare procedure, UTF-8 with -nocase option} {
| | | | 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 |
test cmdIL-4.35 {SortCompare procedure, -ascii option with -nocase option} {
lsort -ascii -nocase {d E c B a D35 d300 100 20}
} {100 20 a B c d d300 D35 E}
test cmdIL-4.36 {SortCompare procedure, UTF-8 with -nocase option} {
scan [lsort -ascii -nocase [list \u101 \u100]] %c%c%c
} {257 32 256}
test cmdIL-4.37 {SortCompare procedure, UTF-8 with -nocase option} {
scan [lsort -ascii -nocase [list a\x00a a]] %c%c%c%c%c
} {97 32 97 0 97}
test cmdIL-4.38 {SortCompare procedure, UTF-8 with -nocase option} {
scan [lsort -ascii -nocase [list a a\x00a]] %c%c%c%c%c
} {97 32 97 0 97}
test cmdIL-5.1 {lsort with list style index} {
lsort -ascii -decreasing -index {0 1} {
{{Jim Alpha} 20000410}
{{Joe Bravo} 19990320}
{{Jacky Charlie} 19390911}
|
| ︙ | ︙ | |||
772 773 774 775 776 777 778 |
} {f e {c d} b a}
test cmdIL-7.6 {lreverse command - unshared object [Bug 1672585]} {
lreverse [set x {1 2 3}][unset x]
} {3 2 1}
test cmdIL-7.7 {lreverse command - empty object [Bug 1876793]} {
lreverse [list]
} {}
| | | 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 |
} {f e {c d} b a}
test cmdIL-7.6 {lreverse command - unshared object [Bug 1672585]} {
lreverse [set x {1 2 3}][unset x]
} {3 2 1}
test cmdIL-7.7 {lreverse command - empty object [Bug 1876793]} {
lreverse [list]
} {}
test cmdIL-7.8 {lreverse command - shared internalrep [Bug 1675044]} -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
proc K {a b} {return $a}
|
| ︙ | ︙ |
Changes to tests/cmdMZ.test.
| ︙ | ︙ | |||
295 296 297 298 299 300 301 |
append x $f
}
return $x
}}
} {]\n}
test cmdMZ-4.11 {Tcl_SplitObjCmd: basic split commands} {
apply {{} {
| | | | | | | 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 |
append x $f
}
return $x
}}
} {]\n}
test cmdMZ-4.11 {Tcl_SplitObjCmd: basic split commands} {
apply {{} {
set x ab\x00c
set y [split $x {}]
binary scan $y c* z
return $z
}}
} {97 32 98 32 0 32 99}
test cmdMZ-4.12 {Tcl_SplitObjCmd: basic split commands} {
split "a0ab1b2bbb3\x00c4" ab\x00c
} {{} 0 {} 1 2 {} {} 3 {} 4}
test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} {
# if not UTF-8 aware, result is "a {} {} b qwå {} N wq"
split "a乎b qw幎N wq" " 乎"
} "a b qw幎N wq"
# The tests for Tcl_StringObjCmd are in string.test
# The tests for Tcl_SubstObjCmd are in subst.test
# The tests for Tcl_SwitchObjCmd are in switch.test
# todo: rewrite this if monotonic clock is provided resp. command "after"
# gets microsecond accuracy (RFE [fdfbd5e10] gets merged):
|
| ︙ | ︙ |
Changes to tests/compExpr-old.test.
| ︙ | ︙ | |||
25 26 27 28 29 30 31 |
proc testIEEE {} {
variable ieeeValues
binary scan [binary format dd -1.0 1.0] c* c
switch -exact -- $c {
{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
# little endian
| | | | | | | | | | | | 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 |
proc testIEEE {} {
variable ieeeValues
binary scan [binary format dd -1.0 1.0] c* c
switch -exact -- $c {
{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
# little endian
binary scan \x00\x00\x00\x00\x00\x00\xF0\xFF d \
ieeeValues(-Infinity)
binary scan \x00\x00\x00\x00\x00\x00\xF0\xBF d \
ieeeValues(-Normal)
binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \
ieeeValues(-Subnormal)
binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \
ieeeValues(-0)
binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+0)
binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \
ieeeValues(+Subnormal)
binary scan \x00\x00\x00\x00\x00\x00\xF0\x3F d \
ieeeValues(+Normal)
binary scan \x00\x00\x00\x00\x00\x00\xF0\x7F d \
ieeeValues(+Infinity)
binary scan \x00\x00\x00\x00\x00\x00\xF8\x7F d \
ieeeValues(NaN)
set ieeeValues(littleEndian) 1
return 1
}
{-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} {
binary scan \xFF\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Infinity)
binary scan \xBF\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Normal)
binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Subnormal)
binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-0)
binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+0)
binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Subnormal)
binary scan \x3F\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Normal)
binary scan \x7F\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Infinity)
binary scan \x7F\xF8\x00\x00\x00\x00\x00\x00 d \
ieeeValues(NaN)
set ieeeValues(littleEndian) 0
return 1
}
default {
return 0
}
|
| ︙ | ︙ |
Changes to tests/compile.test.
| ︙ | ︙ | |||
282 283 284 285 286 287 288 |
set j [incr i]
if {$j > 3} break
}
set j
} {4}
test compile-8.1 {CollectArgInfo: binary data} {
| | | | 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 |
set j [incr i]
if {$j > 3} break
}
set j
} {4}
test compile-8.1 {CollectArgInfo: binary data} {
list [catch "string length \x00foo" msg] $msg
} {0 4}
test compile-8.2 {CollectArgInfo: binary data} {
list [catch "string length foo\x00" msg] $msg
} {0 4}
test compile-8.3 {CollectArgInfo: handle "]" at end of command properly} {
set x ]
} {]}
test compile-9.1 {UpdateStringOfByteCode: called for duplicate of compiled empty object} {
proc p {} {
|
| ︙ | ︙ | |||
496 497 498 499 500 501 502 |
interp recursionlimit ti [expr {10000+50}]
ti eval {set result {}}
} -body {
# Test different compilation variants (instructions evalStk, invokeStk, etc),
# with 1500 (1000 in debug) nested scripts (bodies). If you get SO/SF exceptions on some low-stack
# boxes or systems, please don't decrease it (either provide a constraint)
ti eval {foreach cmd {eval "if 1" try catch} {
| | | 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 |
interp recursionlimit ti [expr {10000+50}]
ti eval {set result {}}
} -body {
# Test different compilation variants (instructions evalStk, invokeStk, etc),
# with 1500 (1000 in debug) nested scripts (bodies). If you get SO/SF exceptions on some low-stack
# boxes or systems, please don't decrease it (either provide a constraint)
ti eval {foreach cmd {eval "if 1" try catch} {
set c [gencode [expr {[tcl::build-info debug] ? 1500 : 1000}] $cmd]
if 1 $c
}}
ti eval {set result}
} -result {1 1 1 1}
test compile-13.3 {TclCompileScript: testing check of max depth by nested scripts compilation} -setup {
_ti_gencode
interp recursionlimit ti 100
|
| ︙ | ︙ |
Changes to tests/config.test.
| ︙ | ︙ | |||
15 16 17 18 19 20 21 |
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
test pkgconfig-1.1 {query keys} -body {
lsort [::tcl::pkgconfig list]
| | | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 |
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
test pkgconfig-1.1 {query keys} -body {
lsort [::tcl::pkgconfig list]
} -match glob -result {*bindir,install bindir,runtime*docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime*scriptdir,install scriptdir,runtime*}
test pkgconfig-1.2 {query keys multiple times} {
string compare [::tcl::pkgconfig list] [::tcl::pkgconfig list]
} 0
test pkgconfig-1.3 {query value multiple times} {
string compare \
[::tcl::pkgconfig get bindir,install] \
[::tcl::pkgconfig get bindir,install]
|
| ︙ | ︙ |
Changes to tests/coroutine.test.
| ︙ | ︙ | |||
750 751 752 753 754 755 756 757 758 759 760 761 762 763 |
C ; # and called at level 1
}
boom ; # does not crash: the coro floor is a good insulator
list
} -cleanup {
rename boom {}; rename cc {}; rename c {}
} -result {}
test coroutine-8.0.0 {coro inject executed} -body {
coroutine demo apply {{} { foreach i {1 2} yield }}
demo
set ::result none
tcl::unsupported::inject demo set ::result inject-executed
demo
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 |
C ; # and called at level 1
}
boom ; # does not crash: the coro floor is a good insulator
list
} -cleanup {
rename boom {}; rename cc {}; rename c {}
} -result {}
test coroutine-7.13 {
issue f9800d52bd61f240
vwait is not NRE-enabled, and yieldto cannot find the right splicing spot
} -body {
coroutine c0 apply [list {} {
variable done
yield
yieldto c1
after 0 c2
vwait [namespace current]::done
} [namespace current]]
coroutine c1 apply [list {} {
yield
tailcall c0
} [namespace current]]
coroutine c2 apply [list {} {
variable done
yield
yieldto try {yieldto c1} on error {} [list after 0 [list [info coroutine]]]
yieldto try {yieldto c1} on error {} [list after 0 [list [info coroutine]]]
set done 1
} [namespace current]]
after 0 [list [namespace which c0]]
vwait [namespace current]::done
return $done
} -result 1
test coroutine-7.14 {
issue 5106fddd4400e5b9
failure to yieldto is not the same thing as not calling yieldto in the
first place
} -body {
variable done
variable done1
coroutine c0 ::apply [list {} {
yield
after 0 [list [namespace which c1]]
vwait [namespace current]::done1
} [namespace current]]
coroutine c1 ::apply [list {} {
variable done1
yield
yieldto try "yieldto [list [info coroutine]]" on error {} "
::set [list [namespace current]]::done1 failure
::set [list [namespace current]]::done0 failure
"
set done1 success
} [namespace current]]
after 1 [list [namespace which c0]]
vwait [namespace current]::done0
if {[namespace which [namespace current]::c1] ne {}} {
# prior to the fix for 5106fddd4400e5b9, the nested yieldto turned into a
# tailcall which was eventutally activated, causing control to return to
# c1. After the fix, that doesn't happen, so if c1 still exists call it
# one final time to allow it to finish and clean up
rename c1 {}
}
return [list $done0 $done1]
} -result {failure failure}
test coroutine-8.0.0 {coro inject executed} -body {
coroutine demo apply {{} { foreach i {1 2} yield }}
demo
set ::result none
tcl::unsupported::inject demo set ::result inject-executed
demo
|
| ︙ | ︙ |
Changes to tests/encoding.test.
| ︙ | ︙ | |||
179 180 181 182 183 184 185 |
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
| | | 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 |
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
|
| ︙ | ︙ | |||
215 216 217 218 219 220 221 |
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
| | | | 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 |
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"
proc viewable {str} {
set res ""
foreach c [split $str {}] {
if {[string is print $c] && [string is ascii $c]} {
append res $c
} else {
append res "\\u[format %4.4X [scan $c %c]]"
}
}
return "$str ($res)"
}
test encoding-11.1 {LoadEncodingFile: unknown encoding} {testencoding} {
set system [encoding system]
|
| ︙ | ︙ | |||
254 255 256 257 258 259 260 |
encoding convertfrom shiftjis \x8C\xC1
} 乎
test encoding-11.5 {LoadEncodingFile: escape file} {
viewable [encoding convertto iso2022 乎]
} [viewable "\x1B\$B8C\x1B(B"]
test encoding-11.5.1 {LoadEncodingFile: escape file} {
viewable [encoding convertto iso2022-jp 乎]
| | | 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 |
encoding convertfrom shiftjis \x8C\xC1
} 乎
test encoding-11.5 {LoadEncodingFile: escape file} {
viewable [encoding convertto iso2022 乎]
} [viewable "\x1B\$B8C\x1B(B"]
test encoding-11.5.1 {LoadEncodingFile: escape file} {
viewable [encoding convertto iso2022-jp 乎]
} [viewable "\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]
|
| ︙ | ︙ | |||
279 280 281 282 283 284 285 |
removeDirectory tmp
cd [workingDirectory]
encoding dirs $path
encoding system $system
} -result {invalid encoding file "splat"}
test encoding-11.8 {encoding: extended Unicode UTF-16} {
viewable [encoding convertto utf-16le 😹]
| | | > > > > > > | | | | | | | | | | 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 |
removeDirectory tmp
cd [workingDirectory]
encoding dirs $path
encoding system $system
} -result {invalid encoding file "splat"}
test encoding-11.8 {encoding: extended Unicode UTF-16} {
viewable [encoding convertto utf-16le 😹]
} {=Ø9Þ (=\u00D89\u00DE)}
test encoding-11.9 {encoding: extended Unicode UTF-16} {
viewable [encoding convertto utf-16be 😹]
} {Ø=Þ9 (\u00D8=\u00DE9)}
test encoding-11.10 {encoding: extended Unicode UTF-32} {
viewable [encoding convertto utf-32le 😹]
} "9\xF6\x01\x00 (9\\u00F6\\u0001\\u0000)"
test encoding-11.11 {encoding: extended Unicode UTF-32} {
viewable [encoding convertto utf-32be 😹]
} "\x00\x01\xF69 (\\u0000\\u0001\\u00F69)"
# 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 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} {
viewable [set x [encoding convertto iso2022 ab乎棙g]]
} [viewable "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]]
|
| ︙ | ︙ | |||
347 348 349 350 351 352 353 |
test encoding-15.7 {UtfToUtfProc emoji character output} {
set x \uDE02\uD83D\uD83D
set y [encoding convertto 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} {
| | | | | | | | 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 |
test encoding-15.7 {UtfToUtfProc emoji character output} {
set x \uDE02\uD83D\uD83D
set y [encoding convertto 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 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 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 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 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 utf-8 \uDE02Y]
binary scan $y H* z
|
| ︙ | ︙ | |||
405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 |
} "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-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 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]]
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | > > > > > > > > | | | | | | | | > > > > > > | | | | | | < < > > | < > | 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 |
} "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-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 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-17.1 {UtfToUtf16Proc} -body {
encoding convertto utf-16 "\U460DC"
} -result "\xD8\xD8\xDC\xDC"
test encoding-17.2 {UtfToUcs2Proc} -body {
encoding convertfrom utf-16 [encoding convertto ucs-2 "\U460DC"]
} -result "\uFFFD"
test encoding-17.3 {UtfToUtf16Proc} -body {
encoding convertto utf-16be "\uDCDC"
} -result "\xFF\xFD"
test encoding-17.4 {UtfToUtf16Proc} -body {
encoding convertto utf-16le "\uD8D8"
} -result "\xFD\xFF"
test encoding-17.5 {UtfToUtf16Proc} -body {
encoding convertto utf-32le "\U460DC"
} -result "\xDC\x60\x04\x00"
test encoding-17.6 {UtfToUtf16Proc} -body {
encoding convertto utf-32be "\U460DC"
} -result "\x00\x04\x60\xDC"
test encoding-18.1 {TableToUtfProc} {
} {}
test encoding-19.1 {TableFromUtfProc} {
} {}
test encoding-20.1 {TableFreefProc} {
} {}
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 )までご住所変更済の連絡をいただけないで
しょうか?"
cd [temporaryDirectory]
set fid [open iso2022.txt w]
fconfigure $fid -encoding binary
puts -nonewline $fid $iso2022encData
close $fid
|
| ︙ | ︙ | |||
535 536 537 538 539 540 541 |
viewable [runInSubprocess {
encoding system cp1252; # Bug #2891556 crash revelator
fconfigure stdout -encoding iso2022-jp
puts ab乎棙g
set env(TCL_FINALIZE_ON_EXIT) 1
exit
}]
| | | | 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 |
viewable [runInSubprocess {
encoding system cp1252; # Bug #2891556 crash revelator
fconfigure stdout -encoding iso2022-jp
puts ab乎棙g
set env(TCL_FINALIZE_ON_EXIT) 1
exit
}]
} "ab\x1B\$B8C\x1B\$(DD%\x1B(Bg (ab\\u001B\$B8C\\u001B\$(DD%\\u001B(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 [viewable $line]
} [list 3 "乎乞也 (\\u4E4E\\u4E5E\\u4E5F)"]
test encoding-24.4 {Parse valid or invalid utf-8} {
string length [encoding convertfrom utf-8 "\xC0\x80"]
} 1
test encoding-24.5 {Parse valid or invalid utf-8} {
string length [encoding convertfrom utf-8 "\xC0\x81"]
} 2
|
| ︙ | ︙ | |||
628 629 630 631 632 633 634 |
} else {
error "really?"
}
}
}
proc gen-jisx0208-euc-jp {code} {
binary format cc \
| | | | | | | 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 |
} else {
error "really?"
}
}
}
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))}]
} else {
set c1 [expr {($c1 >> 1) + ($c1 < 0xDF ? 0x30 : 0x70)}]
incr c2 -2
}
binary format cc $c1 $c2
}
proc channel-diff {fa fb} {
set diff {}
while {[gets $fa la] >= 0 && [gets $fb lb] >= 0} {
|
| ︙ | ︙ | |||
738 739 740 741 742 743 744 | encoding convertto $name $string # discard the cached internal representation of Tcl_Encoding # Unfortunately, without this, encoding 2-1 fails. llength $name } return $count | | | 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 |
encoding convertto $name $string
# discard the cached internal representation of Tcl_Encoding
# Unfortunately, without this, encoding 2-1 fails.
llength $name
}
return $count
} -result [expr {[info exists ::tcl_precision] ? 92 : 91}]
runtests
}
# cleanup
namespace delete ::tcl::test::encoding
::tcltest::cleanupTests
return
# Local Variables:
# mode: tcl
# End:
|
Changes to tests/env.test.
| ︙ | ︙ | |||
102 103 104 105 106 107 108 |
variable keep {
TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING MSYSTEM
__CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
CommonProgramFiles CommonProgramFiles(x86) ProgramFiles
ProgramFiles(x86) CommonProgramW6432 ProgramW6432
| | | 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 |
variable keep {
TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING MSYSTEM
__CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
CommonProgramFiles CommonProgramFiles(x86) ProgramFiles
ProgramFiles(x86) CommonProgramW6432 ProgramW6432
WINECONFIGDIR WINEDATADIR WINEDLLDIR0 WINEHOMEDIR PROCESSOR_ARCHITECTURE
}
variable printenvScript [makeFile [string map [list @keep@ [list $keep]] {
encoding system iso8859-1
proc lrem {listname name} {
upvar $listname list
set i [lsearch -nocase $list $name]
|
| ︙ | ︙ |
Changes to tests/exec.test.
| ︙ | ︙ | |||
165 166 167 168 169 170 171 |
exec [interpreter] $path(cat) "<<Joined to arrows"
} {Joined to arrows}
test exec-2.6 {redirecting input from immediate source, with UTF} -setup {
set sysenc [encoding system]
encoding system iso8859-1
proc quotenonascii s {
regsub -all {\[|\\|\]} $s {\\&} s
| | | | | | | 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 |
exec [interpreter] $path(cat) "<<Joined to arrows"
} {Joined to arrows}
test exec-2.6 {redirecting input from immediate source, with UTF} -setup {
set sysenc [encoding system]
encoding system iso8859-1
proc quotenonascii s {
regsub -all {\[|\\|\]} $s {\\&} s
regsub -all "\[\x7F-\xFF\]" $s \
{[apply {c {format {\x%02X} [scan $c %c]}} &]} s
return [subst -novariables $s]
}
} -constraints {exec} -body {
# If this fails, it may give back: "\xC3\xA9\xC3\xA0\xC3\xBC\xC3\xB1"
# If it does, this means that the UTF -> external conversion did not occur
# before writing out the temp file.
quotenonascii [exec [interpreter] $path(cat) << "\xE9\xE0\xFC\xF1"]
} -cleanup {
encoding system $sysenc
rename quotenonascii {}
} -result {\xE9\xE0\xFC\xF1}
# I/O redirection: output to file.
set path(gorp.file) [makeFile {} gorp.file]
file delete $path(gorp.file)
test exec-3.1 {redirecting output to file} {exec} {
|
| ︙ | ︙ |
Changes to tests/execute.test.
| ︙ | ︙ | |||
1062 1063 1064 1065 1066 1067 1068 |
} else {
set result SUCCESS
}
set result
} SUCCESS
test execute-10.1 {TclExecuteByteCode, INST_CONCAT1, bytearrays} {
| | | 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 |
} else {
set result SUCCESS
}
set result
} SUCCESS
test execute-10.1 {TclExecuteByteCode, INST_CONCAT1, bytearrays} {
apply {s {binary scan $s c x; list $x [scan $s$s %c%c]}} İ
} {48 {304 304}}
test execute-10.2 {Bug 2802881} -setup {
interp create child
} -body {
# If [Bug 2802881] is not fixed, this will segfault
child eval {
trace add variable ::errorInfo write {expr {$foo} ;#}
|
| ︙ | ︙ |
Changes to tests/expr-old.test.
| ︙ | ︙ | |||
31 32 33 34 35 36 37 |
proc testIEEE {} {
variable ieeeValues
binary scan [binary format dd -1.0 1.0] c* c
switch -exact -- $c {
{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
# little endian
| | | | | | | | | | | | 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 |
proc testIEEE {} {
variable ieeeValues
binary scan [binary format dd -1.0 1.0] c* c
switch -exact -- $c {
{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
# little endian
binary scan \x00\x00\x00\x00\x00\x00\xF0\xFF d \
ieeeValues(-Infinity)
binary scan \x00\x00\x00\x00\x00\x00\xF0\xBF d \
ieeeValues(-Normal)
binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \
ieeeValues(-Subnormal)
binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \
ieeeValues(-0)
binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+0)
binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \
ieeeValues(+Subnormal)
binary scan \x00\x00\x00\x00\x00\x00\xF0\x3F d \
ieeeValues(+Normal)
binary scan \x00\x00\x00\x00\x00\x00\xF0\x7F d \
ieeeValues(+Infinity)
binary scan \x00\x00\x00\x00\x00\x00\xF8\x7F d \
ieeeValues(NaN)
set ieeeValues(littleEndian) 1
return 1
}
{-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} {
binary scan \xFF\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Infinity)
binary scan \xBF\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Normal)
binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Subnormal)
binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-0)
binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+0)
binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Subnormal)
binary scan \x3F\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Normal)
binary scan \x7F\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Infinity)
binary scan \x7F\xF8\x00\x00\x00\x00\x00\x00 d \
ieeeValues(NaN)
set ieeeValues(littleEndian) 0
return 1
}
default {
return 0
}
|
| ︙ | ︙ |
Changes to tests/expr.test.
| ︙ | ︙ | |||
29 30 31 32 33 34 35 |
proc testIEEE {} {
variable ieeeValues
binary scan [binary format dd -1.0 1.0] c* c
switch -exact -- $c {
{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
# little endian
| | | | | | | | | | | | | | 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 |
proc testIEEE {} {
variable ieeeValues
binary scan [binary format dd -1.0 1.0] c* c
switch -exact -- $c {
{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
# little endian
binary scan \x00\x00\x00\x00\x00\x00\xF0\xFF d \
ieeeValues(-Infinity)
binary scan \x00\x00\x00\x00\x00\x00\xF0\xBF d \
ieeeValues(-Normal)
binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \
ieeeValues(-Subnormal)
binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \
ieeeValues(-0)
binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+0)
binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \
ieeeValues(+Subnormal)
binary scan \x00\x00\x00\x00\x00\x00\xF0\x3F d \
ieeeValues(+Normal)
binary scan \x00\x00\x00\x00\x00\x00\xF0\x7F d \
ieeeValues(+Infinity)
binary scan \x00\x00\x00\x00\x00\x00\xF8\x7F d \
ieeeValues(NaN)
binary scan \x00\x00\x00\x00\x00\x00\xF8\xFF d \
ieeeValues(-NaN)
set ieeeValues(littleEndian) 1
return 1
}
{-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} {
binary scan \xFF\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Infinity)
binary scan \xBF\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Normal)
binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Subnormal)
binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-0)
binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+0)
binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Subnormal)
binary scan \x3F\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Normal)
binary scan \x7F\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Infinity)
binary scan \x7F\xF8\x00\x00\x00\x00\x00\x00 d \
ieeeValues(NaN)
binary scan \xFF\xF8\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-NaN)
set ieeeValues(littleEndian) 0
return 1
}
default {
return 0
}
|
| ︙ | ︙ | |||
347 348 349 350 351 352 353 |
test expr-8.10 {CompileEqualityExpr: error compiling equality arm} -body {
expr 2***3==6
} -returnCodes error -match glob -result *
test expr-8.11 {CompileEqualityExpr: error compiling equality arm} -body {
expr 2!=x
} -returnCodes error -match glob -result *
test expr-8.12 {CompileBitAndExpr: equality expr} {expr {"a"eq"a"}} 1
| | | 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 |
test expr-8.10 {CompileEqualityExpr: error compiling equality arm} -body {
expr 2***3==6
} -returnCodes error -match glob -result *
test expr-8.11 {CompileEqualityExpr: error compiling equality arm} -body {
expr 2!=x
} -returnCodes error -match glob -result *
test expr-8.12 {CompileBitAndExpr: equality expr} {expr {"a"eq"a"}} 1
test expr-8.13 {CompileBitAndExpr: equality expr} {expr {"\374" eq [set s \xFC]}} 1
test expr-8.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0
test expr-8.15 {CompileBitAndExpr: equality expr} {expr 2.0eq2} 0
test expr-8.16 {CompileBitAndExpr: equality expr} {expr 3.2ne2.2} 1
test expr-8.17 {CompileBitAndExpr: equality expr} {expr 01eq1} 0
test expr-8.18 {CompileBitAndExpr: equality expr} {expr {"abc" eq "abd"}} 0
test expr-8.19 {CompileBitAndExpr: equality expr} {expr {"abc" ne "abd"}} 1
test expr-8.20 {CompileBitAndExpr: error in equality expr} -body {
|
| ︙ | ︙ |
Changes to tests/fCmd.test.
| ︙ | ︙ | |||
267 268 269 270 271 272 273 |
} -result {tf1 tf2 tf3 tf4}
test fCmd-3.14 {FileCopyRename: FileBasename fails} -setup {
cleanup
} -constraints {notRoot} -returnCodes error -body {
file mkdir td1
file rename ~_totally_bogus_user td1
} -result {user "_totally_bogus_user" doesn't exist}
| | | 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 |
} -result {tf1 tf2 tf3 tf4}
test fCmd-3.14 {FileCopyRename: FileBasename fails} -setup {
cleanup
} -constraints {notRoot} -returnCodes error -body {
file mkdir td1
file rename ~_totally_bogus_user td1
} -result {user "_totally_bogus_user" doesn't exist}
test fCmd-3.15 {FileCopyRename: source[0] == '\x00'} -setup {
cleanup
} -constraints {notRoot unixOrWin} -returnCodes error -body {
file mkdir td1
file rename / td1
} -result {error renaming "/" to "td1": file already exists}
test fCmd-3.16 {FileCopyRename: break on first error} -setup {
cleanup
|
| ︙ | ︙ | |||
309 310 311 312 313 314 315 |
glob td1 td2 tf1 td3 td4
} -result {td1 td2 tf1}
test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} -setup {
cleanup
} -constraints {notRoot} -returnCodes error -body {
file mkdir ~_totally_bogus_user
} -result {user "_totally_bogus_user" doesn't exist}
| | | 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 |
glob td1 td2 tf1 td3 td4
} -result {td1 td2 tf1}
test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} -setup {
cleanup
} -constraints {notRoot} -returnCodes error -body {
file mkdir ~_totally_bogus_user
} -result {user "_totally_bogus_user" doesn't exist}
test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\x00'} -setup {
cleanup
} -constraints {notRoot} -returnCodes error -body {
file mkdir ""
} -result {can't create directory "": no such file or directory}
test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} -setup {
cleanup
} -constraints {notRoot} -body {
|
| ︙ | ︙ | |||
370 371 372 373 374 375 376 |
list $x [file exists td1]
} -result {0 1}
test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} -setup {
cleanup
file delete -force foo
} -constraints {unix notRoot} -body {
file mkdir foo
| | | 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 |
list $x [file exists td1]
} -result {0 1}
test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} -setup {
cleanup
file delete -force foo
} -constraints {unix notRoot} -body {
file mkdir foo
file attr foo -perm 0o40000
file mkdir foo/tf1
} -returnCodes error -cleanup {
file delete -force foo
} -result {can't create directory "foo/tf1": permission denied}
test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} -setup {
cleanup
} -constraints {notRoot} -body {
|
| ︙ | ︙ | |||
683 684 685 686 687 688 689 |
file rename td1 $tmpspace
glob td* [file join $tmpspace td1 t*]
} -result [file join $tmpspace td1 td2]
test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup {
cleanup $tmpspace
} -constraints {unix notRoot} -body {
file mkdir foo/bar
| | | | 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 |
file rename td1 $tmpspace
glob td* [file join $tmpspace td1 t*]
} -result [file join $tmpspace td1 td2]
test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup {
cleanup $tmpspace
} -constraints {unix notRoot} -body {
file mkdir foo/bar
file attr foo -perm 0o40555
file rename foo/bar $tmpspace
} -returnCodes error -cleanup {
catch {file delete [file join $tmpspace bar]}
catch {file attr foo -perm 0o40777}
catch {file delete -force foo}
} -match glob -result {*: permission denied}
test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} -setup {
cleanup $tmpspace
} -constraints {notRoot xdev} -body {
file mkdir [file join $tmpspace td1]
createfile [file join $tmpspace td1 tf1]
|
| ︙ | ︙ | |||
740 741 742 743 744 745 746 |
glob -- -- -force
} -result {no files matched glob patterns "-- -force"}
test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
-constraints {unix notRoot knownBug} -body {
# Labelled knownBug because it is dangerous [Bug: 3881]
file mkdir td1
| | | | 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 |
glob -- -- -force
} -result {no files matched glob patterns "-- -force"}
test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
-constraints {unix notRoot knownBug} -body {
# Labelled knownBug because it is dangerous [Bug: 3881]
file mkdir td1
file attr td1 -perm 0o40000
file rename ~$user td1
} -returnCodes error -cleanup {
file delete -force td1
} -result "error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied"
test fCmd-8.2 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
-constraints {unix notRoot} -body {
string equal [file tail ~$user] ~$user
} -result 0
test fCmd-8.3 {file copy and path translation: ensure correct error} -body {
file copy ~ [file join this file doesnt exist]
} -returnCodes error -result [subst \
{error copying "~" to "[file join this file doesnt exist]": no such file or directory}]
test fCmd-9.1 {file rename: comprehensive: EACCES} -setup {
cleanup
} -constraints {unix notRoot} -body {
file mkdir td1
file mkdir td2
file attr td2 -perm 0o40000
file rename td1 td2/
} -returnCodes error -cleanup {
file delete -force td2
file delete -force td1
} -result {error renaming "td1" to "td2/td1": permission denied}
test fCmd-9.2 {file rename: comprehensive: source doesn't exist} -setup {
cleanup
|
| ︙ | ︙ |
Changes to tests/fileSystemEncoding.test.
| ︙ | ︙ | |||
9 10 11 12 13 14 15 |
namespace eval ::tcl::test::fileSystemEncoding {
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
| | | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 |
namespace eval ::tcl::test::fileSystemEncoding {
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
variable fname1 登鸛鵲樓
proc autopath {} {
global auto_path
set scriptpath [info script]
set scriptpathnorm [file dirname [file normalize $scriptpath/...]]
set dirnorm [file dirname $scriptpathnorm]
set idx [lsearch -exact $auto_path $dirnorm]
|
| ︙ | ︙ |
Changes to tests/format.test.
| ︙ | ︙ | |||
19 20 21 22 23 24 25 |
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]
testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}]
# MSVC uses a broken libc that gets sprintf("%g") wrong. This is a pain
# particularly in Continuous Integration, and there isn't anything much we can
# do about it.
| | | | 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 |
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]
testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}]
# MSVC uses a broken libc that gets sprintf("%g") wrong. This is a pain
# particularly in Continuous Integration, and there isn't anything much we can
# do about it.
testConstraint knownMsvcBug [expr {![string match msvc-* [tcl::build-info compiler]]}]
test format-1.1 {integer formatting} {
format "%*d %d %d %d" 6 34 16923 -12 -1
} { 34 16923 -12 -1}
test format-1.2 {integer formatting} {
format "%4d %4d %4d %4d %d %#x %#X" 6 34 16923 -12 -1 14 12
} { 6 34 16923 -12 -1 0xe 0xC}
test format-1.3 {integer formatting} longIs32bit {
|
| ︙ | ︙ | |||
101 102 103 104 105 106 107 |
test format-2.3 {string formatting} {
format "%.10s %.10s %c %.10s" abcd {This is a very long test string.} 120 x
} {abcd This is a x x}
test format-2.4 {string formatting} {
format "%s %s %% %c %s" abcd {This is a very long test string.} 120 x
} {abcd This is a very long test string. % x x}
test format-2.5 {string formatting, embedded nulls} {
| | | | | | | | | | 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 |
test format-2.3 {string formatting} {
format "%.10s %.10s %c %.10s" abcd {This is a very long test string.} 120 x
} {abcd This is a x x}
test format-2.4 {string formatting} {
format "%s %s %% %c %s" abcd {This is a very long test string.} 120 x
} {abcd This is a very long test string. % x x}
test format-2.5 {string formatting, embedded nulls} {
format "%10s" abc\x00def
} " abc\x00def"
test format-2.6 {string formatting, international chars} {
format "%10s" abc\uFEFFdef
} " abc\uFEFFdef"
test format-2.7 {string formatting, international chars} {
format "%.5s" abc\uFEFFdef
} "abc\uFEFFd"
test format-2.8 {string formatting, international chars} {
format "foo\uFEFFbar%s" baz
} "foo\uFEFFbarbaz"
test format-2.9 {string formatting, width} {
format "a%5sa" f
} "a fa"
test format-2.10 {string formatting, width} {
format "a%-5sa" f
} "af a"
test format-2.11 {string formatting, width} {
|
| ︙ | ︙ | |||
139 140 141 142 143 144 145 146 147 148 149 150 |
} {1 {bad field specifier "-"}}
test format-2.16 {string formatting, width and precision} {
format "a%5.2sa" foobarbaz
} "a foa"
test format-2.17 {string formatting, width and precision} {
format "a%5.7sa" foobarbaz
} "afoobarba"
test format-3.1 {Tcl_FormatObjCmd: character formatting} {
format "|%c|%0c|%-1c|%1c|%-6c|%6c|%*c|%*c|" 65 65 65 65 65 65 3 65 -4 65
} "|A|A|A|A|A | A| A|A |"
test format-3.2 {Tcl_FormatObjCmd: international character formatting} {
| > > > > > > | | | 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 |
} {1 {bad field specifier "-"}}
test format-2.16 {string formatting, width and precision} {
format "a%5.2sa" foobarbaz
} "a foa"
test format-2.17 {string formatting, width and precision} {
format "a%5.7sa" foobarbaz
} "afoobarba"
test format-2.18 {string formatting, surrogates} {
format "\uD83D%s" \uDE02
} \uD83D\uDE02
test format-2.19 {string formatting, surrogates} {
format "%s\uDE02" \uD83D
} \uD83D\uDE02
test format-3.1 {Tcl_FormatObjCmd: character formatting} {
format "|%c|%0c|%-1c|%1c|%-6c|%6c|%*c|%*c|" 65 65 65 65 65 65 3 65 -4 65
} "|A|A|A|A|A | A| A|A |"
test format-3.2 {Tcl_FormatObjCmd: international character formatting} {
format "|%c|%0c|%-1c|%1c|%-6c|%6c|%*c|%*c|" 0xA2 0x4E4E 0x25A 0xC3 0xFF08 0 3 0x6575 -4 0x4E4F
} "|¢|乎|ɚ|Ã|( | \x00| 敵|乏 |"
test format-4.1 {e and f formats} {eformat} {
format "%e %e %e %e" 34.2e12 68.514 -.125 -16000. .000053
} {3.420000e+13 6.851400e+01 -1.250000e-01 -1.600000e+04}
test format-4.2 {e and f formats} {eformat} {
format "%20e %20e %20e %20e" 34.2e12 68.514 -.125 -16000. .000053
} { 3.420000e+13 6.851400e+01 -1.250000e-01 -1.600000e+04}
|
| ︙ | ︙ | |||
610 611 612 613 614 615 616 |
test format-19.4.2 {Bug d498578df4: width overflow should cause limit exceeded} -body {
# limit should exceeds in any case,
# and it don't throw an error in case the bug is not fixed (and probably no segfault).
format %[expr {0xffffffffffffffff - 1}]g 0
} -returnCodes error -result "max size for a Tcl value exceeded"
# Note that this test may fail in future versions
| | | | 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 |
test format-19.4.2 {Bug d498578df4: width overflow should cause limit exceeded} -body {
# limit should exceeds in any case,
# and it don't throw an error in case the bug is not fixed (and probably no segfault).
format %[expr {0xffffffffffffffff - 1}]g 0
} -returnCodes error -result "max size for a Tcl value exceeded"
# Note that this test may fail in future versions
test format-20.1 {Bug 2932421: plain %s caused internalrep change of args} -body {
set x [dict create a b c d]
format %s $x
# After this, obj in $x should be a dict
# We are testing to make sure it has not been shimmered to a
# different internalrep when that is not necessary.
# Whether or not there is a string rep - we should not care!
tcl::unsupported::representation $x
} -match glob -result {value is a dict *}
# cleanup
catch {unset a}
catch {unset b}
|
| ︙ | ︙ |
Changes to tests/http.test.
| ︙ | ︙ | |||
38 39 40 41 42 43 44 |
puts stderr $errorInfo
}
# 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
| | | 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 |
puts stderr $errorInfo
}
# 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
set bindata "This is binary data\x0D\x0Amore\x0Dmore\x0Amore\x00null"
catch {unset data}
# Ensure httpd file exists
set origFile [file join [pwd] [file dirname [info script]] httpd]
set httpdFile [file join [temporaryDirectory] httpd_[pid]]
if {![file exists $httpdFile]} {
|
| ︙ | ︙ | |||
616 617 618 619 620 621 622 |
http::formatQuery name1 value1 name2 "value two"
} {name1=value1&name2=value%20two}
# test http-5.2 obsoleted by 5.4 and 5.5 with http 2.5
test http-5.3 {http::formatQuery} {
http::formatQuery lines "line1\nline2\nline3"
} {lines=line1%0D%0Aline2%0D%0Aline3}
test http-5.4 {http::formatQuery} {
| | | | 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 |
http::formatQuery name1 value1 name2 "value two"
} {name1=value1&name2=value%20two}
# test http-5.2 obsoleted by 5.4 and 5.5 with http 2.5
test http-5.3 {http::formatQuery} {
http::formatQuery lines "line1\nline2\nline3"
} {lines=line1%0D%0Aline2%0D%0Aline3}
test http-5.4 {http::formatQuery} {
http::formatQuery name1 ~bwelch name2 ¡¢¢
} {name1=~bwelch&name2=%C2%A1%C2%A2%C2%A2}
test http-5.5 {http::formatQuery} {
set enc [http::config -urlencoding]
http::config -urlencoding iso8859-1
set res [http::formatQuery name1 ~bwelch name2 ¡¢¢]
http::config -urlencoding $enc
set res
} {name1=~bwelch&name2=%A1%A2%A2}
test http-6.1 {http::ProxyRequired} -body {
http::config -proxyhost ${::HOST} -proxyport $port
set token [http::geturl $url]
|
| ︙ | ︙ | |||
646 647 648 649 650 651 652 |
test http-7.1 {http::mapReply} {
http::mapReply "abc\$\[\]\"\\()\}\{"
} {abc%24%5B%5D%22%5C%28%29%7D%7B}
test http-7.2 {http::mapReply} {
# RFC 2718 specifies that we pass urlencoding on utf-8 chars by default,
# so make sure this gets converted to utf-8 then urlencoded.
| | | | | | 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 |
test http-7.1 {http::mapReply} {
http::mapReply "abc\$\[\]\"\\()\}\{"
} {abc%24%5B%5D%22%5C%28%29%7D%7B}
test http-7.2 {http::mapReply} {
# RFC 2718 specifies that we pass urlencoding on utf-8 chars by default,
# so make sure this gets converted to utf-8 then urlencoded.
http::mapReply "∈"
} {%E2%88%88}
test http-7.3 {http::formatQuery} -setup {
set enc [http::config -urlencoding]
} -returnCodes error -body {
# this would be reverting to http <=2.4 behavior
http::config -urlencoding ""
http::mapReply "∈"
} -cleanup {
http::config -urlencoding $enc
} -result "can't read \"formMap(∈)\": no such element in array"
test http-7.4 {http::formatQuery} -setup {
set enc [http::config -urlencoding]
} -body {
# this would be reverting to http <=2.4 behavior w/o errors
# (unknown chars become '?')
http::config -urlencoding "iso8859-1"
http::mapReply "∈"
} -cleanup {
http::config -urlencoding $enc
} -result {%3F}
package require tcl::idna 1.0
test http-idna-1.1 {IDNA package: basics} -returnCodes error -body {
|
| ︙ | ︙ | |||
711 712 713 714 715 716 717 |
::tcl::idna encode
} -result {wrong # args: should be "::tcl::idna encode hostname"}
test http-idna-2.1 {puny encode: functional test} {
::tcl::idna puny encode abc
} abc-
test http-idna-2.2 {puny encode: functional test} {
| | | | | | | | 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 |
::tcl::idna encode
} -result {wrong # args: should be "::tcl::idna encode hostname"}
test http-idna-2.1 {puny encode: functional test} {
::tcl::idna puny encode abc
} abc-
test http-idna-2.2 {puny encode: functional test} {
::tcl::idna puny encode a€b€c
} abc-k50ab
test http-idna-2.3 {puny encode: functional test} {
::tcl::idna puny encode ABC
} ABC-
test http-idna-2.4 {puny encode: functional test} {
::tcl::idna puny encode A€B€C
} ABC-k50ab
test http-idna-2.5 {puny encode: functional test} {
::tcl::idna puny encode ABC 0
} abc-
test http-idna-2.6 {puny encode: functional test} {
::tcl::idna puny encode A€B€C 0
} abc-k50ab
test http-idna-2.7 {puny encode: functional test} {
::tcl::idna puny encode ABC 1
} ABC-
test http-idna-2.8 {puny encode: functional test} {
::tcl::idna puny encode A€B€C 1
} ABC-k50ab
test http-idna-2.9 {puny encode: functional test} {
::tcl::idna puny encode abc 0
} abc-
test http-idna-2.10 {puny encode: functional test} {
::tcl::idna puny encode a€b€c 0
} abc-k50ab
test http-idna-2.11 {puny encode: functional test} {
::tcl::idna puny encode abc 1
} ABC-
test http-idna-2.12 {puny encode: functional test} {
::tcl::idna puny encode a€b€c 1
} ABC-k50ab
test http-idna-2.13 {puny encode: edge cases} {
::tcl::idna puny encode ""
} ""
test http-idna-2.14-A {puny encode: examples from RFC 3492} {
::tcl::idna puny encode [join [subst [string map {u+ \\u} {
u+0644 u+064A u+0647 u+0645 u+0627 u+0628 u+062A u+0643 u+0644
|
| ︙ | ︙ | |||
871 872 873 874 875 876 877 |
} {-> $1.00 <--}
test http-idna-3.1 {puny decode: functional test} {
::tcl::idna puny decode abc-
} abc
test http-idna-3.2 {puny decode: functional test} {
::tcl::idna puny decode abc-k50ab
| | | | | | | | | | 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 |
} {-> $1.00 <--}
test http-idna-3.1 {puny decode: functional test} {
::tcl::idna puny decode abc-
} abc
test http-idna-3.2 {puny decode: functional test} {
::tcl::idna puny decode abc-k50ab
} a€b€c
test http-idna-3.3 {puny decode: functional test} {
::tcl::idna puny decode ABC-
} ABC
test http-idna-3.4 {puny decode: functional test} {
::tcl::idna puny decode ABC-k50ab
} A€B€C
test http-idna-3.5 {puny decode: functional test} {
::tcl::idna puny decode ABC-K50AB
} A€B€C
test http-idna-3.6 {puny decode: functional test} {
::tcl::idna puny decode abc-K50AB
} a€b€c
test http-idna-3.7 {puny decode: functional test} {
::tcl::idna puny decode ABC- 0
} abc
test http-idna-3.8 {puny decode: functional test} {
::tcl::idna puny decode ABC-K50AB 0
} a€b€c
test http-idna-3.9 {puny decode: functional test} {
::tcl::idna puny decode ABC- 1
} ABC
test http-idna-3.10 {puny decode: functional test} {
::tcl::idna puny decode ABC-K50AB 1
} A€B€C
test http-idna-3.11 {puny decode: functional test} {
::tcl::idna puny decode abc- 0
} abc
test http-idna-3.12 {puny decode: functional test} {
::tcl::idna puny decode abc-k50ab 0
} a€b€c
test http-idna-3.13 {puny decode: functional test} {
::tcl::idna puny decode abc- 1
} ABC
test http-idna-3.14 {puny decode: functional test} {
::tcl::idna puny decode abc-k50ab 1
} A€B€C
test http-idna-3.15 {puny decode: edge cases and errors} {
# Is this case actually correct?
binary encode hex [encoding convertto utf-8 [::tcl::idna puny decode abc]]
} c282c281c280
test http-idna-3.16 {puny decode: edge cases and errors} -returnCodes error -body {
::tcl::idna puny decode abc!
} -result {bad decode character "!"}
|
| ︙ | ︙ | |||
1041 1042 1043 1044 1045 1046 1047 |
} {-> $1.00 <-}
rename hexify ""
test http-idna-4.1 {IDNA encoding} {
::tcl::idna encode abc.def
} abc.def
test http-idna-4.2 {IDNA encoding} {
| | | | | 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 |
} {-> $1.00 <-}
rename hexify ""
test http-idna-4.1 {IDNA encoding} {
::tcl::idna encode abc.def
} abc.def
test http-idna-4.2 {IDNA encoding} {
::tcl::idna encode a€b€c.def
} xn--abc-k50ab.def
test http-idna-4.3 {IDNA encoding} {
::tcl::idna encode def.a€b€c
} def.xn--abc-k50ab
test http-idna-4.4 {IDNA encoding} {
::tcl::idna encode ABC.DEF
} ABC.DEF
test http-idna-4.5 {IDNA encoding} {
::tcl::idna encode A€B€C.def
} xn--ABC-k50ab.def
test http-idna-4.6 {IDNA encoding: invalid edge case} {
# Should this be an error?
::tcl::idna encode abc..def
} abc..def
test http-idna-4.7 {IDNA encoding: invalid char} -returnCodes error -body {
::tcl::idna encode abc.$.def
|
| ︙ | ︙ | |||
1080 1081 1082 1083 1084 1085 1086 |
} -returnCodes error -result "hostname part too long"
test http-idna-4.9.1 {IDNA encoding: max lengths from RFC 5890} {
catch {::tcl::idna encode $overlong} -> opt
dict get $opt -errorcode
} {IDNA OVERLONG_PART xn--989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c}
unset overlong
test http-idna-4.10 {IDNA encoding: edge cases} {
| | | 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 |
} -returnCodes error -result "hostname part too long"
test http-idna-4.9.1 {IDNA encoding: max lengths from RFC 5890} {
catch {::tcl::idna encode $overlong} -> opt
dict get $opt -errorcode
} {IDNA OVERLONG_PART xn--989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c}
unset overlong
test http-idna-4.10 {IDNA encoding: edge cases} {
::tcl::idna encode passé.example.com
} xn--pass-epa.example.com
test http-idna-5.1 {IDNA decoding} {
::tcl::idna decode abc.def
} abc.def
test http-idna-5.2 {IDNA decoding} {
# Invalid entry that's just a wrapper
|
| ︙ | ︙ |
Changes to tests/http11.test.
1 2 3 4 | # http11.test -- -*- tcl-*- # # Test HTTP/1.1 features. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 |
# http11.test -- -*- tcl-*-
#
# Test HTTP/1.1 features.
#
# Copyright © 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
|
| ︙ | ︙ |
Changes to tests/httpPipeline.test.
1 2 3 4 5 | # httpPipeline.test # # Test HTTP/1.1 concurrent requests including # queueing, pipelining and retries. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 |
# httpPipeline.test
#
# Test HTTP/1.1 concurrent requests including
# queueing, pipelining and retries.
#
# Copyright © 2018 Keith Nash <kjnash@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
|
| ︙ | ︙ |
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 | # httpTest.tcl # # Test HTTP/1.1 concurrent requests including # queueing, pipelining and retries. # # Copyright © 2018 Keith Nash <kjnash@users.sourceforge.net> # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # ------------------------------------------------------------------------------ # "Package" httpTest for analysis of Log output of http requests. # ------------------------------------------------------------------------------ |
| ︙ | ︙ |
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 | # httpTestScript.tcl # # Test HTTP/1.1 concurrent requests including # queueing, pipelining and retries. # # Copyright © 2018 Keith Nash <kjnash@users.sourceforge.net> # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # ------------------------------------------------------------------------------ # "Package" httpTestScript for executing test scripts written in a convenient # shorthand. |
| ︙ | ︙ |
Changes to tests/httpd11.tcl.
1 2 3 4 5 | # httpd11.tcl -- -*- tcl -*- # # A simple httpd for testing HTTP/1.1 client features. # Not suitable for use on a internet connected port. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 |
# httpd11.tcl -- -*- tcl -*-
#
# A simple httpd for testing HTTP/1.1 client features.
# Not suitable for use on a internet connected port.
#
# Copyright © 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
package require tcl
proc ::tcl::dict::get? {dict key} {
|
| ︙ | ︙ |
Changes to tests/indexObj.test.
| ︙ | ︙ | |||
13 14 15 16 17 18 19 20 21 22 23 24 25 26 |
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
testConstraint testindexobj [llength [info commands testindexobj]]
testConstraint testparseargs [llength [info commands testparseargs]]
test indexObj-1.1 {exact match} testindexobj {
testindexobj 1 1 xyz abc def xyz alm
} {2}
test indexObj-1.2 {exact match} testindexobj {
testindexobj 1 1 abc abc def xyz alm
| > | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 |
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
testConstraint testindexobj [llength [info commands testindexobj]]
testConstraint testgetintforindex [llength [info commands testgetintforindex]]
testConstraint testparseargs [llength [info commands testparseargs]]
test indexObj-1.1 {exact match} testindexobj {
testindexobj 1 1 xyz abc def xyz alm
} {2}
test indexObj-1.2 {exact match} testindexobj {
testindexobj 1 1 abc abc def xyz alm
|
| ︙ | ︙ | |||
87 88 89 90 91 92 93 |
set x {a b}
lindex $x 1
testindexobj 1 1 $x abc def {a b} zzz
} {2}
test indexObj-5.1 {Tcl_WrongNumArgs} testindexobj {
testwrongnumargs 1 "?-switch?" mycmd
| | | | | | | | | | | > > > > > > > > > > > > | | 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 |
set x {a b}
lindex $x 1
testindexobj 1 1 $x abc def {a b} zzz
} {2}
test indexObj-5.1 {Tcl_WrongNumArgs} testindexobj {
testwrongnumargs 1 "?-switch?" mycmd
} {wrong # args: should be "mycmd ?-switch?"}
test indexObj-5.2 {Tcl_WrongNumArgs} testindexobj {
testwrongnumargs 2 "bar" mycmd foo
} {wrong # args: should be "mycmd foo bar"}
test indexObj-5.3 {Tcl_WrongNumArgs} testindexobj {
testwrongnumargs 0 "bar" mycmd foo
} {wrong # args: should be "bar"}
test indexObj-5.4 {Tcl_WrongNumArgs} testindexobj {
testwrongnumargs 0 "" mycmd foo
} {wrong # args: should be ""}
test indexObj-5.5 {Tcl_WrongNumArgs} testindexobj {
testwrongnumargs 1 "" mycmd foo
} {wrong # args: should be "mycmd"}
test indexObj-5.6 {Tcl_WrongNumArgs} testindexobj {
testwrongnumargs 2 "" mycmd foo
} {wrong # args: should be "mycmd foo"}
# Contrast this with test proc-3.6; they have to be like this because
# of [Bug 1066837] so Itcl won't break.
test indexObj-5.7 {Tcl_WrongNumArgs} {testindexobj obsolete} {
testwrongnumargs 2 "fee fi" "fo fum" foo bar
} {wrong # args: should be "fo fum foo fee fi"}
test indexObj-6.1 {Tcl_GetIndexFromObjStruct} testindexobj {
set x a
testgetindexfromobjstruct $x 0
} {wrong # args: should be "testgetindexfromobjstruct a 0"}
test indexObj-6.2 {Tcl_GetIndexFromObjStruct} testindexobj {
set x a
testgetindexfromobjstruct $x 0
testgetindexfromobjstruct $x 0
} {wrong # args: should be "testgetindexfromobjstruct a 0"}
test indexObj-6.3 {Tcl_GetIndexFromObjStruct} testindexobj {
set x c
testgetindexfromobjstruct $x 1
} {wrong # args: should be "testgetindexfromobjstruct c 1"}
test indexObj-6.4 {Tcl_GetIndexFromObjStruct} testindexobj {
set x c
testgetindexfromobjstruct $x 1
testgetindexfromobjstruct $x 1
} {wrong # args: should be "testgetindexfromobjstruct c 1"}
test indexObj-6.5 {Tcl_GetIndexFromObjStruct with TCL_EXACT flag} -constraints testindexobj -body {
set x e
testgetindexfromobjstruct $x 0 1
} -returnCodes error -result {bad dummy "e": must be a, c, or ee}
test indexObj-6.6 {Tcl_GetIndexFromObjStruct with NULL input} -constraints testindexobj -body {
set x ""
testgetindexfromobjstruct $x 0
} -returnCodes error -result {ambiguous dummy "": must be a, c, or ee}
test indexObj-6.7 {Tcl_GetIndexFromObjStruct} testindexobj {
set x ""
testgetindexfromobjstruct $x -1 4
} "wrong # args: should be \"testgetindexfromobjstruct {} -1 4\""
test indexObj-7.1 {Tcl_ParseArgsObjv} testparseargs {
testparseargs
} {0 1 testparseargs}
test indexObj-7.2 {Tcl_ParseArgsObjv} testparseargs {
testparseargs -bool
} {1 1 testparseargs}
|
| ︙ | ︙ | |||
153 154 155 156 157 158 159 160 161 162 163 164 165 166 |
test indexObj-7.6 {Tcl_ParseArgsObjv} testparseargs {
testparseargs -- -bool -help
} {0 3 {testparseargs -bool -help}}
test indexObj-7.7 {Tcl_ParseArgsObjv memory management} testparseargs {
testparseargs 1 2 3 4 5 6 7 8 9 0 -bool 1 2 3 4 5 6 7 8 9 0
} {1 21 {testparseargs 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0}}
# cleanup
::tcltest::cleanupTests
return
# Local Variables:
# mode: tcl
# End:
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
test indexObj-7.6 {Tcl_ParseArgsObjv} testparseargs {
testparseargs -- -bool -help
} {0 3 {testparseargs -bool -help}}
test indexObj-7.7 {Tcl_ParseArgsObjv memory management} testparseargs {
testparseargs 1 2 3 4 5 6 7 8 9 0 -bool 1 2 3 4 5 6 7 8 9 0
} {1 21 {testparseargs 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0}}
test indexObj-8.1 {Tcl_GetIntForIndex integer} testgetintforindex {
testgetintforindex 0 0
} 0
test indexObj-8.2 {Tcl_GetIntForIndex integer} testgetintforindex {
testgetintforindex -1 0
} -1
test indexObj-8.3 {Tcl_GetIntForIndex integer} testgetintforindex {
testgetintforindex -2 0
} -1
test indexObj-8.4 {Tcl_GetIntForIndex INT_MAX} testgetintforindex {
testgetintforindex 2147483647 0
} 2147483647
test indexObj-8.5 {Tcl_GetIntForIndex INT_MAX+1} testgetintforindex {
testgetintforindex 2147483648 0
} 2147483647
test indexObj-8.6 {Tcl_GetIntForIndex end-1} testgetintforindex {
testgetintforindex end-1 2147483646
} 2147483645
test indexObj-8.7 {Tcl_GetIntForIndex end-1} testgetintforindex {
testgetintforindex end-1 2147483647
} 2147483646
test indexObj-8.8 {Tcl_GetIntForIndex end} testgetintforindex {
testgetintforindex end 2147483646
} 2147483646
test indexObj-8.9 {Tcl_GetIntForIndex end} testgetintforindex {
testgetintforindex end 2147483647
} 2147483647
test indexObj-8.10 {Tcl_GetIntForIndex end-1} testgetintforindex {
testgetintforindex end-1 -1
} -2
test indexObj-8.11 {Tcl_GetIntForIndex end-1} testgetintforindex {
testgetintforindex end-1 -2
} -3
test indexObj-8.12 {Tcl_GetIntForIndex end} testgetintforindex {
testgetintforindex end -1
} -1
test indexObj-8.13 {Tcl_GetIntForIndex end} testgetintforindex {
testgetintforindex end -2
} -2
test indexObj-8.14 {Tcl_GetIntForIndex end+1} testgetintforindex {
testgetintforindex end+1 -1
} 0
test indexObj-8.15 {Tcl_GetIntForIndex end+1} testgetintforindex {
testgetintforindex end+1 -2
} -1
# cleanup
::tcltest::cleanupTests
return
# Local Variables:
# mode: tcl
# End:
|
Changes to tests/info.test.
| ︙ | ︙ | |||
16 17 18 19 20 21 22 23 24 |
# DO NOT DELETE THIS LINE
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 zlib [llength [info commands zlib]]
| > < | 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 |
# DO NOT DELETE THIS LINE
if {{::tcltest} ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
package require tcltests
catch [list package require -exact tcl::test [info patchlevel]]
testConstraint zlib [llength [info commands zlib]]
# Set up namespaces needed to test operation of "info args", "info body",
# "info default", and "info procs" with imported procedures.
catch {namespace delete test_ns_info1 test_ns_info2}
namespace eval test_ns_info1 {
namespace export *
|
| ︙ | ︙ | |||
97 98 99 100 101 102 103 |
}
foo a
eval [info body foo]
} -returnCodes error -result {can't read "args": no such variable}
# Fix for problem tested for in info-2.5 caused problems when
# procedure body had no string rep (i.e. was not yet bytecode)
# causing an empty string to be returned [Bug #545644]
| | | 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 |
}
foo a
eval [info body foo]
} -returnCodes error -result {can't read "args": no such variable}
# Fix for problem tested for in info-2.5 caused problems when
# procedure body had no string rep (i.e. was not yet bytecode)
# causing an empty string to be returned [Bug #545644]
test info-2.6 {info body option, returning list bodies} deprecated {
proc foo args [list subst bar]
list [string bytelength [info body foo]] \
[foo; string bytelength [info body foo]]
} {9 9}
proc testinfocmdcount {} {
set x [info cmdcount]
|
| ︙ | ︙ |
Changes to tests/init.test.
| ︙ | ︙ | |||
151 152 153 154 155 156 157 |
foo bar foo
"}
{contrived example: rare circumstance
where the point at which to prune the
error stack cannot be uniquely determined.
foo bar
"}
| | | 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 |
foo bar foo
"}
{contrived example: rare circumstance
where the point at which to prune the
error stack cannot be uniquely determined.
foo bar
"}
{argument that contains non-ASCII character, €, and which is of such great length that it will be longer than 150 bytes so it will be truncated by the Tcl C library}
}] { ;# emacs needs -> "
test init-4.$count.0 {::errorInfo produced by [unknown]} -setup {
auto_reset
} -body {
catch {parray a b $arg}
set first $::errorInfo
|
| ︙ | ︙ |
Changes to tests/io.test.
| ︙ | ︙ | |||
104 105 106 107 108 109 110 |
test io-1.5 {Tcl_WriteChars: CheckChannelErrors} {emptyTest} {
# no test, need to cause an async error.
} {}
set path(test1) [makeFile {} test1]
test io-1.6 {Tcl_WriteChars: WriteBytes} {
set f [open $path(test1) w]
fconfigure $f -encoding binary
| | | | | | | 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 |
test io-1.5 {Tcl_WriteChars: CheckChannelErrors} {emptyTest} {
# no test, need to cause an async error.
} {}
set path(test1) [makeFile {} test1]
test io-1.6 {Tcl_WriteChars: WriteBytes} {
set f [open $path(test1) w]
fconfigure $f -encoding binary
puts -nonewline $f "a乍\x00"
close $f
contents $path(test1)
} "a\x4D\x00"
test io-1.7 {Tcl_WriteChars: WriteChars} {
set f [open $path(test1) w]
fconfigure $f -encoding shiftjis
puts -nonewline $f "a乍\x00"
close $f
contents $path(test1)
} "a\x93\xE1\x00"
set path(test2) [makeFile {} test2]
test io-1.8 {Tcl_WriteChars: WriteChars} {
# This test written for SF bug #506297.
#
# Executing this test without the fix for the referenced bug
# applied to tcl will cause tcl, more specifically WriteChars, to
# go into an infinite loop.
set f [open $path(test2) w]
fconfigure $f -encoding iso2022-jp
puts -nonewline $f [format %s%c [string repeat " " 4] 12399]
close $f
contents $path(test2)
} " \x1B\$B\$O\x1B(B"
test io-1.9 {Tcl_WriteChars: WriteChars} {
# When closing a channel with an encoding that appends
# escape bytes, check for the case where the escape
# bytes overflow the current IO buffer. The bytes
# should be moved into a new buffer.
|
| ︙ | ︙ | |||
291 292 293 294 295 296 297 |
lappend x [contents $path(test1)]
} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
# One incomplete UTF-8 character at end of staging buffer. Backup
# in src to the beginning of that UTF-8 character and try again.
#
# Translate the first 16 bytes, produce 14 bytes of output, 2 left over
| | | | | 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 |
lappend x [contents $path(test1)]
} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
# One incomplete UTF-8 character at end of staging buffer. Backup
# in src to the beginning of that UTF-8 character and try again.
#
# Translate the first 16 bytes, produce 14 bytes of output, 2 left over
# (first two bytes of A in UTF-8). Given those two bytes try
# translating them again, find that no bytes are read produced, and break
# to outer loop where those two bytes will have the remaining 4 bytes
# (the last byte of A plus the all of B) appended.
set f [open $path(test1) w]
fconfigure $f -encoding shiftjis -buffersize 16
puts -nonewline $f "12345678901234AB"
set x [list [contents $path(test1)]]
close $f
lappend x [contents $path(test1)]
} [list "12345678901234\x82\x60" "12345678901234\x82\x60\x82\x61"]
test io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} {
# When translating UTF-8 to external, the produced bytes went past end
# of the channel buffer. This is done purpose -- we then truncate the
|
| ︙ | ︙ | |||
447 448 449 450 451 452 453 |
set x [list [tell $f] [gets $f line] [tell $f] [gets $f line] $line]
close $f
set x
} {0 3 5 4 defg}
test io-6.4 {Tcl_GetsObj: encoding == NULL} {
set f [open $path(test1) w]
fconfigure $f -translation binary
| | | | | 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 |
set x [list [tell $f] [gets $f line] [tell $f] [gets $f line] $line]
close $f
set x
} {0 3 5 4 defg}
test io-6.4 {Tcl_GetsObj: encoding == NULL} {
set f [open $path(test1) w]
fconfigure $f -translation binary
puts $f "\x81\u1234\x00"
close $f
set f [open $path(test1)]
fconfigure $f -translation binary
set x [list [gets $f line] $line]
close $f
set x
} [list 3 "\x81\x34\x00"]
test io-6.5 {Tcl_GetsObj: encoding != NULL} {
set f [open $path(test1) w]
fconfigure $f -translation binary
puts $f "\x88\xEA\x92\x9A"
close $f
set f [open $path(test1)]
fconfigure $f -encoding shiftjis
set x [list [gets $f line] $line]
close $f
set x
} [list 2 "一丁"]
set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
append a $a
append a $a
test io-6.6 {Tcl_GetsObj: loop test} {
# if (dst >= dstEnd)
set f [open $path(test1) w]
|
| ︙ | ︙ | |||
505 506 507 508 509 510 511 |
fconfigure $f -eofchar \x1A
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
} {6 abcdef -1 {}}
test io-6.9 {Tcl_GetsObj: remember if EOF is seen} {
set f [open $path(test1) w]
| | | 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 |
fconfigure $f -eofchar \x1A
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
} {6 abcdef -1 {}}
test io-6.9 {Tcl_GetsObj: remember if EOF is seen} {
set f [open $path(test1) w]
puts $f "abcdefghijk\nwom\x1Abat"
close $f
set f [open $path(test1)]
fconfigure $f -eofchar \x1A
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
} {11 abcdefghijk 3 wom}
|
| ︙ | ︙ | |||
1048 1049 1050 1051 1052 1053 1054 |
set x
} {3 abc 1}
test io-6.55 {Tcl_GetsObj: overconverted} {
# Tcl_ExternalToUtf(), make sure state updated
set f [open $path(test1) w]
fconfigure $f -encoding iso2022-jp
| | | | 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 |
set x
} {3 abc 1}
test io-6.55 {Tcl_GetsObj: overconverted} {
# Tcl_ExternalToUtf(), make sure state updated
set f [open $path(test1) w]
fconfigure $f -encoding iso2022-jp
puts $f "there一ok\n丁more bytes\nhere"
close $f
set f [open $path(test1)]
fconfigure $f -encoding iso2022-jp
set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line]
close $f
set x
} [list 8 "there一ok" 11 "丁more bytes" 4 "here"]
test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio fileevent} {
update
set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -buffering none
puts -nonewline $f "foobar"
fconfigure $f -blocking 0
variable x {}
|
| ︙ | ︙ | |||
1082 1083 1084 1085 1086 1087 1088 |
} {{} timeout foobarbaz timeout}
test io-7.1 {FilterInputBytes: split up character at end of buffer} {
# (result == TCL_CONVERT_MULTIBYTE)
set f [open $path(test1) w]
fconfigure $f -encoding shiftjis
| | | | | | | | | 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 |
} {{} timeout foobarbaz timeout}
test io-7.1 {FilterInputBytes: split up character at end of buffer} {
# (result == TCL_CONVERT_MULTIBYTE)
set f [open $path(test1) w]
fconfigure $f -encoding shiftjis
puts $f "123456789012301234\nend"
close $f
set f [open $path(test1)]
fconfigure $f -encoding shiftjis -buffersize 16
set x [gets $f]
close $f
set x
} "123456789012301234"
test io-7.2 {FilterInputBytes: split up character in middle of buffer} {
# (bufPtr->nextAdded < bufPtr->bufLength)
set f [open $path(test1) w]
fconfigure $f -encoding binary
puts -nonewline $f "1234567890\n123\x82\x4F\x82\x50\x82"
close $f
set f [open $path(test1)]
fconfigure $f -encoding shiftjis
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
set x [list [gets $f line] $line]
lappend x [tell $f] [testchannel inputbuffered $f] [eof $f]
lappend x [gets $f line] $line
close $f
set x
} [list 15 "123456789012301" 18 0 1 -1 ""]
test io-7.4 {FilterInputBytes: recover from split up character} {stdio fileevent} {
set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -encoding binary -buffering none
puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
fconfigure $f -encoding shiftjis -blocking 0
fileevent $f read [namespace code "ready $f"]
variable x {}
proc ready {f} {
variable x
lappend x [gets $f line] $line [fblocked $f]
}
vwait [namespace which -variable x]
fconfigure $f -encoding binary -blocking 1
puts $f "\x51\x82\x52"
fconfigure $f -encoding shiftjis
vwait [namespace which -variable x]
close $f
set x
} [list -1 "" 1 17 "12345678901230123" 0]
test io-8.1 {PeekAhead: only go to device if no more cached data} {testchannel} {
# (bufPtr->nextPtr == NULL)
set f [open $path(test1) w]
fconfigure $f -encoding ascii -translation lf
puts -nonewline $f "123456789012345\r\n2345678"
|
| ︙ | ︙ | |||
1411 1412 1413 1414 1415 1416 1417 |
lappend x [read $f] [testchannel inputbuffered $f]
}
variable x {}
fconfigure $f -encoding shiftjis
vwait [namespace which -variable x]
fconfigure $f -encoding binary -blocking 1
| | | | | | 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 |
lappend x [read $f] [testchannel inputbuffered $f]
}
variable x {}
fconfigure $f -encoding shiftjis
vwait [namespace which -variable x]
fconfigure $f -encoding binary -blocking 1
puts -nonewline $f "\x7B"
after 500 ;# Give the cat process time to catch up
fconfigure $f -encoding shiftjis -blocking 0
vwait [namespace which -variable x]
close $f
set x
} [list "123456789012345" 1 "本" 0]
test io-12.5 {ReadChars: fileevents on partial characters} {stdio fileevent} {
set path(test1) [makeFile {
fconfigure stdout -encoding binary -buffering none
gets stdin; puts -nonewline "\xE7"
gets stdin; puts -nonewline "\x89"
gets stdin; puts -nonewline "\xA6"
} test1]
set f [open "|[list [interpreter] $path(test1)]" r+]
fileevent $f readable [namespace code {
lappend x [read $f]
if {[eof $f]} {
lappend x eof
}
|
| ︙ | ︙ | |||
1450 1451 1452 1453 1454 1455 1456 |
vwait [namespace which -variable x]
puts $f "go3"
flush $f
vwait [namespace which -variable x]
vwait [namespace which -variable x]
lappend x [catch {close $f} msg] $msg
set x
| | | | 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 |
vwait [namespace which -variable x]
puts $f "go3"
flush $f
vwait [namespace which -variable x]
vwait [namespace which -variable x]
lappend x [catch {close $f} msg] $msg
set x
} "{} timeout {} timeout 牦 {} eof 0 {}"
test io-12.6 {ReadChars: too many chars read} {
proc driver {cmd args} {
variable buffer
variable index
set chan [lindex $args 0]
switch -- $cmd {
initialize {
set index($chan) 0
set buffer($chan) [encoding convertto utf-8 \
[string repeat 뻯 20][string repeat . 20]]
return {initialize finalize watch read}
}
finalize {
unset index($chan) buffer($chan)
return
}
watch {}
|
| ︙ | ︙ | |||
1493 1494 1495 1496 1497 1498 1499 |
variable buffer
variable index
set chan [lindex $args 0]
switch -- $cmd {
initialize {
set index($chan) 0
set buffer($chan) [encoding convertto utf-8 \
| | | 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 |
variable buffer
variable index
set chan [lindex $args 0]
switch -- $cmd {
initialize {
set index($chan) 0
set buffer($chan) [encoding convertto utf-8 \
[string repeat 뻯 10]....뻯]
return {initialize finalize watch read}
}
finalize {
unset index($chan) buffer($chan)
return
}
watch {}
|
| ︙ | ︙ | |||
1520 1521 1522 1523 1524 1525 1526 |
read $c 7
}
close $c
} {}
test io-12.8 {ReadChars: multibyte chars split} {
set f [open $path(test1) w]
fconfigure $f -translation binary
| | | | | 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 |
read $c 7
}
close $c
} {}
test io-12.8 {ReadChars: multibyte chars split} {
set f [open $path(test1) w]
fconfigure $f -translation binary
puts -nonewline $f [string repeat a 9]\xC2\xA0
close $f
set f [open $path(test1)]
fconfigure $f -encoding utf-8 -buffersize 10
set in [read $f]
close $f
scan [string index $in end] %c
} 160
test io-12.9 {ReadChars: multibyte chars split} {
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 -buffersize 10
set in [read $f]
close $f
scan [string index $in end] %c
} 194
test io-12.10 {ReadChars: multibyte chars split} {
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 -buffersize 11
set in [read $f]
close $f
scan [string index $in end] %c
} 194
|
| ︙ | ︙ | |||
1728 1729 1730 1731 1732 1733 1734 |
set f [open $path(test1)]
fconfigure $f -translation auto
set x [read $f]
close $f
set x
} "abcd\ndef"
test io-13.11 {TranslateInputEOL: EOF char} {
| | | | 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 |
set f [open $path(test1)]
fconfigure $f -translation auto
set x [read $f]
close $f
set x
} "abcd\ndef"
test io-13.11 {TranslateInputEOL: EOF char} {
# (*chanPtr->inEofChar != '\x00')
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "abcd\ndefgh"
close $f
set f [open $path(test1)]
fconfigure $f -translation auto -eofchar e
set x [read $f]
close $f
set x
} "abcd\nd"
test io-13.12 {TranslateInputEOL: find EOF char in src} {
# (*chanPtr->inEofChar != '\x00')
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "\r\n\r\n\r\nab\r\n\r\ndef\r\n\r\n\r\n"
close $f
set f [open $path(test1)]
fconfigure $f -translation auto -eofchar e
|
| ︙ | ︙ | |||
2342 2343 2344 2345 2346 2347 2348 |
}
if {$counter == 1000} {
set result probably_broken
} else {
set result ok
}
} ok
| | | | 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 |
}
if {$counter == 1000} {
set result probably_broken
} else {
set result ok
}
} ok
test io-28.4 Tcl_Close testchannel {
file delete $path(test1)
set l {}
lappend l [lsort [testchannel open]]
set f [open $path(test1) w]
lappend l [lsort [testchannel open]]
close $f
lappend l [lsort [testchannel open]]
set x [list $consoleFileNames \
[lsort [list {*}$consoleFileNames $f]] \
|
| ︙ | ︙ | |||
2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 |
}
close $f
set f [open "|[list [interpreter] $path(script)]" r]
set l [gets $f]
close $f
lsort $l
} {file1 file2}
test io-29.1 {Tcl_WriteChars, channel not writable} {
list [catch {puts stdin hello} msg] $msg
} {1 {channel "stdin" wasn't opened for writing}}
test io-29.2 {Tcl_WriteChars, empty string} {
file delete $path(test1)
set f [open $path(test1) w]
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
}
close $f
set f [open "|[list [interpreter] $path(script)]" r]
set l [gets $f]
close $f
lsort $l
} {file1 file2}
test io-28.6 {
close channel in write event handler
Should not produce a segmentation fault in a Tcl built with
--enable-symbols and -DPURIFY
} debugpurify {
variable done
variable res
after 0 [list coroutine c1 apply [list {} {
variable done
set chan [chan create w {apply {args {
list initialize finalize watch write configure blocking
}}}]
chan configure $chan -blocking 0
while 1 {
chan event $chan writable [list [info coroutine]]
yield
close $chan
set done 1
return
}
} [namespace current]]]
vwait [namespace current]::done
return success
} success
test io-28.7 {
close channel in read event handler
Should not produce a segmentation fault in a Tcl built with
--enable-symbols and -DPURIFY
} debugpurify {
variable done
variable res
after 0 [list coroutine c1 apply [list {} {
variable done
set chan [chan create r {apply {{cmd chan args} {
switch $cmd {
blocking - finalize {
}
watch {
chan postevent $chan read
}
initialize {
list initialize finalize watch read write configure blocking
}
default {
error [list {unexpected command} $cmd]
}
}
}}}]
chan configure $chan -blocking 0
while 1 {
chan event $chan readable [list [info coroutine]]
yield
close $chan
set done 1
return
}
} [namespace current]]]
vwait [namespace current]::done
return success
} success
test io-29.1 {Tcl_WriteChars, channel not writable} {
list [catch {puts stdin hello} msg] $msg
} {1 {channel "stdin" wasn't opened for writing}}
test io-29.2 {Tcl_WriteChars, empty string} {
file delete $path(test1)
set f [open $path(test1) w]
|
| ︙ | ︙ | |||
3198 3199 3200 3201 3202 3203 3204 |
test io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f hello\nthere\nand\rhere\n\x1A
close $f
set f [open $path(test1) r]
| | | | | | | 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 |
test io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f hello\nthere\nand\rhere\n\x1A
close $f
set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1A
set c [read $f]
close $f
set c
} {hello
there
and
here
}
test io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} {win} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -translation lf -eofchar \x1A
puts $f hello\nthere\nand\rhere
close $f
set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1A
set c [read $f]
close $f
set c
} {hello
there
and
here
}
test io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -translation lf
set s [format "abc\ndef\n%cghi\nqrs" 26]
puts $f $s
close $f
set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1A
set l ""
lappend l [gets $f]
lappend l [gets $f]
lappend l [eof $f]
lappend l [gets $f]
lappend l [eof $f]
lappend l [gets $f]
lappend l [eof $f]
close $f
set l
} {abc def 0 {} 1 {} 1}
test io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -translation lf
set s [format "abc\ndef\n%cghi\nqrs" 26]
puts $f $s
close $f
set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1A
set l ""
lappend l [gets $f]
lappend l [gets $f]
lappend l [eof $f]
lappend l [gets $f]
lappend l [eof $f]
lappend l [gets $f]
|
| ︙ | ︙ | |||
3732 3733 3734 3735 3736 3737 3738 |
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -translation lf
set s [format "hello\nthere\nand\rhere\n\%c" 26]
puts $f $s
close $f
set f [open $path(test1) r]
| | | | < | | | 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 |
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -translation lf
set s [format "hello\nthere\nand\rhere\n\%c" 26]
puts $f $s
close $f
set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1A
set l ""
lappend l [gets $f]
lappend l [gets $f]
lappend l [gets $f]
lappend l [gets $f]
lappend l [eof $f]
lappend l [gets $f]
lappend l [eof $f]
close $f
set l
} {hello there and here 0 {} 1}
test io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -translation lf -eofchar \x1A
puts $f hello\nthere\nand\rhere
close $f
set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1A
set l ""
lappend l [gets $f]
lappend l [gets $f]
lappend l [gets $f]
lappend l [gets $f]
lappend l [eof $f]
lappend l [gets $f]
lappend l [eof $f]
close $f
set l
} {hello there and here 0 {} 1}
test io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -translation lf
set s [format "abc\ndef\n%cqrs\ntuv" 26]
puts $f $s
close $f
set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1A
set l ""
lappend l [gets $f]
lappend l [gets $f]
lappend l [eof $f]
lappend l [gets $f]
lappend l [eof $f]
close $f
set l
} {abc def 0 {} 1}
test io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -translation lf
set s [format "abc\ndef\n%cqrs\ntuv" 26]
puts $f $s
close $f
set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1A
set l ""
lappend l [gets $f]
lappend l [gets $f]
lappend l [eof $f]
lappend l [gets $f]
lappend l [eof $f]
close $f
|
| ︙ | ︙ | |||
5307 5308 5309 5310 5311 5312 5313 |
test io-39.1 {Tcl_GetChannelOption} {
file delete $path(test1)
set f1 [open $path(test1) w]
set x [fconfigure $f1 -blocking]
close $f1
set x
} 1
| < < < | 5374 5375 5376 5377 5378 5379 5380 5381 5382 5383 5384 5385 5386 5387 |
test io-39.1 {Tcl_GetChannelOption} {
file delete $path(test1)
set f1 [open $path(test1) w]
set x [fconfigure $f1 -blocking]
close $f1
set x
} 1
test io-39.2 {Tcl_GetChannelOption} {
file delete $path(test1)
set f1 [open $path(test1) w]
set x [fconfigure $f1 -buffering]
close $f1
set x
} full
|
| ︙ | ︙ | |||
5475 5476 5477 5478 5479 5480 5481 |
close $f
set x
} 40000
test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -encoding {}
| | | | | | | | 5539 5540 5541 5542 5543 5544 5545 5546 5547 5548 5549 5550 5551 5552 5553 5554 5555 5556 5557 5558 5559 5560 5561 5562 5563 5564 5565 5566 5567 5568 5569 5570 5571 5572 5573 5574 5575 5576 5577 5578 5579 5580 5581 5582 5583 5584 5585 5586 5587 5588 5589 5590 5591 5592 5593 5594 5595 5596 5597 5598 5599 5600 5601 |
close $f
set x
} 40000
test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -encoding {}
puts -nonewline $f \xE7\x89\xA6
close $f
set f [open $path(test1) r]
fconfigure $f -encoding utf-8
set x [read $f]
close $f
set x
} 牦
test io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -encoding binary
puts -nonewline $f \xE7\x89\xA6
close $f
set f [open $path(test1) r]
fconfigure $f -encoding utf-8
set x [read $f]
close $f
set x
} 牦
test io-39.16 {Tcl_SetChannelOption: -encoding, errors} {
file delete $path(test1)
set f [open $path(test1) w]
set result [list [catch {fconfigure $f -encoding foobar} msg] $msg]
close $f
set result
} {1 {unknown encoding "foobar"}}
test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio fileevent} {
set f [open "|[list [interpreter] $path(cat)]" r+]
fconfigure $f -encoding binary
puts -nonewline $f "\xE7"
flush $f
fconfigure $f -encoding utf-8 -blocking 0
variable x {}
fileevent $f readable [namespace code { lappend x [read $f] }]
vwait [namespace which -variable x]
after 300 [namespace code { lappend x timeout }]
vwait [namespace which -variable x]
fconfigure $f -encoding utf-8
vwait [namespace which -variable x]
after 300 [namespace code { lappend x timeout }]
vwait [namespace which -variable x]
fconfigure $f -encoding binary
vwait [namespace which -variable x]
after 300 [namespace code { lappend x timeout }]
vwait [namespace which -variable x]
close $f
set x
} "{} timeout {} timeout \xE7 timeout"
test io-39.18 {Tcl_SetChannelOption, setting read mode independently} \
{socket} {
proc accept {s a p} {close $s}
set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
set port [lindex [fconfigure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
|
| ︙ | ︙ | |||
5826 5827 5828 5829 5830 5831 5832 |
fileevent $f r "yet another"
lappend result [fileevent $f readable]
fileevent $f r ""
lappend result [fileevent $f readable]
} {{first script} {new script} {yet another} {}}
test io-42.3 {Tcl_FileeventCmd: replacing, with NULL chars in script} {fileevent} {
set result {}
| | | | | 5890 5891 5892 5893 5894 5895 5896 5897 5898 5899 5900 5901 5902 5903 5904 5905 5906 5907 5908 |
fileevent $f r "yet another"
lappend result [fileevent $f readable]
fileevent $f r ""
lappend result [fileevent $f readable]
} {{first script} {new script} {yet another} {}}
test io-42.3 {Tcl_FileeventCmd: replacing, with NULL chars in script} {fileevent} {
set result {}
fileevent $f r "first scr\x00ipt"
lappend result [string length [fileevent $f readable]]
fileevent $f r "new scr\x00ipt"
lappend result [string length [fileevent $f readable]]
fileevent $f r "yet ano\x00ther"
lappend result [string length [fileevent $f readable]]
fileevent $f r ""
lappend result [fileevent $f readable]
} {13 11 12 {}}
test io-43.1 {Tcl_FileeventCmd: creating, deleting, querying} {stdio unixExecs fileevent} {
|
| ︙ | ︙ | |||
6387 6388 6389 6390 6391 6392 6393 |
lappend l [gets $f]
incr c
}
}
set c 0
set l ""
set f [open $path(test1) r]
| | | 6451 6452 6453 6454 6455 6456 6457 6458 6459 6460 6461 6462 6463 6464 6465 |
lappend l [gets $f]
incr c
}
}
set c 0
set l ""
set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1A
fileevent $f readable [namespace code [list consume $f]]
variable x
vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.6 {cr write, testing readability, ^Z termination, auto read mode} {fileevent} {
file delete $path(test1)
|
| ︙ | ︙ | |||
6443 6444 6445 6446 6447 6448 6449 |
lappend l [gets $f]
incr c
}
}
set c 0
set l ""
set f [open $path(test1) r]
| | | 6507 6508 6509 6510 6511 6512 6513 6514 6515 6516 6517 6518 6519 6520 6521 |
lappend l [gets $f]
incr c
}
}
set c 0
set l ""
set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1A
fileevent $f readable [namespace code [list consume $f]]
variable x
vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.8 {crlf write, testing readability, ^Z termination, auto read mode} {fileevent} {
file delete $path(test1)
|
| ︙ | ︙ | |||
6499 6500 6501 6502 6503 6504 6505 |
lappend l [gets $f]
incr c
}
}
set c 0
set l ""
set f [open $path(test1) r]
| | | 6563 6564 6565 6566 6567 6568 6569 6570 6571 6572 6573 6574 6575 6576 6577 |
lappend l [gets $f]
incr c
}
}
set c 0
set l ""
set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1A
fileevent $f readable [namespace code [list consume $f]]
variable x
vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} {fileevent} {
file delete $path(test1)
|
| ︙ | ︙ | |||
6527 6528 6529 6530 6531 6532 6533 |
lappend l [gets $f]
incr c
}
}
set c 0
set l ""
set f [open $path(test1) r]
| | | 6591 6592 6593 6594 6595 6596 6597 6598 6599 6600 6601 6602 6603 6604 6605 |
lappend l [gets $f]
incr c
}
}
set c 0
set l ""
set f [open $path(test1) r]
fconfigure $f -translation lf -eofchar \x1A
fileevent $f readable [namespace code [list consume $f]]
variable x
vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.11 {lf write, testing readability, ^Z termination, lf read mode} {fileevent} {
file delete $path(test1)
|
| ︙ | ︙ | |||
6583 6584 6585 6586 6587 6588 6589 |
lappend l [gets $f]
incr c
}
}
set c 0
set l ""
set f [open $path(test1) r]
| | | 6647 6648 6649 6650 6651 6652 6653 6654 6655 6656 6657 6658 6659 6660 6661 |
lappend l [gets $f]
incr c
}
}
set c 0
set l ""
set f [open $path(test1) r]
fconfigure $f -translation cr -eofchar \x1A
fileevent $f readable [namespace code [list consume $f]]
variable x
vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.13 {cr write, testing readability, ^Z termination, cr read mode} {fileevent} {
file delete $path(test1)
|
| ︙ | ︙ | |||
6639 6640 6641 6642 6643 6644 6645 |
lappend l [gets $f]
incr c
}
}
set c 0
set l ""
set f [open $path(test1) r]
| | | 6703 6704 6705 6706 6707 6708 6709 6710 6711 6712 6713 6714 6715 6716 6717 |
lappend l [gets $f]
incr c
}
}
set c 0
set l ""
set f [open $path(test1) r]
fconfigure $f -translation crlf -eofchar \x1A
fileevent $f readable [namespace code [list consume $f]]
variable x
vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} {fileevent} {
file delete $path(test1)
|
| ︙ | ︙ | |||
7214 7215 7216 7217 7218 7219 7220 |
# 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
| | | 7278 7279 7280 7281 7282 7283 7284 7285 7286 7287 7288 7289 7290 7291 7292 |
# 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
puts $out "АА"
close $out
test io-52.9 {TclCopyChannel & encodings} {fcopy} {
# Copy kyrillic to UTF-8, using fcopy.
set in [open $path(kyrillic.txt) r]
set out [open $path(utf8-fcopy.txt) w]
|
| ︙ | ︙ | |||
7266 7267 7268 7269 7270 7271 7272 |
close $out
file size $path(utf8-fcopy.txt)
} 5
test io-52.11 {TclCopyChannel & encodings} -setup {
set out [open $path(utf8-fcopy.txt) w]
fconfigure $out -encoding utf-8 -translation lf
| | | 7330 7331 7332 7333 7334 7335 7336 7337 7338 7339 7340 7341 7342 7343 7344 |
close $out
file size $path(utf8-fcopy.txt)
} 5
test io-52.11 {TclCopyChannel & encodings} -setup {
set out [open $path(utf8-fcopy.txt) w]
fconfigure $out -encoding utf-8 -translation lf
puts $out "АА"
close $out
} -constraints {fcopy} -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]
|
| ︙ | ︙ | |||
8386 8387 8388 8389 8390 8391 8392 |
test io-60.1 {writing illegal utf sequences} {fileevent testbytestring} {
# This test will hang in older revisions of the core.
set out [open $path(script) w]
puts $out "catch {load $::tcltestlib Tcltest}"
puts $out {
| | | 8450 8451 8452 8453 8454 8455 8456 8457 8458 8459 8460 8461 8462 8463 8464 |
test io-60.1 {writing illegal utf sequences} {fileevent testbytestring} {
# This test will hang in older revisions of the core.
set out [open $path(script) w]
puts $out "catch {load $::tcltestlib Tcltest}"
puts $out {
puts [testbytestring \xE2]
exit 1
}
proc readit {pipe} {
variable x
variable result
if {[eof $pipe]} {
set x [catch {close $pipe} line]
|
| ︙ | ︙ | |||
8410 8411 8412 8413 8414 8415 8416 |
variable x ""
set result ""
vwait [namespace which -variable x]
# cut of the remainder of the error stack, especially the filename
set result [lreplace $result 3 3 [lindex [split [lindex $result 3] \n] 0]]
list $x $result
| | | 8474 8475 8476 8477 8478 8479 8480 8481 8482 8483 8484 8485 8486 8487 8488 |
variable x ""
set result ""
vwait [namespace which -variable x]
# cut of the remainder of the error stack, especially the filename
set result [lreplace $result 3 3 [lindex [split [lindex $result 3] \n] 0]]
list $x $result
} {1 {gets {} catch {error writing "stdout": illegal byte sequence}}}
test io-61.1 {Reset eof state after changing the eof char} -setup {
set datafile [makeFile {} eofchar]
set f [open $datafile w]
fconfigure $f -translation binary
puts -nonewline $f [string repeat "Ho hum\n" 11]
puts $f =
|
| ︙ | ︙ | |||
8684 8685 8686 8687 8688 8689 8690 |
test io-73.1 {channel Tcl_Obj SetChannelFromAny} {} {
# Test for Bug 1847044 - don't spoil type unless we have a valid channel
catch {close [lreplace [list a] 0 end]}
} {1}
test io-73.2 {channel Tcl_Obj SetChannelFromAny, bug 2407783} -setup {
| | | 8748 8749 8750 8751 8752 8753 8754 8755 8756 8757 8758 8759 8760 8761 8762 |
test io-73.1 {channel Tcl_Obj SetChannelFromAny} {} {
# Test for Bug 1847044 - don't spoil type unless we have a valid channel
catch {close [lreplace [list a] 0 end]}
} {1}
test io-73.2 {channel Tcl_Obj SetChannelFromAny, bug 2407783} -setup {
# Invalidate internalrep of 'channel' Tcl_Obj when transiting between interpreters.
set f [open [info script] r]
} -body {
interp create foo
seek $f 0
set code [catch {interp eval foo [list seek $f 0]} msg]
# The string map converts the changing channel handle to a fixed string
list $code [string map [list $f @@] $msg]
|
| ︙ | ︙ | |||
8744 8745 8746 8747 8748 8749 8750 |
set rfd [open $fn r]
set wfd [open $fn a]
chan configure $wfd -buffering none -translation binary
chan configure $rfd -buffersize 5 -encoding utf-8
read $rfd
} -body {
set result [eof $rfd]
| | | | 8808 8809 8810 8811 8812 8813 8814 8815 8816 8817 8818 8819 8820 8821 8822 8823 8824 8825 8826 8827 8828 8829 8830 |
set rfd [open $fn r]
set wfd [open $fn a]
chan configure $wfd -buffering none -translation binary
chan configure $rfd -buffersize 5 -encoding utf-8
read $rfd
} -body {
set result [eof $rfd]
puts -nonewline $wfd "more\xC2\xA0data"
lappend result [eof $rfd]
lappend result [read $rfd]
lappend result [eof $rfd]
} -cleanup {
close $wfd
close $rfd
removeFile io-73.5
} -result [list 1 1 more\xA0data 1]
test io-74.1 {[104f2885bb] improper cache validity check} -setup {
set fn [makeFile {} io-74.1]
set rfd [open $fn r]
testobj freeallvars
interp create child
} -constraints testobj -body {
|
| ︙ | ︙ |
Changes to tests/ioCmd.test.
| ︙ | ︙ | |||
490 491 492 493 494 495 496 |
fconfigure $f -translation binary
set result [string length [read $f]]
close $f
set result
} 5
test iocmd-12.11 {POSIX open access modes: BINARY} {
set f [open $path(test1) {WRONLY BINARY TRUNC}]
| | | | 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 |
fconfigure $f -translation binary
set result [string length [read $f]]
close $f
set result
} 5
test iocmd-12.11 {POSIX open access modes: BINARY} {
set f [open $path(test1) {WRONLY BINARY TRUNC}]
puts $f Ɉ ;# gets truncated to H
close $f
set f [open $path(test1) r]
fconfigure $f -translation binary
set result [read -nonewline $f]
close $f
set result
} H
test iocmd-13.1 {errors in open command} {
list [catch {open} msg] $msg
} {1 {wrong # args: should be "open fileName ?access? ?permissions?"}}
test iocmd-13.2 {errors in open command} {
list [catch {open a b c d} msg] $msg
} {1 {wrong # args: should be "open fileName ?access? ?permissions?"}}
|
| ︙ | ︙ |
Changes to tests/list.test.
| ︙ | ︙ | |||
41 42 43 44 45 46 47 |
test list-1.21 {basic tests} {list a b c\\\nd} "a b c\\\\\\nd"
test list-1.22 {basic tests} {list "{ab}\\"} \\{ab\\}\\\\
test list-1.23 {basic tests} {list \{} "\\{"
test list-1.24 {basic tests} {list} {}
test list-1.25 {basic tests} {list # #} {{#} #}
test list-1.26 {basic tests} {list #\{ #\{} {\#\{ #\{}
test list-1.27 {basic null treatment} {
| | | | | | | | | 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 |
test list-1.21 {basic tests} {list a b c\\\nd} "a b c\\\\\\nd"
test list-1.22 {basic tests} {list "{ab}\\"} \\{ab\\}\\\\
test list-1.23 {basic tests} {list \{} "\\{"
test list-1.24 {basic tests} {list} {}
test list-1.25 {basic tests} {list # #} {{#} #}
test list-1.26 {basic tests} {list #\{ #\{} {\#\{ #\{}
test list-1.27 {basic null treatment} {
set l [list "" "\x00" "\x00\x00"]
set e "{} \x00 \x00\x00"
string equal $l $e
} 1
test list-1.28 {basic null treatment} {
set result "\x00a\x00b"
list $result [string length $result]
} "\x00a\x00b 4"
test list-1.29 {basic null treatment} {
set result "\x00a\x00b"
set srep "$result 4"
set lrep [list $result [string length $result]]
string equal $srep $lrep
} 1
test list-1.30 {basic null treatment} {
set l [list "\x00abc" "xyz"]
set e "\x00abc xyz"
string equal $l $e
} 1
# For the next round of tests create a list and then pick it apart
# with "index" to make sure that we get back exactly what went in.
set num 0
|
| ︙ | ︙ |
Changes to tests/load.test.
| ︙ | ︙ | |||
32 33 34 35 36 37 38 |
# Tests also require that this DLL has not already been loaded.
set loaded "[file tail $x]Loaded"
set alreadyLoaded [info loaded]
testConstraint $loaded [expr {![string match *pkga* $alreadyLoaded]}]
set alreadyTotalLoaded [info loaded]
| | | | 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 |
# Tests also require that this DLL has not already been loaded.
set loaded "[file tail $x]Loaded"
set alreadyLoaded [info loaded]
testConstraint $loaded [expr {![string match *pkga* $alreadyLoaded]}]
set alreadyTotalLoaded [info loaded]
# Certain tests require the 'teststaticlibrary' command from tcltest
testConstraint teststaticlibrary [llength [info commands teststaticlibrary]]
# Test load-10.1 requires the 'testsimplefilesystem' command from tcltest
testConstraint testsimplefilesystem \
[llength [info commands testsimplefilesystem]]
test load-1.1 {basic errors} -returnCodes error -body {
|
| ︙ | ︙ | |||
146 147 148 149 150 151 152 |
#
# As of 2005, such ancient broken systems no longer matter.
test load-6.1 {errors loading file} [list $dll $loaded] {
catch {load foo foo}
} {1}
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 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 |
#
# As of 2005, such ancient broken systems no longer matter.
test load-6.1 {errors loading file} [list $dll $loaded] {
catch {load foo foo}
} {1}
test load-7.1 {Tcl_StaticLibrary procedure} [list teststaticlibrary] {
set x "not loaded"
teststaticlibrary Test 1 0
load {} test
load {} test child
list [set x] [child eval set x]
} {loaded loaded}
test load-7.2 {Tcl_StaticLibrary procedure} [list teststaticlibrary] {
set x "not loaded"
teststaticlibrary Another 0 0
load {} Another
child eval {set x "not loaded"}
list [catch {load {} Another child} msg] $msg \
[child eval set x] [set x]
} {1 {can't use library in a safe interpreter: no Another_SafeInit procedure} {not loaded} loaded}
test load-7.3 {Tcl_StaticLibrary procedure} [list teststaticlibrary] {
set x "not loaded"
teststaticlibrary More 0 1
load {} more
set x
} {not loaded}
catch {load [file join $testDir pkga$ext] Pkga}
catch {load [file join $testDir pkgb$ext] Pkgb}
catch {load [file join $testDir pkge$ext] Pkge}
set currentRealLibraries [list [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]]
test load-7.4 {Tcl_StaticLibrary procedure, redundant calls} -setup {
teststaticlibrary Test 1 0
teststaticlibrary Another 0 0
teststaticlibrary More 0 1
} -constraints [list teststaticlibrary $dll $loaded] -body {
teststaticlibrary Double 0 1
teststaticlibrary Double 0 1
info loaded
} -result [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealLibraries {*}$alreadyTotalLoaded]
testConstraint teststaticlibrary_8.x 0
if {[testConstraint teststaticlibrary]} {
catch {
teststaticlibrary Test 1 1
teststaticlibrary Another 0 1
teststaticlibrary More 0 1
teststaticlibrary Double 0 1
testConstraint teststaticlibrary_8.x 1
}
}
test load-8.1 {TclGetLoadedLibraries procedure} [list teststaticlibrary_8.x $dll $loaded] {
lsort -index 1 [info loaded]
} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealLibraries {*}$alreadyTotalLoaded]]
test load-8.2 {TclGetLoadedLibraries procedure} -constraints {teststaticlibrary_8.x} -body {
info loaded gorp
} -returnCodes error -result {could not find interpreter "gorp"}
test load-8.3a {TclGetLoadedLibraries procedure} [list teststaticlibrary_8.x $dll $loaded] {
lsort -index 1 [info loaded {}]
} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga] [list [file join $testDir pkgb$ext] Pkgb] {*}$alreadyLoaded]]
test load-8.3b {TclGetLoadedLibraries procedure} [list teststaticlibrary_8.x $dll $loaded] {
lsort -index 1 [info loaded child]
} [lsort -index 1 [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]]
test load-8.4 {TclGetLoadedLibraries procedure} [list teststaticlibrary_8.x $dll $loaded] {
load [file join $testDir pkgb$ext] Pkgb
list [lsort -index 1 [info loaded {}]] [lsort [info commands pkgb_*]]
} [list [lsort -index 1 [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded]] {pkgb_demo pkgb_sub pkgb_unsafe}]
interp delete child
test load-9.1 {Tcl_StaticLibrary, load already-loaded package into another interp} -setup {
interp create child1
interp create child2
load {} Tcltest child1
load {} Tcltest child2
} -constraints {teststaticlibrary} -body {
child1 eval { teststaticlibrary Loadninepointone 0 1 }
child2 eval { teststaticlibrary Loadninepointone 0 1 }
list [child1 eval { info loaded {} }] \
[child2 eval { info loaded {} }]
} -match glob -cleanup {
interp delete child1
interp delete child2
} -result {{{{} Loadninepointone} {* Tcltest}} {{{} Loadninepointone} {* Tcltest}}}
|
| ︙ | ︙ |
Changes to tests/lsearch.test.
| ︙ | ︙ | |||
98 99 100 101 102 103 104 |
lsearch -index a b
} -result {"-index" option must be followed by list index}
test lsearch-3.7 {lsearch errors} -returnCodes error -body {
lsearch -subindices -exact a b
} -result {-subindices cannot be used without -index option}
test lsearch-4.1 {binary data} {
| | | | 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 |
lsearch -index a b
} -result {"-index" option must be followed by list index}
test lsearch-3.7 {lsearch errors} -returnCodes error -body {
lsearch -subindices -exact a b
} -result {-subindices cannot be used without -index option}
test lsearch-4.1 {binary data} {
lsearch -exact [list foo one\x00two bar] bar
} 2
test lsearch-4.2 {binary data} {
set x one
append x \x00
append x two
lsearch -exact [list foo one\x00two bar] $x
} 1
# Make a sorted list
set l {}
set l2 {}
for {set i 0} {$i < 100} {incr i} {
lappend l $i
|
| ︙ | ︙ |
Changes to tests/lset.test.
| ︙ | ︙ | |||
408 409 410 411 412 413 414 |
test lset-14.2 {lset, not compiled, flat args, is string rep preserved?} testevalex {
set a { { 1 2 } { 3 4 } }
catch { testevalex {lset a 1 5 5} }
list $a [lindex $a 1]
} "{ { 1 2 } { 3 4 } } { 3 4 }"
testConstraint testobj [llength [info commands testobj]]
| | | 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 |
test lset-14.2 {lset, not compiled, flat args, is string rep preserved?} testevalex {
set a { { 1 2 } { 3 4 } }
catch { testevalex {lset a 1 5 5} }
list $a [lindex $a 1]
} "{ { 1 2 } { 3 4 } } { 3 4 }"
testConstraint testobj [llength [info commands testobj]]
test lset-15.1 {lset: shared internalrep [Bug 1677512]} -setup {
teststringobj set 1 {{1 2} 3}
testobj convert 1 list
testobj duplicate 1 2
variable x [teststringobj get 1]
variable y [teststringobj get 2]
testobj freeallvars
set l [list $y z]
|
| ︙ | ︙ |
Changes to tests/main.test.
| ︙ | ︙ | |||
64 65 66 67 68 69 70 |
} -result [list [interpreter] -script 0]\n
test Tcl_Main-1.3 {
} -constraints {
stdio
} -setup {
makeFile {puts [list $argv0 $argv $tcl_interactive]} script
| | | | | | | | | | | | | | | | | | 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 |
} -result [list [interpreter] -script 0]\n
test Tcl_Main-1.3 {
} -constraints {
stdio
} -setup {
makeFile {puts [list $argv0 $argv $tcl_interactive]} script
catch {set f [open "|[list [interpreter] script À]" r]}
} -body {
read $f
} -cleanup {
close $f
removeFile script
} -result [list script [list [encoding convertfrom [encoding system] \
[encoding convertto [encoding system] À]]] 0]\n
test Tcl_Main-1.4 {
} -constraints {
stdio
} -setup {
makeFile {puts [list $argv0 $argv $tcl_interactive]} script
catch {set f [open "|[list [interpreter] script €]" r]}
} -body {
read $f
} -cleanup {
close $f
removeFile script
} -result [list script [list [encoding convertfrom [encoding system] \
[encoding convertto [encoding system] €]]] 0]\n
test Tcl_Main-1.5 {
} -constraints {
stdio
} -setup {
makeFile {puts [list $argv0 $argv $tcl_interactive]} À
catch {set f [open "|[list [interpreter] À]" r]}
} -body {
read $f
} -cleanup {
close $f
removeFile À
} -result [list [list [encoding convertfrom [encoding system] \
[encoding convertto [encoding system] À]]] {} 0]\n
test Tcl_Main-1.6 {
} -constraints {
stdio
} -setup {
makeFile {puts [list $argv0 $argv $tcl_interactive]} €
catch {set f [open "|[list [interpreter] €]" r]}
} -body {
read $f
} -cleanup {
close $f
removeFile €
} -result [list [list [encoding convertfrom [encoding system] \
[encoding convertto [encoding system] €]]] {} 0]\n
test Tcl_Main-1.7 {
Tcl_Main: startup script - -encoding option
} -constraints {
stdio
} -setup {
set script [makeFile {} script]
file delete $script
set f [open $script w]
chan configure $f -encoding utf-8
puts $f {puts [list $argv0 $argv $tcl_interactive]}
puts -nonewline $f {puts [string equal € }
puts $f "€]"
close $f
catch {set f [open "|[list [interpreter] -encoding utf-8 script]" r]}
} -body {
read $f
} -cleanup {
close $f
removeFile script
} -result [list script {} 0]\n1\n
test Tcl_Main-1.8 {
Tcl_Main: startup script - -encoding option - mismatched encodings
} -constraints {
stdio
} -setup {
set script [makeFile {} script]
file delete $script
set f [open $script w]
chan configure $f -encoding utf-8
puts $f {puts [list $argv0 $argv $tcl_interactive]}
puts -nonewline $f {puts [string equal \u20ac }
puts $f "€]"
close $f
catch {set f [open "|[list [interpreter] -encoding ascii script]" r]}
} -body {
read $f
} -cleanup {
close $f
removeFile script
} -result [list script {} 0]\n0\n
test Tcl_Main-1.9 {
Tcl_Main: startup script - -encoding option - no abbrevation
} -constraints {
stdio
} -setup {
set script [makeFile {} script]
file delete $script
set f [open $script w]
chan configure $f -encoding utf-8
puts $f {puts [list $argv0 $argv $tcl_interactive]}
puts -nonewline $f {puts [string equal \u20ac }
puts $f "€]"
close $f
catch {set f [open "|[list [interpreter] -enc utf-8 script]" r+]}
} -body {
type $f {
puts $argv
}
list [catch {gets $f} line] $line
|
| ︙ | ︙ | |||
602 603 604 605 606 607 608 |
Tcl_Main handles stdin EOF in mid-command
} -constraints {
exec
} -setup {
catch {set f [open "|[list [interpreter]]" w+]}
catch {chan configure $f -blocking 0}
} -body {
| | | | 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 |
Tcl_Main handles stdin EOF in mid-command
} -constraints {
exec
} -setup {
catch {set f [open "|[list [interpreter]]" w+]}
catch {chan configure $f -blocking 0}
} -body {
type $f "chan configure stdin -eofchar \"\\x1A {}\"
if 1 \{\n\x1A"
variable wait
chan event $f readable \
[list set [namespace which -variable wait] "child exit"]
set id [after 5000 [list set [namespace which -variable wait] timeout]]
vwait [namespace which -variable wait]
after cancel $id
set wait
|
| ︙ | ︙ |
Changes to tests/namespace.test.
| ︙ | ︙ | |||
178 179 180 181 182 183 184 |
proc x {} {}
trace add command x delete "namespace delete [namespace current];#"
}
namespace delete test_ns_2
} {}
test namespace-7.7 {Bug 1655305} -setup {
interp create child
| | | | 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 |
proc x {} {}
trace add command x delete "namespace delete [namespace current];#"
}
namespace delete test_ns_2
} {}
test namespace-7.7 {Bug 1655305} -setup {
interp create child
# Can't invoke through the ensemble, since deleting ::tcl
# (indirectly, via deleting the global namespace) deletes the ensemble.
child eval {rename ::tcl::info::commands ::infocommands}
child hide infocommands
child eval {
proc foo {} {
namespace delete ::
}
}
|
| ︙ | ︙ | |||
203 204 205 206 207 208 209 |
namespace ensemble create
}
trace add command ns1 delete {
namespace delete ns1
}
} -body {
| | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
namespace ensemble create
}
trace add command ns1 delete {
namespace delete ns1
}
} -body {
# No segmentation fault given --enable-symbols.
namespace delete ns1
} -result {}
test namespace-7.9 {
Bug e39cb3f462631a99
A namespace being deleted should not be removed from other namespace paths
until the contents of the namespace are entirely removed.
} -setup {
} -body {
variable res {}
namespace eval ns1 {
proc p1 caller {
lappend [namespace parent]::res $caller
}
}
namespace eval ns1a {
namespace path [namespace parent]::ns1
proc t1 {old new op} {
$old t1
}
}
namespace eval ns2 {
proc p1 caller {
lappend [namespace parent]::res $caller
}
}
namespace eval ns2a {
namespace path [namespace parent]::ns2
proc t1 {old new op} {
[namespace tail $old] t2
}
}
trace add command ns1::p1 delete ns1a::t1
namespace delete ns1
trace add command ns2::p1 delete ns2a::t1
namespace delete ns2
return $res
} -cleanup {
namespace delete ns1a
namespace delete ns2a
unset res
} -result {t1 t2}
test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
catch {interp delete test_interp}
interp create test_interp
interp eval test_interp {
namespace eval test_ns_1 {
namespace export p
|
| ︙ | ︙ | |||
1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 |
namespace ensemble configure n -subcommands $lst -map $lst
} -body {
n one
} -cleanup {
namespace delete n
unset -nocomplain lst
} -returnCodes error -match glob -result {invalid command name *three*}
test namespace-43.1 {ensembles: dict-driven} {
namespace eval ns {
namespace export x*
proc x1 {} {format 1}
proc x2 {} {format 2}
namespace ensemble create -map {a x1 b x2}
| > > > > > > > > > > > > > > > > > > | 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 |
namespace ensemble configure n -subcommands $lst -map $lst
} -body {
n one
} -cleanup {
namespace delete n
unset -nocomplain lst
} -returnCodes error -match glob -result {invalid command name *three*}
test namespace-42.11 {
ensembles: prefix matching segmentation fault
issue ccc448a6bfd59cbd
} -body {
namespace eval n1 {
namespace ensemble create
namespace export *
proc p1 args {error success}
}
# segmentation fault only occurs in the non-byte-compiled path, so avoid
# byte compilation
set cmd {namespace eva n1 {[namespace parent]::n1 p1}}
{*}$cmd
} -returnCodes error -result success
test namespace-43.1 {ensembles: dict-driven} {
namespace eval ns {
namespace export x*
proc x1 {} {format 1}
proc x2 {} {format 2}
namespace ensemble create -map {a x1 b x2}
|
| ︙ | ︙ | |||
2719 2720 2721 2722 2723 2724 2725 |
}
} -result {2 {} 2} -cleanup {
catch {namespace delete ::test_ns_1}
catch {namespace delete ::test_ns_2}
catch {namespace delete ::test_ns_3}
catch {namespace delete ::test_ns_4}
}
| | > > > > | 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 |
}
} -result {2 {} 2} -cleanup {
catch {namespace delete ::test_ns_1}
catch {namespace delete ::test_ns_2}
catch {namespace delete ::test_ns_3}
catch {namespace delete ::test_ns_4}
}
test namespace-51.13 {
name resolution path control
when the trace fires, ns_2 is being deleted but isn't gone yet, and is
still visible for the trace
} -body {
set ::result {}
namespace eval ::test_ns_1 {
proc foo {} {lappend ::result 1}
}
namespace eval ::test_ns_2 {
proc foo {} {lappend ::result 2}
trace add command foo delete "namespace eval ::test_ns_3 foo;#"
|
| ︙ | ︙ | |||
2742 2743 2744 2745 2746 2747 2748 |
namespace eval ::test_ns_4 {
namespace path {::test_ns_2 ::test_ns_3 ::test_ns_1}
proc bar {} {
list [foo] [namespace delete ::test_ns_2] [foo]
}
bar
}
| < | | 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 |
namespace eval ::test_ns_4 {
namespace path {::test_ns_2 ::test_ns_3 ::test_ns_1}
proc bar {} {
list [foo] [namespace delete ::test_ns_2] [foo]
}
bar
}
} -result {2 {} {2 3 2 1}} -cleanup {
catch {namespace delete ::test_ns_1}
catch {namespace delete ::test_ns_2}
catch {namespace delete ::test_ns_3}
catch {namespace delete ::test_ns_4}
}
test namespace-51.14 {name resolution path control} -setup {
foreach cmd [info commands foo*] {
|
| ︙ | ︙ | |||
3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 |
} -body {
namespace-56.5 cmd
} -cleanup {
namespace delete namespace-56.5
} -result 1
test namespace-57.0 {
an imported alias should be usable in the deletion trace for the alias
see 29e8848eb976
} -body {
variable res {}
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 |
} -body {
namespace-56.5 cmd
} -cleanup {
namespace delete namespace-56.5
} -result 1
test namespace-56.6 {
Namespace deletion traces on both the original routine and the imported
routine should run without any memory error under a debug build.
} -body {
variable res {}
proc ondelete {old new op} {
variable res
set tail [namespace tail $old]
set up [namespace tail [namespace qualifiers $old]]
lappend res [list $up $tail]
}
namespace eval ns1 {} {
namespace export *
proc p1 {} {
namespace upvar [namespace parent] res res
incr res
}
trace add command p1 delete ondelete
}
namespace eval ns2 {} {
namespace import [namespace parent]::ns1::p1
trace add command p1 delete ondelete
}
namespace delete ns1
namespace delete ns2
after 1
return $res
} -cleanup {
unset res
rename ondelete {}
} -result {{ns1 p1} {ns2 p1}}
test namespace-57.0 {
an imported alias should be usable in the deletion trace for the alias
see 29e8848eb976
} -body {
variable res {}
|
| ︙ | ︙ |
Changes to tests/obj.test.
| ︙ | ︙ | |||
247 248 249 250 251 252 253 |
set result ""
lappend result [testobj newobj 1]
lappend result [catch {testbooleanobj not 1} msg]
lappend result $msg
} {{} 1 {expected boolean value but got ""}}
test obj-13.8 {SetBooleanFromAny, unicode strings} testobj {
set result ""
| | | | 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 |
set result ""
lappend result [testobj newobj 1]
lappend result [catch {testbooleanobj not 1} msg]
lappend result $msg
} {{} 1 {expected boolean value but got ""}}
test obj-13.8 {SetBooleanFromAny, unicode strings} testobj {
set result ""
lappend result [teststringobj set 1 1睷]
lappend result [catch {testbooleanobj not 1} msg]
lappend result $msg
} "1睷 1 {expected boolean value but got \"1睷\"}"
test obj-14.1 {UpdateStringOfBoolean} testobj {
set result ""
lappend result [testbooleanobj set 1 0]
lappend result [testbooleanobj not 1]
lappend result [testbooleanobj get 1] ;# must update string rep
} {0 1 1}
|
| ︙ | ︙ |
Changes to tests/parse.test.
| ︙ | ︙ | |||
27 28 29 30 31 32 33 |
testConstraint testparsevar [llength [info commands testparsevar]]
testConstraint testasync [llength [info commands testasync]]
testConstraint testcmdtrace [llength [info commands testcmdtrace]]
testConstraint testevent [llength [info commands testevent]]
testConstraint memory [llength [info commands memory]]
test parse-1.1 {Tcl_ParseCommand procedure, computing string length} {testparser testbytestring} {
| | | 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 |
testConstraint testparsevar [llength [info commands testparsevar]]
testConstraint testasync [llength [info commands testasync]]
testConstraint testcmdtrace [llength [info commands testcmdtrace]]
testConstraint testevent [llength [info commands testevent]]
testConstraint memory [llength [info commands memory]]
test parse-1.1 {Tcl_ParseCommand procedure, computing string length} {testparser testbytestring} {
testparser [testbytestring "foo\x00 bar"] -1
} {- foo 1 simple foo 1 text foo 0 {}}
test parse-1.2 {Tcl_ParseCommand procedure, computing string length} testparser {
testparser "foo bar" -1
} {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
test parse-1.3 {Tcl_ParseCommand procedure, leading space} testparser {
testparser " \n\t foo" 0
} {- foo 1 simple foo 1 text foo 0 {}}
|
| ︙ | ︙ | |||
296 297 298 299 300 301 302 |
test parse-6.14 {ParseTokens procedure, backslash-newline} testparser {
testparser "b\\\nc" 0
} {- b\\\nc 2 simple b 1 text b 0 simple c 1 text c 0 {}}
test parse-6.15 {ParseTokens procedure, backslash-newline} testparser {
testparser "\"b\\\nc\"" 0
} {- \"b\\\nc\" 1 word \"b\\\nc\" 3 text b 0 backslash \\\n 0 text c 0 {}}
test parse-6.16 {ParseTokens procedure, backslash substitution} testparser {
| | | | 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 |
test parse-6.14 {ParseTokens procedure, backslash-newline} testparser {
testparser "b\\\nc" 0
} {- b\\\nc 2 simple b 1 text b 0 simple c 1 text c 0 {}}
test parse-6.15 {ParseTokens procedure, backslash-newline} testparser {
testparser "\"b\\\nc\"" 0
} {- \"b\\\nc\" 1 word \"b\\\nc\" 3 text b 0 backslash \\\n 0 text c 0 {}}
test parse-6.16 {ParseTokens procedure, backslash substitution} testparser {
testparser {\n\a\x7F} 0
} {- {\n\a\x7F} 1 word {\n\a\x7F} 3 backslash {\n} 0 backslash {\a} 0 backslash {\x7F} 0 {}}
test parse-6.17 {ParseTokens procedure, null characters} {testparser testbytestring} {
expr {[testparser [testbytestring "foo\0zz"] 0] eq
"- [testbytestring foo\0zz] 1 word [testbytestring foo\0zz] 3 text foo 0 text [testbytestring \0] 0 text zz 0 {}"
}
} 1
test parse-6.18 {ParseTokens procedure, seek past numBytes for close-bracket} testparser {
# Test for Bug 681841
|
| ︙ | ︙ | |||
703 704 705 706 707 708 709 |
expr {$end - $tmp}
} -cleanup {
unset -nocomplain a end i vn res tmp
rename getbytes {}
} -result 0
test parse-14.1 {Tcl_ParseBraces procedure, computing string length} {testparser testbytestring} {
| | | 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 |
expr {$end - $tmp}
} -cleanup {
unset -nocomplain a end i vn res tmp
rename getbytes {}
} -result 0
test parse-14.1 {Tcl_ParseBraces procedure, computing string length} {testparser testbytestring} {
testparser [testbytestring "foo\x00 bar"] -1
} {- foo 1 simple foo 1 text foo 0 {}}
test parse-14.2 {Tcl_ParseBraces procedure, computing string length} testparser {
testparser "foo bar" -1
} {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
test parse-14.3 {Tcl_ParseBraces procedure, words in braces} testparser {
testparser {foo {a $b [concat foo]} {c d}} 0
} {- {foo {a $b [concat foo]} {c d}} 3 simple foo 1 text foo 0 simple {{a $b [concat foo]}} 1 text {a $b [concat foo]} 0 simple {{c d}} 1 text {c d} 0 {}}
|
| ︙ | ︙ | |||
740 741 742 743 744 745 746 |
testparser {foo {}} 0
} {- {foo {}} 2 simple foo 1 text foo 0 simple {{}} 1 text {} 0 {}}
test parse-14.12 {Tcl_ParseBraces procedure, missing close brace} testparser {
list [catch {testparser "foo \{xy\\\nz" 0} msg] $msg $::errorInfo
} {1 {missing close-brace} missing\ close-brace\n\ \ \ \ (remainder\ of\ script:\ \"\{xy\\\nz\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"foo\ \\\{xy\\\\\\nz\"\ 0\"}
test parse-15.1 {Tcl_ParseQuotedString procedure, computing string length} {testparser testbytestring} {
| | | 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 |
testparser {foo {}} 0
} {- {foo {}} 2 simple foo 1 text foo 0 simple {{}} 1 text {} 0 {}}
test parse-14.12 {Tcl_ParseBraces procedure, missing close brace} testparser {
list [catch {testparser "foo \{xy\\\nz" 0} msg] $msg $::errorInfo
} {1 {missing close-brace} missing\ close-brace\n\ \ \ \ (remainder\ of\ script:\ \"\{xy\\\nz\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"foo\ \\\{xy\\\\\\nz\"\ 0\"}
test parse-15.1 {Tcl_ParseQuotedString procedure, computing string length} {testparser testbytestring} {
testparser [testbytestring "foo\x00 bar"] -1
} {- foo 1 simple foo 1 text foo 0 {}}
test parse-15.2 {Tcl_ParseQuotedString procedure, computing string length} testparser {
testparser "foo bar" -1
} {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
test parse-15.3 {Tcl_ParseQuotedString procedure, word is quoted string} testparser {
testparser {foo "a b c" d "efg";} 0
} {- {foo "a b c" d "efg";} 4 simple foo 1 text foo 0 simple {"a b c"} 1 text {a b c} 0 simple d 1 text d 0 simple {"efg"} 1 text efg 0 {}}
|
| ︙ | ︙ | |||
906 907 908 909 910 911 912 |
test parse-15.53 {CommandComplete procedure} "
info complete \" # \{\"
" 1
test parse-15.54 {CommandComplete procedure} "
info complete \"foo bar;# \{\"
" 1
test parse-15.55 {CommandComplete procedure} testbytestring {
| | | | 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 |
test parse-15.53 {CommandComplete procedure} "
info complete \" # \{\"
" 1
test parse-15.54 {CommandComplete procedure} "
info complete \"foo bar;# \{\"
" 1
test parse-15.55 {CommandComplete procedure} testbytestring {
info complete "set x [testbytestring \x00]; puts hi"
} 1
test parse-15.56 {CommandComplete procedure} testbytestring {
info complete "set x [testbytestring \x00]; \{"
} 0
test parse-15.57 {CommandComplete procedure} {
info complete "# Comment should be complete command"
} 1
test parse-15.58 {CommandComplete procedure, memory leaks} {
info complete "1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22"
} 1
|
| ︙ | ︙ |
Changes to tests/parseExpr.test.
| ︙ | ︙ | |||
28 29 30 31 32 33 34 |
proc testIEEE {} {
variable ieeeValues
binary scan [binary format dd -1.0 1.0] c* c
switch -exact -- $c {
{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
# little endian
| | | | | | | | | | | | | 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 |
proc testIEEE {} {
variable ieeeValues
binary scan [binary format dd -1.0 1.0] c* c
switch -exact -- $c {
{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
# little endian
binary scan \x00\x00\x00\x00\x00\x00\xF0\xFF d \
ieeeValues(-Infinity)
binary scan \x00\x00\x00\x00\x00\x00\xF0\xBF d \
ieeeValues(-Normal)
binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \
ieeeValues(-Subnormal)
binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \
ieeeValues(-0)
binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+0)
binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \
ieeeValues(+Subnormal)
binary scan \x00\x00\x00\x00\x00\x00\xF0\x3F d \
ieeeValues(+Normal)
binary scan \x00\x00\x00\x00\x00\x00\xF0\x7F d \
ieeeValues(+Infinity)
binary scan \x00\x00\x00\x00\x00\x00\xF8\x7F d \
ieeeValues(NaN)
set ieeeValues(littleEndian) 1
return 1
}
{-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} {
binary scan \xFF\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Infinity)
binary scan \xBF\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Normal)
binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Subnormal)
binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-0)
binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+0)
binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Subnormal)
binary scan \x3F\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Normal)
binary scan \x7F\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Infinity)
binary scan \x7F\xF8\x00\x00\x00\x00\x00\x00 d \
ieeeValues(NaN)
set ieeeValues(littleEndian) 0
return 1
}
default {
return 0
}
}
}
testConstraint ieeeFloatingPoint [testIEEE]
######################################################################
test parseExpr-1.1 {Tcl_ParseExpr procedure, computing string length} {testexprparser testbytestring} {
testexprparser [testbytestring "1+2\x00 +3"] -1
} {- {} 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
test parseExpr-1.2 {Tcl_ParseExpr procedure, computing string length} testexprparser {
testexprparser "1 + 2" -1
} {- {} 0 subexpr {1 + 2} 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
test parseExpr-1.3 {Tcl_ParseExpr procedure, error getting initial lexeme} testexprparser {
testexprparser 12345678901234567890 -1
} {- {} 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}}
|
| ︙ | ︙ | |||
878 879 880 881 882 883 884 |
} -returnCodes error -result {invalid character "@"
in expression "0@"abcdefghijklmnopqrstu..."}
test parseExpr-21.36 {error messages} -body {
expr {"abcdefghijklmnopqrstuvwxyz"@"abcdefghijklmnopqrstuvwxyz"}
} -returnCodes error -result {invalid character "@"
in expression "...fghijklmnopqrstuvwxyz"@"abcdefghijklmnopqrstu..."}
test parseExpr-21.37 {error messages} -body {
| | | | | | | | | | 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 |
} -returnCodes error -result {invalid character "@"
in expression "0@"abcdefghijklmnopqrstu..."}
test parseExpr-21.36 {error messages} -body {
expr {"abcdefghijklmnopqrstuvwxyz"@"abcdefghijklmnopqrstuvwxyz"}
} -returnCodes error -result {invalid character "@"
in expression "...fghijklmnopqrstuvwxyz"@"abcdefghijklmnopqrstu..."}
test parseExpr-21.37 {error messages} -body {
expr [format {"%s" @ 0} [string repeat \xA7 25]]
} -returnCodes error -result [format {invalid character "@"
in expression "...%s" @ 0"} [string repeat \xA7 10]]
test parseExpr-21.38 {error messages} -body {
expr [format {0 @ "%s"} [string repeat \xA7 25]]
} -returnCodes error -result [format {invalid character "@"
in expression "0 @ "%s..."} [string repeat \xA7 10]]
test parseExpr-21.39 {error messages} -body {
expr [format {"%s" @ "%s"} [string repeat \xA7 25] [string repeat \xA7 25]]
} -returnCodes error -result [format {invalid character "@"
in expression "...%s" @ "%s..."} [string repeat \xA7 10] [string repeat \xA7 10]]
test parseExpr-21.40 {error messages} -body {
catch {expr {"abcdefghijklmnopqrstuvwxyz"@0}} m o
dict get $o -errorinfo
} -result {invalid character "@"
in expression "...fghijklmnopqrstuvwxyz"@0"
(parsing expression ""abcdefghijklmnopqrstu...")
invoked from within
"expr {"abcdefghijklmnopqrstuvwxyz"@0}"}
test parseExpr-21.41 {error messages} -body {
catch {expr [format {"%s" @ 0} [string repeat \xA7 25]]} m o
dict get $o -errorinfo
} -result [format {invalid character "@"
in expression "...%s" @ 0"
(parsing expression ""%s...")
invoked from within
"expr [format {"%%s" @ 0} [string repeat \xA7 25]]"} [string repeat \xA7 10] [string repeat \xA7 10]]
test parseExpr-21.42 {error message} -body {
expr {123456789012345678901234567890*"abcdefghijklmnopqrstuvwxyz}
} -returnCodes error -result {missing "
in expression "...012345678901234567890*"abcdefghijklmnopqrstuv..."}
test parseExpr-21.43 {error message} -body {
expr "123456789012345678901234567890*\"foobar\$\{abcdefghijklmnopqrstuvwxyz\""
} -returnCodes error -result "missing close-brace for variable name
|
| ︙ | ︙ | |||
1062 1063 1064 1065 1066 1067 1068 |
} -result {TCL PARSE EXPR BADNUMBER BINARY}
test parseExpr-22.18 {Bug 3401704} -constraints testexprparser -body {
catch {testexprparser 0b02 -1} m o
dict get $o -errorcode
} -result {TCL PARSE EXPR BADNUMBER BINARY}
test parseExpr-22.19 {Bug d2ffcca163} -constraints testexprparser -body {
| | | | | 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 |
} -result {TCL PARSE EXPR BADNUMBER BINARY}
test parseExpr-22.18 {Bug 3401704} -constraints testexprparser -body {
catch {testexprparser 0b02 -1} m o
dict get $o -errorcode
} -result {TCL PARSE EXPR BADNUMBER BINARY}
test parseExpr-22.19 {Bug d2ffcca163} -constraints testexprparser -body {
testexprparser г -1
} -returnCodes error -match glob -result {*invalid character*}
test parseExpr-22.20 {Bug d2ffcca163} -constraints testexprparser -body {
testexprparser п -1
} -returnCodes error -match glob -result {*invalid character*}
test parseExpr-22.21 {Bug d2ffcca163} -constraints testexprparser -body {
testexprparser inг(0) -1
} -returnCodes error -match glob -result {missing operand*}
test parseExpr-23.1 {TIP 582: comments} -constraints testexprparser -body {
testexprparser "7 # * 8 " -1
} -result {- {} 0 subexpr 7 1 text 7 0 {}}
test parseExpr-23.2 {TIP 582: comments} -constraints testexprparser -body {
testexprparser "7 #\n* 8 " -1
} -result {- {} 0 subexpr {7 #
*} 5 operator # 0 subexpr 7 1 text 7 0 subexpr * 1 text * 0 {}}
# cleanup
cleanupTests
return
|
Changes to tests/parseOld.test.
| ︙ | ︙ | |||
18 19 20 21 22 23 24 |
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
testConstraint testwordend [llength [info commands testwordend]]
| < | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 |
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
testConstraint testwordend [llength [info commands testwordend]]
# Save the argv value for restoration later
set savedArgv $argv
proc fourArgs {a b c d} {
global arg1 arg2 arg3 arg4
set arg1 $a
|
| ︙ | ︙ | |||
260 261 262 263 264 265 266 |
} "x"
test parseOld-7.10 {backslash substitution} {
eval "list a b\\\nc d"
} {a b c d}
test parseOld-7.11 {backslash substitution} {
eval "list a \"b c\"\\\nd e"
} {a {b c} d e}
| | | | | | | | 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 |
} "x"
test parseOld-7.10 {backslash substitution} {
eval "list a b\\\nc d"
} {a b c d}
test parseOld-7.11 {backslash substitution} {
eval "list a \"b c\"\\\nd e"
} {a {b c} d e}
test parseOld-7.12 {backslash substitution} {
expr {[list \uA2] eq "¢"}
} 1
test parseOld-7.13 {backslash substitution} {
expr {[list \u4E21] eq "両"}
} 1
test parseOld-7.14 {backslash substitution} {
expr {[list \u4E2k] eq "Ӣk"}
} 1
# Semi-colon.
test parseOld-8.1 {semi-colons} {
set b 0
getArgs a;set b 2
|
| ︙ | ︙ |
Changes to tests/pkgMkIndex.test.
| ︙ | ︙ | |||
573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 |
# Do all [load]ing of shared libraries in another process, so we can
# delete the file and not get stuck because we're holding a reference to
# it.
set cmd [list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl]
exec [interpreter] << $cmd
pkgtest::runCreatedIndex {0 {}} -lazy $fullPkgPath pkga[info sharedlibextension] pkga.tcl
} "0 {{pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}"
test pkgMkIndex-10.2 {package in DLL hidden by -load} [list exec $dll] {
# Do all [load]ing of shared libraries in another process, so we can
# delete the file and not get stuck because we're holding a reference to
# it.
#
# This test depends on context from prior test, so repeat it.
set script \
"[list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl]"
append script \n \
"[list pkg_mkIndex -lazy -load Pkg* $fullPkgPath [file tail $x]]"
exec [interpreter] << $script
pkgtest::runCreatedIndex {0 {}} -lazy -load Pkg* -- $fullPkgPath pkga[info sharedlibextension]
| > > | | 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 |
# Do all [load]ing of shared libraries in another process, so we can
# delete the file and not get stuck because we're holding a reference to
# it.
set cmd [list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl]
exec [interpreter] << $cmd
pkgtest::runCreatedIndex {0 {}} -lazy $fullPkgPath pkga[info sharedlibextension] pkga.tcl
} "0 {{pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}"
test pkgMkIndex-10.2 {package in DLL hidden by -load} [list exec $dll] {
# Do all [load]ing of shared libraries in another process, so we can
# delete the file and not get stuck because we're holding a reference to
# it.
#
# This test depends on context from prior test, so repeat it.
set script \
"[list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl]"
append script \n \
"[list pkg_mkIndex -lazy -load Pkg* $fullPkgPath [file tail $x]]"
exec [interpreter] << $script
pkgtest::runCreatedIndex {0 {}} -lazy -load Pkg* -- $fullPkgPath pkga[info sharedlibextension]
} "0 {{pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}}}}}"
if {[testConstraint $dll]} {
file delete -force [file join $fullPkgPath [file tail $x]]
removeFile [file join pkg pkga.tcl]
}
# Tolerate "namespace import" at the global scope
|
| ︙ | ︙ |
Changes to tests/proc.test.
| ︙ | ︙ | |||
13 14 15 16 17 18 19 20 21 22 23 24 25 26 |
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
testConstraint tcl::test [expr {![catch {package require tcl::test}]}]
testConstraint memory [llength [info commands memory]]
catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename p ""}
catch {rename {} ""}
| > | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 |
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
testConstraint tcl::test [expr {![catch {package require tcl::test}]}]
testConstraint memory [llength [info commands memory]]
catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename p ""}
catch {rename {} ""}
|
| ︙ | ︙ | |||
320 321 322 323 324 325 326 327 328 329 330 331 332 333 |
} -cleanup {
rename getbytes {}
unset -nocomplain end i tmp leakedBytes
} -result 0
test proc-4.9 {[39fed4dae5] Valid Tcl_PkgPresent return} tcl::test {
tcl::procbodytest::check
} 1
test proc-5.1 {Bytecompiling noop; test for correct argument substitution} -body {
proc p args {} ; # this will be bytecompiled into t
proc t {} {
set res {}
set a 0
set b 0
| > > > > > > > > > | 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 |
} -cleanup {
rename getbytes {}
unset -nocomplain end i tmp leakedBytes
} -result 0
test proc-4.9 {[39fed4dae5] Valid Tcl_PkgPresent return} tcl::test {
tcl::procbodytest::check
} 1
test proc-4.10 {
TclCreateProc, issue a8579d906a28, argument with no name
} -body {
catch {
proc p1 [list [list [expr {1 + 2}] default]] {}
}
} -cleanup {
catch {rename p1 {}}
} -result 0
test proc-5.1 {Bytecompiling noop; test for correct argument substitution} -body {
proc p args {} ; # this will be bytecompiled into t
proc t {} {
set res {}
set a 0
set b 0
|
| ︙ | ︙ |
Changes to tests/reg.test.
| ︙ | ︙ | |||
510 511 512 513 514 515 516 |
expectMatch 9.37 bE {a[\]]b} "a\\]b" "a\\]b"
expectMatch 9.38 eE {a[\]]b} "a\\]b" "a\\]b"
expectMatch 9.39 EP {a[\\]b} "a\\b" "a\\b"
expectMatch 9.40 eE {a[\\]b} "a\\b" "a\\b"
expectMatch 9.41 bE {a[\\]b} "a\\b" "a\\b"
expectError 9.42 - {a[\Z]b} EESCAPE
expectMatch 9.43 & {a[[b]c} "a\[c" "a\[c"
| | | | 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 |
expectMatch 9.37 bE {a[\]]b} "a\\]b" "a\\]b"
expectMatch 9.38 eE {a[\]]b} "a\\]b" "a\\]b"
expectMatch 9.39 EP {a[\\]b} "a\\b" "a\\b"
expectMatch 9.40 eE {a[\\]b} "a\\b" "a\\b"
expectMatch 9.41 bE {a[\\]b} "a\\b" "a\\b"
expectError 9.42 - {a[\Z]b} EESCAPE
expectMatch 9.43 & {a[[b]c} "a\[c" "a\[c"
expectMatch 9.44 EMP* {a[\xFE-\u0507][\xFF-\u0300]b} \
"a\u0102\u02FFb" "a\u0102\u02FFb"
doing 10 "anchors and newlines"
expectMatch 10.1 & ^a a a
expectNomatch 10.2 &^ ^a a
expectIndices 10.3 &N ^ a {0 -1}
expectIndices 10.4 & {a$} aba {2 2}
|
| ︙ | ︙ | |||
639 640 641 642 643 644 645 |
expectMatch 13.26 MP "a\\010b" "a\bb" "a\bb"
expectMatch 13.27 P "a\\U00001234x" "a\u1234x" "a\u1234x"
expectMatch 13.28 P {a\U00001234x} "a\u1234x" "a\u1234x"
expectMatch 13.29 P "a\\U0001234x" "a\u1234x" "a\u1234x"
expectMatch 13.30 P {a\U0001234x} "a\u1234x" "a\u1234x"
expectMatch 13.31 P "a\\U000012345x" "a\u12345x" "a\u12345x"
expectMatch 13.32 P {a\U000012345x} "a\u12345x" "a\u12345x"
| | | | 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 |
expectMatch 13.26 MP "a\\010b" "a\bb" "a\bb"
expectMatch 13.27 P "a\\U00001234x" "a\u1234x" "a\u1234x"
expectMatch 13.28 P {a\U00001234x} "a\u1234x" "a\u1234x"
expectMatch 13.29 P "a\\U0001234x" "a\u1234x" "a\u1234x"
expectMatch 13.30 P {a\U0001234x} "a\u1234x" "a\u1234x"
expectMatch 13.31 P "a\\U000012345x" "a\u12345x" "a\u12345x"
expectMatch 13.32 P {a\U000012345x} "a\u12345x" "a\u12345x"
expectMatch 13.33 P "a\\U1000000x" "a\uFFFD0x" "a\uFFFD0x"
expectMatch 13.34 P {a\U1000000x} "a\uFFFD0x" "a\uFFFD0x"
doing 14 "back references"
# ugh
expectMatch 14.1 RP {a(b*)c\1} abbcbb abbcbb bb
expectMatch 14.2 RP {a(b*)c\1} ac ac ""
expectNomatch 14.3 RP {a(b*)c\1} abbcb
|
| ︙ | ︙ |
Changes to tests/regexp.test.
| ︙ | ︙ | |||
13 14 15 16 17 18 19 |
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
unset -nocomplain foo
| | | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 |
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
unset -nocomplain foo
package require tcltests
testConstraint exec [llength [info commands exec]]
# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
proc memtest script {
set end [lindex [split [memory info] \n] 3 3]
|
| ︙ | ︙ | |||
50 51 52 53 54 55 56 |
regexp {^([^ ]*)[ ]*([^ ]*)} "" a
} 1
test regexp-1.6 {basic regexp operation} {
list [catch {regexp {} abc} msg] $msg
} {0 1}
test regexp-1.7 {regexp utf compliance} {
# if not UTF-8 aware, result is "0 1"
| | | | 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 |
regexp {^([^ ]*)[ ]*([^ ]*)} "" a
} 1
test regexp-1.6 {basic regexp operation} {
list [catch {regexp {} abc} msg] $msg
} {0 1}
test regexp-1.7 {regexp utf compliance} {
# if not UTF-8 aware, result is "0 1"
set foo "乎b q"
regexp "乎b q" "a乎b qw幎N wq" bar
list [string compare $foo $bar] [regexp 4 $bar]
} {0 0}
test regexp-1.8 {regexp ***= metasyntax} {
regexp -- "***=o" "aeiou"
} 1
test regexp-1.9 {regexp ***= metasyntax} {
set string "aeiou"
|
| ︙ | ︙ | |||
190 191 192 193 194 195 196 |
} {1 {1 1} {1 1} {-1 -1} {-1 -1}}
test regexp-3.7 {getting substrings back from regexp} {
set foo 1; set f2 1; set f3 1; set f4 1
list [regexp -indices (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4
} {1 {1 2} {1 1} {-1 -1} {2 2}}
test regexp-3.8a {-indices by multi-byte utf-8} {
regexp -inline -indices {(\w+)-(\w+)} \
| | | | | 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 |
} {1 {1 1} {1 1} {-1 -1} {-1 -1}}
test regexp-3.7 {getting substrings back from regexp} {
set foo 1; set f2 1; set f3 1; set f4 1
list [regexp -indices (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4
} {1 {1 2} {1 1} {-1 -1} {2 2}}
test regexp-3.8a {-indices by multi-byte utf-8} {
regexp -inline -indices {(\w+)-(\w+)} \
"grüß-привет"
} {{0 10} {0 3} {5 10}}
test regexp-3.8b {-indices by multi-byte utf-8, from -start position} {
list\
[regexp -inline -indices -start 3 {(\w+)-(\w+)} \
"grüß-привет"] \
[regexp -inline -indices -start 4 {(\w+)-(\w+)} \
"grüß-привет"]
} {{{3 10} {3 3} {5 10}} {}}
test regexp-4.1 {-nocase option to regexp} {
regexp -nocase foo abcFOo
} 1
test regexp-4.2 {-nocase option to regexp} {
set f1 22
|
| ︙ | ︙ | |||
348 349 350 351 352 353 354 |
} {1 {abc111 def}}
test regexp-7.16 {basic regsub operation} {
set foo xxx
list [regsub x "" y foo] $foo
} {0 {}}
test regexp-7.17 {regsub utf compliance} {
# if not UTF-8 aware, result is "0 1"
| | | | 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 |
} {1 {abc111 def}}
test regexp-7.16 {basic regsub operation} {
set foo xxx
list [regsub x "" y foo] $foo
} {0 {}}
test regexp-7.17 {regsub utf compliance} {
# if not UTF-8 aware, result is "0 1"
set foo "xyz555ijka乎bpqr"
regsub a乎b xyza乎bijka乎bpqr 555 bar
list [string compare $foo $bar] [regexp 4 $bar]
} {0 0}
test regexp-7.18 {basic regsub replacement} {
list [regsub a+ aaa {&} foo] $foo
} {1 aaa}
test regexp-7.19 {basic regsub replacement} {
list [regsub a+ aaa {\&} foo] $foo
|
| ︙ | ︙ | |||
761 762 763 764 765 766 767 |
test regexp-19.2 {regsub null replacement} {
regsub -all {@} {@hel@lo@} "\0a\0" result
set expected "\0a\0hel\0a\0lo\0a\0"
string equal $result $expected
} 1
| | | 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 |
test regexp-19.2 {regsub null replacement} {
regsub -all {@} {@hel@lo@} "\0a\0" result
set expected "\0a\0hel\0a\0lo\0a\0"
string equal $result $expected
} 1
test regexp-20.1 {regsub shared object shimmering} -constraints deprecated -body {
# Bug #461322
set a abcdefghijklmnopqurstuvwxyz
set b $a
set c abcdefghijklmnopqurstuvwxyz0123456789
regsub $a $c $b d
list $d [string length $d] [string bytelength $d]
} -result [list abcdefghijklmnopqurstuvwxyz0123456789 37 37]
|
| ︙ | ︙ |
Changes to tests/regexpComp.test.
| ︙ | ︙ | |||
11 12 13 14 15 16 17 18 19 20 21 22 23 24 |
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
# Procedure to evaluate a script within a proc, to test compilation
# functionality
proc evalInProc { script } {
proc testProc {} $script
set status [catch {
| > > | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 |
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
package require tcltests
# Procedure to evaluate a script within a proc, to test compilation
# functionality
proc evalInProc { script } {
proc testProc {} $script
set status [catch {
|
| ︙ | ︙ | |||
58 59 60 61 62 63 64 |
} 1
test regexpComp-1.6 {basic regexp operation} {
list [catch {regexp {} abc} msg] $msg
} {0 1}
test regexpComp-1.7 {regexp utf compliance} {
# if not UTF-8 aware, result is "0 1"
evalInProc {
| | | | 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 |
} 1
test regexpComp-1.6 {basic regexp operation} {
list [catch {regexp {} abc} msg] $msg
} {0 1}
test regexpComp-1.7 {regexp utf compliance} {
# if not UTF-8 aware, result is "0 1"
evalInProc {
set foo "乎b q"
regexp "乎b q" "a乎b qw幎N wq" bar
list [string compare $foo $bar] [regexp 4 $bar]
}
} {0 0}
test regexpComp-1.8 {regexp ***= metasyntax} {
evalInProc {
regexp -- "***=o" "aeiou"
|
| ︙ | ︙ | |||
443 444 445 446 447 448 449 |
set foo xxx
list [regsub x "" y foo] $foo
}
} {0 {}}
test regexpComp-7.17 {regsub utf compliance} {
evalInProc {
# if not UTF-8 aware, result is "0 1"
| | | | 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 |
set foo xxx
list [regsub x "" y foo] $foo
}
} {0 {}}
test regexpComp-7.17 {regsub utf compliance} {
evalInProc {
# if not UTF-8 aware, result is "0 1"
set foo "xyz555ijka乎bpqr"
regsub a乎b xyza乎bijka乎bpqr 555 bar
list [string compare $foo $bar] [regexp 4 $bar]
}
} {0 0}
test regexpComp-8.1 {case conversion in regsub} {
evalInProc {
list [regsub -nocase a(a+) xaAAaAAay & foo] $foo
|
| ︙ | ︙ | |||
787 788 789 790 791 792 793 |
test regexpComp-19.1 {regsub null replacement} {
evalInProc {
regsub -all {@} {@hel@lo@} "\0a\0" result
list $result [string length $result]
}
} "\0a\0hel\0a\0lo\0a\0 14"
| | | 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 |
test regexpComp-19.1 {regsub null replacement} {
evalInProc {
regsub -all {@} {@hel@lo@} "\0a\0" result
list $result [string length $result]
}
} "\0a\0hel\0a\0lo\0a\0 14"
test regexpComp-20.1 {regsub shared object shimmering} deprecated {
evalInProc {
# Bug #461322
set a abcdefghijklmnopqurstuvwxyz
set b $a
set c abcdefghijklmnopqurstuvwxyz0123456789
regsub $a $c $b d
list $d [string length $d] [string bytelength $d]
|
| ︙ | ︙ |
Changes to tests/safe-zipfs.test.
| ︙ | ︙ | |||
9 10 11 12 13 14 15 | # # 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. | > > > > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < < < < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 |
#
# Copyright © 1995-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
apply [list {} {
global auto_path
global tcl_library
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
foreach i [interp children] {
interp delete $i
}
set SaveAutoPath $::auto_path
set ::auto_path [info library]
set TestsDir [file normalize [file dirname [info script]]]
set ZipMountPoint [zipfs root]auto-files
zipfs mount $ZipMountPoint [file join $TestsDir auto-files.zip]
set PathMapp {}
lappend PathMapp $tcl_library TCLLIB $TestsDir TESTSDIR $ZipMountPoint ZIPDIR
proc mapList {map listIn} {
set listOut {}
foreach element $listIn {
lappend listOut [string map $map $element]
}
return $listOut
}
proc mapAndSortList {map listIn} {
set listOut {}
foreach element $listIn {
lappend listOut [string map $map $element]
}
lsort $listOut
}
# Force actual loading of the safe package because we use un-exported (and
# thus un-autoindexed) APIs in this test result arguments:
catch {safe::interpConfigure}
# Tests 5.* test the example files before using them to test safe interpreters.
test safe-zipfs-5.1 {example tclIndex commands, test in parent interpreter; zipfs} -setup {
set tmpAutoPath $::auto_path
lappend ::auto_path [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2]
} -body {
# Try to load the commands.
set code3 [catch report1 msg3]
set code4 [catch report2 msg4]
list $code3 $msg3 $code4 $msg4
} -cleanup {
catch {rename report1 {}}
catch {rename report2 {}}
set ::auto_path $tmpAutoPath
auto_reset
} -match glob -result {0 ok1 0 ok2}
test safe-zipfs-5.2 {example tclIndex commands, negative test in parent interpreter; zipfs} -setup {
set tmpAutoPath $::auto_path
lappend ::auto_path [file join $ZipMountPoint auto0]
} -body {
# Try to load the commands.
set code3 [catch report1 msg3]
set code4 [catch report2 msg4]
list $code3 $msg3 $code4 $msg4
} -cleanup {
catch {rename report1 {}}
catch {rename report2 {}}
set ::auto_path $tmpAutoPath
auto_reset
} -match glob -result {1 {invalid command name "report1"} 1 {invalid command name "report2"}}
test safe-zipfs-5.3 {example pkgIndex.tcl packages, test in parent interpreter, child directories; zipfs} -setup {
set tmpAutoPath $::auto_path
lappend ::auto_path [file join $ZipMountPoint auto0]
} -body {
# Try to load the packages and run a command from each one.
set code3 [catch {package require SafeTestPackage1} msg3]
set code4 [catch {package require SafeTestPackage2} msg4]
set code5 [catch HeresPackage1 msg5]
set code6 [catch HeresPackage2 msg6]
list $code3 $msg3 $code4 $msg4 $code5 $msg5 $code6 $msg6
} -cleanup {
set ::auto_path $tmpAutoPath
catch {package forget SafeTestPackage1}
catch {package forget SafeTestPackage2}
catch {rename HeresPackage1 {}}
catch {rename HeresPackage2 {}}
} -match glob -result {0 1.2.3 0 2.3.4 0 OK1 0 OK2}
test safe-zipfs-5.4 {example pkgIndex.tcl packages, test in parent interpreter, main directories; zipfs} -setup {
set tmpAutoPath $::auto_path
lappend ::auto_path [file join $ZipMountPoint auto0 auto1] \
[file join $ZipMountPoint auto0 auto2]
} -body {
# Try to load the packages and run a command from each one.
set code3 [catch {package require SafeTestPackage1} msg3]
set code4 [catch {package require SafeTestPackage2} msg4]
set code5 [catch HeresPackage1 msg5]
set code6 [catch HeresPackage2 msg6]
list $code3 $msg3 $code4 $msg4 $code5 $msg5 $code6 $msg6
} -cleanup {
set ::auto_path $tmpAutoPath
catch {package forget SafeTestPackage1}
catch {package forget SafeTestPackage2}
catch {rename HeresPackage1 {}}
catch {rename HeresPackage2 {}}
} -match glob -result {0 1.2.3 0 2.3.4 0 OK1 0 OK2}
test safe-zipfs-5.5 {example modules packages, test in parent interpreter, replace path; zipfs} -setup {
set oldTm [tcl::tm::path list]
foreach path $oldTm {
tcl::tm::path remove $path
}
tcl::tm::path add [file join $ZipMountPoint auto0 modules]
} -body {
# Try to load the modules and run a command from each one.
set code0 [catch {package require test0} msg0]
set code1 [catch {package require mod1::test1} msg1]
set code2 [catch {package require mod2::test2} msg2]
set out0 [test0::try0]
set out1 [mod1::test1::try1]
set out2 [mod2::test2::try2]
list $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $out0 $out1 $out2
} -cleanup {
tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
foreach path [lreverse $oldTm] {
tcl::tm::path add $path
}
catch {package forget test0}
catch {package forget mod1::test1}
catch {package forget mod2::test2}
catch {namespace delete ::test0}
catch {namespace delete ::mod1}
} -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2}
test safe-zipfs-5.6 {example modules packages, test in parent interpreter, append to path; zipfs} -setup {
tcl::tm::path add [file join $ZipMountPoint auto0 modules]
} -body {
# Try to load the modules and run a command from each one.
set code0 [catch {package require test0} msg0]
set code1 [catch {package require mod1::test1} msg1]
set code2 [catch {package require mod2::test2} msg2]
set out0 [test0::try0]
set out1 [mod1::test1::try1]
set out2 [mod2::test2::try2]
list $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $out0 $out1 $out2
} -cleanup {
tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
catch {package forget test0}
catch {package forget mod1::test1}
catch {package forget mod2::test2}
catch {namespace delete ::test0}
catch {namespace delete ::mod1}
} -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2}
# high level general test
# Use zipped example packages not http1.0 etc
test safe-zipfs-7.1 {tests that everything works at high level; zipfs} -setup {
set tmpAutoPath $::auto_path
lappend ::auto_path [file join $ZipMountPoint auto0]
set i [safe::interpCreate]
set ::auto_path $tmpAutoPath
} -body {
# no error shall occur:
# (because the default access_path shall include 1st level sub dirs so
# package require in a child works like in the parent)
set v [interp eval $i {package require SafeTestPackage1}]
# no error shall occur:
interp eval $i {HeresPackage1}
set v
} -cleanup {
safe::interpDelete $i
} -match glob -result 1.2.3
test safe-zipfs-7.2 {tests specific path and interpFind/AddToAccessPath; zipfs} -setup {
} -body {
set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
# should not add anything (p0)
set token1 [safe::interpAddToAccessPath $i [info library]]
# should add as p* (not p1 if parent has a module path)
set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"]
# should add as p* (not p2 if parent has a module path)
set token3 [safe::interpAddToAccessPath $i [file join $ZipMountPoint auto0]]
set confA [safe::interpConfigure $i]
set mappA [mapList $PathMapp [dict get $confA -accessPath]]
# an error shall occur (SafeTestPackage1 is not anymore in the secure 0-level
# provided deep path)
list $token1 $token2 $token3 -- \
[catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \
$mappA -- [safe::interpDelete $i]
} -cleanup {
} -match glob -result {{$p(:0:)} {$p(:*:)} {$p(:*:)} --\
1 {can't find package SafeTestPackage1} --\
{TCLLIB */dummy/unixlike/test/path ZIPDIR/auto0} -- {}}
test safe-zipfs-7.4 {tests specific path and positive search; zipfs} -setup {
} -body {
set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
# should not add anything (p0)
set token1 [safe::interpAddToAccessPath $i [info library]]
# should add as p* (not p1 if parent has a module path)
set token2 [safe::interpAddToAccessPath $i [file join $ZipMountPoint auto0 auto1]]
set confA [safe::interpConfigure $i]
set mappA [mapList $PathMapp [dict get $confA -accessPath]]
# this time, unlike test safe-zipfs-7.2, SafeTestPackage1 should be found
list $token1 $token2 -- \
[catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \
$mappA -- [safe::interpDelete $i]
# Note that the glob match elides directories (those from the module path)
# other than the first and last in the access path.
} -cleanup {
} -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.2.3 --\
{TCLLIB * ZIPDIR/auto0/auto1} -- {}}
test safe-zipfs-9.9 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (dummy test of doreset); zipfs} -setup {
} -body {
set i [safe::interpCreate -accessPath [list $tcl_library \
[file join $ZipMountPoint auto0 auto1] \
[file join $ZipMountPoint auto0 auto2]]]
# Inspect.
set confA [safe::interpConfigure $i]
set mappA [mapList $PathMapp [dict get $confA -accessPath]]
set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]
# Load auto_load data.
interp eval $i {catch nonExistentCommand}
# Load and run the commands.
# This guarantees the test will pass even if the tokens are swapped.
set code1 [catch {interp eval $i {report1}} msg1]
set code2 [catch {interp eval $i {report2}} msg2]
# Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}.
safe::interpConfigure $i -accessPath [list $tcl_library \
[file join $ZipMountPoint auto0 auto2] \
[file join $ZipMountPoint auto0 auto1]]
# Inspect.
set confB [safe::interpConfigure $i]
set mappB [mapList $PathMapp [dict get $confB -accessPath]]
set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]
# Run the commands.
set code3 [catch {interp eval $i {report1}} msg3]
set code4 [catch {interp eval $i {report2}} msg4]
list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB
} -cleanup {
safe::interpDelete $i
} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 ok1 0 ok2 --\
{TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} --\
{TCLLIB ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*}}
test safe-zipfs-9.10 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (actual test of doreset); zipfs} -setup {
} -body {
set i [safe::interpCreate -accessPath [list $tcl_library \
[file join $ZipMountPoint auto0 auto1] \
[file join $ZipMountPoint auto0 auto2]]]
# Inspect.
set confA [safe::interpConfigure $i]
set mappA [mapList $PathMapp [dict get $confA -accessPath]]
set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]
# Load auto_load data.
interp eval $i {catch nonExistentCommand}
# Do not load the commands. With the tokens swapped, the test
# will pass only if the Safe Base has called auto_reset.
# Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}.
safe::interpConfigure $i -accessPath [list $tcl_library \
[file join $ZipMountPoint auto0 auto2] \
[file join $ZipMountPoint auto0 auto1]]
# Inspect.
set confB [safe::interpConfigure $i]
set mappB [mapList $PathMapp [dict get $confB -accessPath]]
set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]
# Load and run the commands.
set code3 [catch {interp eval $i {report1}} msg3]
set code4 [catch {interp eval $i {report2}} msg4]
list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB
} -cleanup {
safe::interpDelete $i
} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\
0 ok1 0 ok2 --\
{TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} --\
{TCLLIB ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*}}
test safe-zipfs-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement; zipfs} -setup {
} -body {
# For complete correspondence to safe-stock87-9.11, include auto0 in access path.
set i [safe::interpCreate -accessPath [list $tcl_library \
[file join $ZipMountPoint auto0] \
[file join $ZipMountPoint auto0 auto1] \
[file join $ZipMountPoint auto0 auto2]]]
# Inspect.
set confA [safe::interpConfigure $i]
set mappA [mapList $PathMapp [dict get $confA -accessPath]]
set path0 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0]]
set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]
# Load pkgIndex.tcl data.
catch {interp eval $i {package require NOEXIST}}
# Rearrange access path. Swap tokens {$p(:2:)} and {$p(:3:)}.
# This would have no effect because the records in Pkg of these directories
# were from access as children of {$p(:1:)}.
safe::interpConfigure $i -accessPath [list $tcl_library \
[file join $ZipMountPoint auto0] \
[file join $ZipMountPoint auto0 auto2] \
[file join $ZipMountPoint auto0 auto1]]
# Inspect.
set confB [safe::interpConfigure $i]
set mappB [mapList $PathMapp [dict get $confB -accessPath]]
set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]
# Try to load the packages and run a command from each one.
set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3]
set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4]
set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5]
set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6]
list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \
$mappA -- $mappB -- $code5 $msg5 $code6 $msg6
} -cleanup {
safe::interpDelete $i
} -match glob -result {{$p(:2:)} {$p(:3:)} -- {$p(:3:)} {$p(:2:)} -- 0 1.2.3 0 2.3.4 --\
{TCLLIB ZIPDIR/auto0 ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} --\
{TCLLIB ZIPDIR/auto0 ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*} --\
0 OK1 0 OK2}
test safe-zipfs-9.12 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, 9.10 without path auto0; zipfs} -setup {
} -body {
set i [safe::interpCreate -accessPath [list $tcl_library \
[file join $ZipMountPoint auto0 auto1] \
[file join $ZipMountPoint auto0 auto2]]]
# Inspect.
set confA [safe::interpConfigure $i]
set mappA [mapList $PathMapp [dict get $confA -accessPath]]
set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]
# Load pkgIndex.tcl data.
catch {interp eval $i {package require NOEXIST}}
# Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}.
safe::interpConfigure $i -accessPath [list $tcl_library \
[file join $ZipMountPoint auto0 auto2] \
[file join $ZipMountPoint auto0 auto1]]
# Inspect.
set confB [safe::interpConfigure $i]
set mappB [mapList $PathMapp [dict get $confB -accessPath]]
set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]
# Try to load the packages and run a command from each one.
set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3]
set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4]
set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5]
set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6]
list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \
$mappA -- $mappB -- $code5 $msg5 $code6 $msg6
} -cleanup {
safe::interpDelete $i
} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\
0 1.2.3 0 2.3.4 --\
{TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} --\
{TCLLIB ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*} --\
0 OK1 0 OK2}
test safe-zipfs-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed; zipfs} -setup {
} -body {
set i [safe::interpCreate -accessPath [list $tcl_library \
[file join $ZipMountPoint auto0 auto1] \
[file join $ZipMountPoint auto0 auto2]]]
# Inspect.
set confA [safe::interpConfigure $i]
set mappA [mapList $PathMapp [dict get $confA -accessPath]]
set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]
# Load pkgIndex.tcl data.
catch {interp eval $i {package require NOEXIST}}
# Limit access path. Remove tokens {$p(:1:)} and {$p(:2:)}.
safe::interpConfigure $i -accessPath [list $tcl_library]
# Inspect.
set confB [safe::interpConfigure $i]
set mappB [mapList $PathMapp [dict get $confB -accessPath]]
set code4 [catch {::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]} path4]
set code5 [catch {::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]} path5]
# Try to load the packages.
set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3]
set code6 [catch {interp eval $i {package require SafeTestPackage2}} msg6]
list $path1 $path2 -- $code4 $path4 -- $code5 $path5 -- $code3 $code6 -- \
$mappA -- $mappB
} -cleanup {
safe::interpDelete $i
} -match glob -result {{$p(:1:)} {$p(:2:)} -- 1 {* not found in access path} --\
1 {* not found in access path} -- 1 1 --\
{TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} -- {TCLLIB*}}
test safe-zipfs-9.20 {check module loading; zipfs} -setup {
set oldTm [tcl::tm::path list]
foreach path $oldTm {
tcl::tm::path remove $path
}
tcl::tm::path add [file join $ZipMountPoint auto0 modules]
} -body {
set i [safe::interpCreate -accessPath [list $tcl_library]]
# Inspect.
set confA [safe::interpConfigure $i]
set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
set modsA [interp eval $i {tcl::tm::path list}]
set path0 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]
# Try to load the packages and run a command from each one.
set code0 [catch {interp eval $i {package require test0}} msg0]
set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
set out0 [interp eval $i {test0::try0}]
set out1 [interp eval $i {mod1::test1::try1}]
set out2 [interp eval $i {mod2::test2::try2}]
list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
$code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $out0 $out1 $out2
} -cleanup {
tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
foreach path [lreverse $oldTm] {
tcl::tm::path add $path
}
safe::interpDelete $i
} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
0 0.5 0 1.0 0 2.0 --\
{TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\
ZIPDIR/auto0/modules/mod2} -- res0 res1 res2}
# - The command safe::InterpSetConfig adds the parent's [tcl::tm::list] in
# tokenized form to the child's access path, and then adds all the
# descendants, discovered recursively by using glob.
# - The order of the directories in the list returned by glob is system-dependent,
# and therefore this is true also for (a) the order of token assignment to
# descendants of the [tcl::tm::list] roots; and (b) the order of those same
# directories in the access path. Both those things must be sorted before
# comparing with expected results. The test is therefore not totally strict,
# but will notice missing or surplus directories.
test safe-zipfs-9.21 {interpConfigure change the access path; check module loading; stale data case 1; zipfs} -setup {
set oldTm [tcl::tm::path list]
foreach path $oldTm {
tcl::tm::path remove $path
}
tcl::tm::path add [file join $ZipMountPoint auto0 modules]
} -body {
set i [safe::interpCreate -accessPath [list $tcl_library]]
# Inspect.
set confA [safe::interpConfigure $i]
set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
set modsA [interp eval $i {tcl::tm::path list}]
set path0 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]
# Add to access path.
# This injects more tokens, pushing modules to higher token numbers.
safe::interpConfigure $i -accessPath [list $tcl_library \
[file join $ZipMountPoint auto0 auto1] \
[file join $ZipMountPoint auto0 auto2]]
# Inspect.
set confB [safe::interpConfigure $i]
set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
set modsB [interp eval $i {tcl::tm::path list}]
set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
set path5 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]
# Load pkg data.
catch {interp eval $i {package require NOEXIST}}
catch {interp eval $i {package require mod1::NOEXIST}}
catch {interp eval $i {package require mod2::NOEXIST}}
# Try to load the packages and run a command from each one.
set code0 [catch {interp eval $i {package require test0}} msg0]
set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
set out0 [interp eval $i {test0::try0}]
set out1 [interp eval $i {mod1::test1::try1}]
set out2 [interp eval $i {mod2::test2::try2}]
list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
[lsort [list $path3 $path4 $path5]] -- $modsB -- \
$code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
$out0 $out1 $out2
} -cleanup {
tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
foreach path [lreverse $oldTm] {
tcl::tm::path add $path
}
safe::interpDelete $i
} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
{{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
0 0.5 0 1.0 0 2.0 --\
{TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\
ZIPDIR/auto0/modules/mod2} --\
{TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules\
ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} --\
res0 res1 res2}
# See comments on lsort after test safe-zipfs-9.20.
test safe-zipfs-9.22 {interpConfigure change the access path; check module loading; stale data case 0; zipfs} -setup {
set oldTm [tcl::tm::path list]
foreach path $oldTm {
tcl::tm::path remove $path
}
tcl::tm::path add [file join $ZipMountPoint auto0 modules]
} -body {
set i [safe::interpCreate -accessPath [list $tcl_library]]
# Inspect.
set confA [safe::interpConfigure $i]
set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
set modsA [interp eval $i {tcl::tm::path list}]
set path0 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]
# Add to access path.
# This injects more tokens, pushing modules to higher token numbers.
safe::interpConfigure $i -accessPath [list $tcl_library \
[file join $ZipMountPoint auto0 auto1] \
[file join $ZipMountPoint auto0 auto2]]
# Inspect.
set confB [safe::interpConfigure $i]
set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
set modsB [interp eval $i {tcl::tm::path list}]
set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
set path5 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]
# Try to load the packages and run a command from each one.
set code0 [catch {interp eval $i {package require test0}} msg0]
set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
set out0 [interp eval $i {test0::try0}]
set out1 [interp eval $i {mod1::test1::try1}]
set out2 [interp eval $i {mod2::test2::try2}]
list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
[lsort [list $path3 $path4 $path5]] -- $modsB -- \
$code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
$out0 $out1 $out2
} -cleanup {
tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
foreach path [lreverse $oldTm] {
tcl::tm::path add $path
}
safe::interpDelete $i
} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
{{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
0 0.5 0 1.0 0 2.0 --\
{TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\
ZIPDIR/auto0/modules/mod2} --\
{TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules\
ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} --\
res0 res1 res2}
# See comments on lsort after test safe-zipfs-9.20.
test safe-zipfs-9.23 {interpConfigure change the access path; check module loading; stale data case 3; zipfs} -setup {
set oldTm [tcl::tm::path list]
foreach path $oldTm {
tcl::tm::path remove $path
}
tcl::tm::path add [file join $ZipMountPoint auto0 modules]
} -body {
set i [safe::interpCreate -accessPath [list $tcl_library]]
# Inspect.
set confA [safe::interpConfigure $i]
set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
set modsA [interp eval $i {tcl::tm::path list}]
set path0 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]
# Force the interpreter to acquire pkg data which will soon become stale.
catch {interp eval $i {package require NOEXIST}}
catch {interp eval $i {package require mod1::NOEXIST}}
catch {interp eval $i {package require mod2::NOEXIST}}
# Add to access path.
# This injects more tokens, pushing modules to higher token numbers.
safe::interpConfigure $i -accessPath [list $tcl_library \
[file join $ZipMountPoint auto0 auto1] \
[file join $ZipMountPoint auto0 auto2]]
# Inspect.
set confB [safe::interpConfigure $i]
set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
set modsB [interp eval $i {tcl::tm::path list}]
set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
set path5 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]
# Refresh stale pkg data.
catch {interp eval $i {package require NOEXIST}}
catch {interp eval $i {package require mod1::NOEXIST}}
catch {interp eval $i {package require mod2::NOEXIST}}
# Try to load the packages and run a command from each one.
set code0 [catch {interp eval $i {package require test0}} msg0]
set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
set out0 [interp eval $i {test0::try0}]
set out1 [interp eval $i {mod1::test1::try1}]
set out2 [interp eval $i {mod2::test2::try2}]
list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
[lsort [list $path3 $path4 $path5]] -- $modsB -- \
$code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
$out0 $out1 $out2
} -cleanup {
tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
foreach path [lreverse $oldTm] {
tcl::tm::path add $path
}
safe::interpDelete $i
} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
{{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
0 0.5 0 1.0 0 2.0 --\
{TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\
ZIPDIR/auto0/modules/mod2} --\
{TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules\
ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} --\
res0 res1 res2}
# See comments on lsort after test safe-zipfs-9.20.
test safe-zipfs-9.24 {interpConfigure change the access path; check module loading; stale data case 2 (worst case); zipfs} -setup {
set oldTm [tcl::tm::path list]
foreach path $oldTm {
tcl::tm::path remove $path
}
tcl::tm::path add [file join $ZipMountPoint auto0 modules]
} -body {
set i [safe::interpCreate -accessPath [list $tcl_library]]
# Inspect.
set confA [safe::interpConfigure $i]
set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
set modsA [interp eval $i {tcl::tm::path list}]
set path0 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]
# Force the interpreter to acquire pkg data which will soon become stale.
catch {interp eval $i {package require NOEXIST}}
catch {interp eval $i {package require mod1::NOEXIST}}
catch {interp eval $i {package require mod2::NOEXIST}}
# Add to access path.
# This injects more tokens, pushing modules to higher token numbers.
safe::interpConfigure $i -accessPath [list $tcl_library \
[file join $ZipMountPoint auto0 auto1] \
[file join $ZipMountPoint auto0 auto2]]
# Inspect.
set confB [safe::interpConfigure $i]
set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
set modsB [interp eval $i {tcl::tm::path list}]
set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
set path5 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]
# Try to load the packages and run a command from each one.
set code0 [catch {interp eval $i {package require test0}} msg0]
set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
set out0 [interp eval $i {test0::try0}]
set out1 [interp eval $i {mod1::test1::try1}]
set out2 [interp eval $i {mod2::test2::try2}]
list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
[lsort [list $path3 $path4 $path5]] -- $modsB -- \
$code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
$out0 $out1 $out2
} -cleanup {
tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
foreach path [lreverse $oldTm] {
tcl::tm::path add $path
}
safe::interpDelete $i
} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
{{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
0 0.5 0 1.0 0 2.0 --\
{TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\
ZIPDIR/auto0/modules/mod2} --\
{TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules\
ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} --\
res0 res1 res2}
# See comments on lsort after test safe-zipfs-9.20.
# cleanup
set ::auto_path $SaveAutoPath
zipfs unmount ${ZipMountPoint}
unset SaveAutoPath TestsDir ZipMountPoint PathMapp
rename mapList {}
rename mapAndSortList {}
::tcltest::cleanupTests
return
} [namespace current]]
# Local Variables:
# mode: tcl
# End:
|
Changes to tests/safe.test.
| ︙ | ︙ | |||
20 21 22 23 24 25 26 27 28 29 30 31 32 33 |
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
foreach i [interp children] {
interp delete $i
}
set SaveAutoPath $::auto_path
set ::auto_path [info library]
| > > | 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 |
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
foreach i [interp children] {
interp delete $i
}
set SaveAutoPath $::auto_path
set ::auto_path [info library]
|
| ︙ | ︙ | |||
1155 1156 1157 1158 1159 1160 1161 |
{TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\
TESTSDIR/auto0/modules/mod2} --\
{TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\
TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\
res0 res1 res2}
# See comments on lsort after test safe-9.20.
| | | 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 |
{TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\
TESTSDIR/auto0/modules/mod2} --\
{TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\
TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\
res0 res1 res2}
# See comments on lsort after test safe-9.20.
catch {teststaticlibrary Safepfx1 0 0}
test safe-10.1 {testing statics loading} -constraints tcl::test -setup {
set i [safe::interpCreate]
} -body {
interp eval $i {load {} Safepfx1}
} -returnCodes error -cleanup {
safe::interpDelete $i
} -result {load of library for prefix Safepfx1 failed: can't use library in a safe interpreter: no Safepfx1_SafeInit procedure}
|
| ︙ | ︙ |
Changes to tests/scan.test.
| ︙ | ︙ | |||
28 29 30 31 32 33 34 |
proc testIEEE {} {
variable ieeeValues
binary scan [binary format dd -1.0 1.0] c* c
switch -exact -- $c {
{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
# little endian
| | | | | | | | | | | | 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 |
proc testIEEE {} {
variable ieeeValues
binary scan [binary format dd -1.0 1.0] c* c
switch -exact -- $c {
{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
# little endian
binary scan \x00\x00\x00\x00\x00\x00\xF0\xFF d \
ieeeValues(-Infinity)
binary scan \x00\x00\x00\x00\x00\x00\xF0\xBF d \
ieeeValues(-Normal)
binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \
ieeeValues(-Subnormal)
binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \
ieeeValues(-0)
binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+0)
binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \
ieeeValues(+Subnormal)
binary scan \x00\x00\x00\x00\x00\x00\xF0\x3F d \
ieeeValues(+Normal)
binary scan \x00\x00\x00\x00\x00\x00\xF0\x7F d \
ieeeValues(+Infinity)
binary scan \x00\x00\x00\x00\x00\x00\xF8\x7F d \
ieeeValues(NaN)
set ieeeValues(littleEndian) 1
return 1
}
{-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} {
binary scan \xFF\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Infinity)
binary scan \xBF\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Normal)
binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Subnormal)
binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-0)
binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+0)
binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Subnormal)
binary scan \x3F\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Normal)
binary scan \x7F\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Infinity)
binary scan \x7F\xF8\x00\x00\x00\x00\x00\x00 d \
ieeeValues(NaN)
set ieeeValues(littleEndian) 0
return 1
}
default {
return 0
}
|
| ︙ | ︙ | |||
635 636 637 638 639 640 641 |
set a {}; set b {}; set c {}
} -body {
list [scan "aaaaaabc aaabcdefg + + XYZQR" {%*4[a] %s %*4[a]%s%*4[ +]%c} a b c] $a $b $c
} -result {3 aabc bcdefg 43}
test scan-7.6 {string and character scanning, unicode} -setup {
set a {}; set b {}; set c {}; set d {}
} -body {
| | | | | | | 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 |
set a {}; set b {}; set c {}
} -body {
list [scan "aaaaaabc aaabcdefg + + XYZQR" {%*4[a] %s %*4[a]%s%*4[ +]%c} a b c] $a $b $c
} -result {3 aabc bcdefg 43}
test scan-7.6 {string and character scanning, unicode} -setup {
set a {}; set b {}; set c {}; set d {}
} -body {
list [scan "abc dÇfghijk dum " "%s %3s %20s %s" a b c d] $a $b $c $d
} -result "4 abc dÇf ghijk dum"
test scan-7.7 {string and character scanning, unicode} -setup {
set a {}; set b {}
} -body {
list [scan "abÇcdef" "ab%c%c" a b] $a $b
} -result "2 199 99"
test scan-7.8 {string and character scanning, unicode} -setup {
set a {}; set b {}
} -body {
list [scan "ab\uFEFFdef" "%\[ab\uFEFF\]" a] $a
} -result "1 ab\uFEFF"
test scan-8.1 {error conditions} -body {
scan a
} -returnCodes error -match glob -result *
test scan-8.2 {error conditions} -returnCodes error -body {
scan a
} -result {wrong # args: should be "scan string format ?varName ...?"}
|
| ︙ | ︙ |
Changes to tests/socket.test.
| ︙ | ︙ | |||
75 76 77 78 79 80 81 |
return
}
testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]
# Some tests require the Thread package or exec command
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
testConstraint exec [llength [info commands exec]]
| < | 75 76 77 78 79 80 81 82 83 84 85 86 87 88 |
return
}
testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]
# Some tests require the Thread package or exec command
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
testConstraint exec [llength [info commands exec]]
testConstraint notWinCI [expr {
$tcl_platform(platform) ne "windows" || ![info exists ::env(CI)]}]
# Produce a random port number in the Dynamic/Private range
# from 49152 through 65535.
proc randport {} {
# firstly try dynamic port via server-socket(0):
|
| ︙ | ︙ |
Changes to tests/source.test.
| ︙ | ︙ | |||
107 108 109 110 111 112 113 |
} -match glob -result {couldn't read file "*_non_existent_": no such file or directory} \
-errorCode {POSIX ENOENT {no such file or directory}}
test source-2.7 {utf-8 with BOM} -setup {
set sourcefile [makeFile {} source.file]
} -body {
set out [open $sourcefile w]
fconfigure $out -encoding utf-8
| | | 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 |
} -match glob -result {couldn't read file "*_non_existent_": no such file or directory} \
-errorCode {POSIX ENOENT {no such file or directory}}
test source-2.7 {utf-8 with BOM} -setup {
set sourcefile [makeFile {} source.file]
} -body {
set out [open $sourcefile w]
fconfigure $out -encoding utf-8
puts $out "\uFEFFset y new-y"
close $out
set y old-y
source -encoding utf-8 $sourcefile
return $y
} -cleanup {
removeFile $sourcefile
} -result {new-y}
|
| ︙ | ︙ | |||
195 196 197 198 199 200 201 |
} -cleanup {
removeFile source.file
} -result {source: 3 4 5}
test source-6.1 {source is binary ok} -setup {
# Note [makeFile] writes in the system encoding.
# [source] defaults to reading in the system encoding.
| | | | | | | | 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 |
} -cleanup {
removeFile source.file
} -result {source: 3 4 5}
test source-6.1 {source is binary ok} -setup {
# Note [makeFile] writes in the system encoding.
# [source] defaults to reading in the system encoding.
set sourcefile [makeFile [list set x "a b\x00c"] source.file]
} -body {
set x {}
source $sourcefile
string length $x
} -cleanup {
removeFile source.file
} -result 5
test source-6.2 {source skips everything after Ctrl-Z: Bug 2040} -setup {
set sourcefile [makeFile "set x ab\x1Ac" source.file]
} -body {
set x {}
source $sourcefile
string length $x
} -cleanup {
removeFile source.file
} -result 2
test source-7.1 {source -encoding test} -setup {
set sourcefile [makeFile {} source.file]
file delete $sourcefile
set f [open $sourcefile w]
fconfigure $f -encoding utf-8
puts $f "set symbol(square-root) √; set x correct"
close $f
} -body {
set x unset
source -encoding utf-8 $sourcefile
set x
} -cleanup {
removeFile source.file
} -result correct
test source-7.2 {source -encoding test} -setup {
# This tests for bad interactions between [source -encoding]
# and use of the Control-Z character (\x1A) as a cross-platform
# EOF character by [source]. Here we write out and the [source] a
# file that contains the byte \x1A, although not the character \x1A in
# the indicated encoding.
set sourcefile [makeFile {} source.file]
file delete $sourcefile
set f [open $sourcefile w]
fconfigure $f -encoding utf-16
puts $f "set symbol(square-root) √; set x correct"
close $f
} -body {
set x unset
source -encoding utf-16 $sourcefile
set x
} -cleanup {
removeFile source.file
|
| ︙ | ︙ | |||
262 263 264 265 266 267 268 |
removeFile source.file
} -returnCodes 1 -match glob -result {unknown encoding*}
test source-7.5 {source -encoding: correct operation} -setup {
set sourcefile [makeFile {} source.file]
file delete $sourcefile
set f [open $sourcefile w]
fconfigure $f -encoding utf-8
| | < > | | < > | 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 |
removeFile source.file
} -returnCodes 1 -match glob -result {unknown encoding*}
test source-7.5 {source -encoding: correct operation} -setup {
set sourcefile [makeFile {} source.file]
file delete $sourcefile
set f [open $sourcefile w]
fconfigure $f -encoding utf-8
puts $f "proc € {} {return foo}"
close $f
} -body {
source -encoding utf-8 $sourcefile
€
} -cleanup {
removeFile source.file
rename € {}
} -result foo
test source-7.6 {source -encoding: mismatch encoding error} -setup {
set sourcefile [makeFile {} source.file]
file delete $sourcefile
set f [open $sourcefile w]
fconfigure $f -encoding utf-8
puts $f "proc € {} {return foo}"
close $f
} -body {
source -encoding ascii $sourcefile
€
} -cleanup {
removeFile source.file
} -returnCodes error -match glob -result {invalid command name*}
test source-8.1 {source and coroutine/yield} -setup {
set sourcefile [makeFile {} source.file]
file delete $sourcefile
|
| ︙ | ︙ |
Changes to tests/split.test.
| ︙ | ︙ | |||
45 46 47 48 49 50 51 |
}
return $x
}
foo
} {]\n}
test split-1.9 {basic split commands} {
proc foo {} {
| | | | | | | | | 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 |
}
return $x
}
foo
} {]\n}
test split-1.9 {basic split commands} {
proc foo {} {
set x ab\x00c
set y [split $x {}]
return $y
}
foo
} "a b \x00 c"
test split-1.10 {basic split commands} {
split "a0ab1b2bbb3\x00c4" ab\x00c
} {{} 0 {} 1 2 {} {} 3 {} 4}
test split-1.11 {basic split commands} {
split "12,3,45" {,}
} {12 3 45}
test split-1.12 {basic split commands} {
split "\x01ab\x01cd\x01\x01ef\x01" \x01
} {{} ab cd {} ef {}}
test split-1.13 {basic split commands} {
split "12,34,56," {,}
} {12 34 56 {}}
test split-1.14 {basic split commands} {
split ",12,,,34,56," {,}
} {{} 12 {} {} 34 56 {}}
test split-1.15 {basic split commands} -body {
split "a💩b" {}
} -result "a 💩 b"
test split-1.16 {basic split commands} -body {
split "a💩b" 💩
} -result "a b"
test split-2.1 {split errors} {
list [catch split msg] $msg $errorCode
} {1 {wrong # args: should be "split string ?splitChars?"} {TCL WRONGARGS}}
test split-2.2 {split errors} {
list [catch {split a b c} msg] $msg $errorCode
|
| ︙ | ︙ |
Changes to tests/string.test.
| ︙ | ︙ | |||
15 16 17 18 19 20 21 22 23 24 25 26 27 28 |
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]]
# Helper commands to test various optimizations, code paths, and special cases.
proc makeByteArray {s} {binary format a* $s}
proc makeUnicode {s} {lindex [regexp -inline .* $s] 0}
proc makeList {args} {return $args}
proc makeShared {s} {uplevel 1 [list lappend copy $s]; return $s}
| > | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 |
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]]
package require tcltests
# Helper commands to test various optimizations, code paths, and special cases.
proc makeByteArray {s} {binary format a* $s}
proc makeUnicode {s} {lindex [regexp -inline .* $s] 0}
proc makeList {args} {return $args}
proc makeShared {s} {uplevel 1 [list lappend copy $s]; return $s}
|
| ︙ | ︙ | |||
68 69 70 71 72 73 74 |
set constraints testevalex
} else {
interp alias {} run {} try
set constraints {}
}
| | | | 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 |
set constraints testevalex
} else {
interp alias {} run {} try
set constraints {}
}
test string-1.1.$noComp {error conditions} -body {
list [catch {run {string gorp a b}} msg] $msg
} -match glob -result {1 {unknown or ambiguous subcommand "gorp": must be *cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-1.2.$noComp {error conditions} {
list [catch {run {string}} msg] $msg
} {1 {wrong # args: should be "string subcommand ?arg ...?"}}
test stringComp-1.3.$noComp {error condition - undefined method during compile} {
# We don't want this to complain about 'never' because it may never
# be called, or string may get redefined. This must compile OK.
proc foo {str i} {
|
| ︙ | ︙ | |||
115 116 117 118 119 120 121 |
test string-2.9.$noComp {string compare with length} {
run {string compare -length 2 abcde abxyz}
} 0
test string-2.10.$noComp {string compare with special index} {
list [catch {run {string compare -length end-3 abcde abxyz}} msg] $msg
} {1 {expected integer but got "end-3"}}
test string-2.11.$noComp {string compare, unicode} {
| | | | | | 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 |
test string-2.9.$noComp {string compare with length} {
run {string compare -length 2 abcde abxyz}
} 0
test string-2.10.$noComp {string compare with special index} {
list [catch {run {string compare -length end-3 abcde abxyz}} msg] $msg
} {1 {expected integer but got "end-3"}}
test string-2.11.$noComp {string compare, unicode} {
run {string compare ab牦 ab牧}
} -1
test string-2.11.1.$noComp {string compare, unicode} {
run {string compare Ü Ü}
} 0
test string-2.11.2.$noComp {string compare, unicode} {
run {string compare Ü ü}
} -1
test string-2.11.3.$noComp {string compare, unicode} {
run {string compare ÜÜÜüü ÜÜÜÜÜ}
} 1
test string-2.12.$noComp {string compare, high bit} {
# This test will fail if the underlying comparison
# is using signed chars instead of unsigned chars.
# (like SunOS's default memcmp thus the compat/memcmp.c)
run {string compare "\x80" "@"}
# Nb this tests works also in utf-8 space because \x80 is
|
| ︙ | ︙ | |||
148 149 150 151 152 153 154 |
test string-2.14.$noComp {string compare -nocase} {
run {string compare -nocase abcde ABCDE}
} 0
test string-2.15.$noComp {string compare -nocase} {
run {string compare -nocase abcde abcde}
} 0
test string-2.15.1.$noComp {string compare -nocase} {
| | | | | 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 |
test string-2.14.$noComp {string compare -nocase} {
run {string compare -nocase abcde ABCDE}
} 0
test string-2.15.$noComp {string compare -nocase} {
run {string compare -nocase abcde abcde}
} 0
test string-2.15.1.$noComp {string compare -nocase} {
run {string compare -nocase Ü Ü}
} 0
test string-2.15.2.$noComp {string compare -nocase} {
run {string compare -nocase ÜÜÜüü ÜÜÜÜÜ}
} 0
test string-2.16.$noComp {string compare -nocase with length} {
run {string compare -length 2 -nocase abcde Abxyz}
} 0
test string-2.17.$noComp {string compare -nocase with length} {
run {string compare -nocase -length 3 abcde Abxyz}
} -1
test string-2.18.$noComp {string compare -nocase with length <= 0} {
run {string compare -nocase -length -1 abcde AbCdEf}
} -1
test string-2.19.$noComp {string compare -nocase with excessive length} {
run {string compare -nocase -length 50 AbCdEf abcde}
} 1
test string-2.20.$noComp {string compare -len unicode} {
# These are strings that are 6 BYTELENGTH long, but the length
# shouldn't make a different because there are actually 3 CHARS long
run {string compare -len 5 ÜÜÜ ÜÜü}
} -1
test string-2.21.$noComp {string compare -nocase with special index} {
list [catch {run {string compare -nocase -length end-3 Abcde abxyz}} msg] $msg
} {1 {expected integer but got "end-3"}}
test string-2.22.$noComp {string compare, null strings} {
run {string compare "" ""}
} 0
|
| ︙ | ︙ | |||
233 234 235 236 237 238 239 |
test string-3.2.$noComp {string equal} {
run {string e abcde ABCDE}
} 0
test string-3.3.$noComp {string equal} {
run {string equal abcde abcde}
} 1
test string-3.4.$noComp {string equal -nocase} {
| | | 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 |
test string-3.2.$noComp {string equal} {
run {string e abcde ABCDE}
} 0
test string-3.3.$noComp {string equal} {
run {string equal abcde abcde}
} 1
test string-3.4.$noComp {string equal -nocase} {
run {string equal -nocase ÜÜÜÜüüüü ÜÜÜÜÜÜÜÜ}
} 1
test string-3.5.$noComp {string equal -nocase} {
run {string equal -nocase abcde abdef}
} 0
test string-3.6.$noComp {string equal -nocase} {
run {string eq -nocase abcde ABCDE}
} 1
|
| ︙ | ︙ | |||
270 271 272 273 274 275 276 |
run {string equal -length 2 abcde abxyz}
} 1
test string-3.15.$noComp {string equal with special index} {
list [catch {run {string equal -length end-3 abcde abxyz}} msg] $msg
} {1 {expected integer but got "end-3"}}
test string-3.16.$noComp {string equal, unicode} {
| | | | | | | | | | 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 |
run {string equal -length 2 abcde abxyz}
} 1
test string-3.15.$noComp {string equal with special index} {
list [catch {run {string equal -length end-3 abcde abxyz}} msg] $msg
} {1 {expected integer but got "end-3"}}
test string-3.16.$noComp {string equal, unicode} {
run {string equal ab牦 ab牧}
} 0
test string-3.17.$noComp {string equal, unicode} {
run {string equal Ü Ü}
} 1
test string-3.18.$noComp {string equal, unicode} {
run {string equal Ü ü}
} 0
test string-3.19.$noComp {string equal, unicode} {
run {string equal ÜÜÜüü ÜÜÜÜÜ}
} 0
test string-3.20.$noComp {string equal, high bit} {
# This test will fail if the underlying comparison
# is using signed chars instead of unsigned chars.
# (like SunOS's default memcmp thus the compat/memcmp.c)
run {string equal "\x80" "@"}
# Nb this tests works also in utf8 space because \x80 is
# translated into a 2 or more bytelength but whose first byte has
# the high bit set.
} 0
test string-3.21.$noComp {string equal -nocase} {
run {string equal -nocase abcde Abdef}
} 0
test string-3.22.$noComp {string equal, -nocase unicode} {
run {string equal -nocase Ü Ü}
} 1
test string-3.23.$noComp {string equal, -nocase unicode} {
run {string equal -nocase ÜÜÜüü ÜÜÜÜÜ}
} 1
test string-3.24.$noComp {string equal -nocase with length} {
run {string equal -length 2 -nocase abcde Abxyz}
} 1
test string-3.25.$noComp {string equal -nocase with length} {
run {string equal -nocase -length 3 abcde Abxyz}
} 0
test string-3.26.$noComp {string equal -nocase with length <= 0} {
run {string equal -nocase -length -1 abcde AbCdEf}
} 0
test string-3.27.$noComp {string equal -nocase with excessive length} {
run {string equal -nocase -length 50 AbCdEf abcde}
} 0
test string-3.28.$noComp {string equal -len unicode} {
# These are strings that are 6 BYTELENGTH long, but the length
# shouldn't make a different because there are actually 3 CHARS long
run {string equal -len 5 ÜÜÜ ÜÜü}
} 0
test string-3.29.$noComp {string equal -nocase with special index} {
list [catch {run {string equal -nocase -length end-3 Abcde abxyz}} msg] $msg
} {1 {expected integer but got "end-3"}}
test string-3.30.$noComp {string equal, null strings} {
run {string equal "" ""}
} 1
|
| ︙ | ︙ | |||
387 388 389 390 391 392 393 |
test string-4.7.$noComp {string first} {
run {string first xxx x123xx345xxx789xxx012}
} 9
test string-4.8.$noComp {string first} {
run {string first "" x123xx345xxx789xxx012}
} -1
test string-4.9.$noComp {string first, unicode} {
| | | | | | | | 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 |
test string-4.7.$noComp {string first} {
run {string first xxx x123xx345xxx789xxx012}
} 9
test string-4.8.$noComp {string first} {
run {string first "" x123xx345xxx789xxx012}
} -1
test string-4.9.$noComp {string first, unicode} {
run {string first x abc牦x}
} 4
test string-4.10.$noComp {string first, unicode} {
run {string first 牦 abc牦x}
} 3
test string-4.11.$noComp {string first, start index} {
run {string first 牦 abc牦x 3}
} 3
test string-4.12.$noComp {string first, start index} -body {
run {string first 牦 abc牦x 4}
} -result -1
test string-4.13.$noComp {string first, start index} -body {
run {string first 牦 abc牦x end-2}
} -result 3
test string-4.14.$noComp {string first, negative start index} -body {
run {string first b abc -1}
} -result 1
test string-4.15.$noComp {string first, ability to two-byte encoded utf-8 chars} -body {
# Test for a bug in Tcl 8.3 where test for all-single-byte-encoded
# strings was incorrect, leading to an index returned by [string first]
# which pointed past the end of the string.
set uchar վ ;# character with two-byte encoding in utf-8
run {string first % %#$uchar$uchar#$uchar$uchar#% 3}
} -result 8
test string-4.16.$noComp {string first, normal string vs pure unicode string} -body {
set s hello
regexp ll $s m
# Representation checks are canaries
run {list [representationpoke $s] [representationpoke $m] \
|
| ︙ | ︙ | |||
465 466 467 468 469 470 471 |
test string-5.8.$noComp {string index} {
run {string index abc end}
} c
test string-5.9.$noComp {string index} {
run {string index abc end-1}
} b
test string-5.10.$noComp {string index, unicode} {
| | | | | | 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 |
test string-5.8.$noComp {string index} {
run {string index abc end}
} c
test string-5.9.$noComp {string index} {
run {string index abc end-1}
} b
test string-5.10.$noComp {string index, unicode} {
run {string index abc牦d 4}
} d
test string-5.11.$noComp {string index, unicode} {
run {string index abc牦d 3}
} 牦
test string-5.12.$noComp {string index, unicode over char length, under byte length} -body {
run {string index ÜüÜü 6}
} -result {}
test string-5.13.$noComp {string index, bytearray object} {
run {string index [binary format a5 fuz] 0}
} f
test string-5.14.$noComp {string index, bytearray object} {
run {string index [binary format I* {0x50515253 0x52}] 3}
} S
|
| ︙ | ︙ | |||
505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 |
} {}
test string-5.20.$noComp {string index, bytearray object out of bounds} -body {
run {string index [binary format I* {0x50515253 0x52}] 20}
} -result {}
test string-5.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} -constraints utf16 -body {
run {list [string index a\U100000b 1] [string index a\U100000b 2] [string index a\U100000b 3]}
} -result [list \U100000 {} b]
test string-6.1.$noComp {string is, not enough args} {
list [catch {run {string is}} msg] $msg
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
test string-6.2.$noComp {string is, not enough args} {
list [catch {run {string is alpha}} msg] $msg
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
test string-6.3.$noComp {string is, bad args} {
list [catch {run {string is alpha -failin str}} msg] $msg
} {1 {wrong # args: should be "string is alpha ?-strict? ?-failindex var? str"}}
test string-6.4.$noComp {string is, too many args} {
list [catch {run {string is alpha -failin var -strict str more}} msg] $msg
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
test string-6.5.$noComp {string is, class check} {
list [catch {run {string is bogus str}} msg] $msg
| > > > | | | 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 |
} {}
test string-5.20.$noComp {string index, bytearray object out of bounds} -body {
run {string index [binary format I* {0x50515253 0x52}] 20}
} -result {}
test string-5.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} -constraints utf16 -body {
run {list [string index a\U100000b 1] [string index a\U100000b 2] [string index a\U100000b 3]}
} -result [list \U100000 {} b]
test string-5.22.$noComp {string index} -constraints testbytestring -body {
run {list [scan [string index [testbytestring \xFF] 0] %c var] $var}
} -result {1 255}
test string-6.1.$noComp {string is, not enough args} {
list [catch {run {string is}} msg] $msg
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
test string-6.2.$noComp {string is, not enough args} {
list [catch {run {string is alpha}} msg] $msg
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
test string-6.3.$noComp {string is, bad args} {
list [catch {run {string is alpha -failin str}} msg] $msg
} {1 {wrong # args: should be "string is alpha ?-strict? ?-failindex var? str"}}
test string-6.4.$noComp {string is, too many args} {
list [catch {run {string is alpha -failin var -strict str more}} msg] $msg
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
test string-6.5.$noComp {string is, class check} {
list [catch {run {string is bogus str}} msg] $msg
} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, dict, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, unicode, wideinteger, wordchar, or xdigit}}
test string-6.6.$noComp {string is, ambiguous class} {
list [catch {run {string is al str}} msg] $msg
} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, dict, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, unicode, wideinteger, wordchar, or xdigit}}
test string-6.7.$noComp {string is alpha, all ok} {
run {string is alpha -strict -failindex var abc}
} 1
test string-6.8.$noComp {string is, error in var} {
list [run {string is alpha -failindex var abc5def}] $var
} {0 3}
test string-6.9.$noComp {string is, var shouldn't get set} {
|
| ︙ | ︙ | |||
547 548 549 550 551 552 553 |
} 0
test string-6.12.$noComp {string is alnum, true} {
run {string is alnum abc123}
} 1
test string-6.13.$noComp {string is alnum, false} {
list [run {string is alnum -failindex var abc1.23}] $var
} {0 4}
| | | | 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 |
} 0
test string-6.12.$noComp {string is alnum, true} {
run {string is alnum abc123}
} 1
test string-6.13.$noComp {string is alnum, false} {
list [run {string is alnum -failindex var abc1.23}] $var
} {0 4}
test string-6.14.$noComp {string is alnum, unicode} "run {string is alnum abcü}" 1
test string-6.15.$noComp {string is alpha, true} {
run {string is alpha abc}
} 1
test string-6.16.$noComp {string is alpha, false} {
list [run {string is alpha -fail var a1bcde}] $var
} {0 1}
test string-6.17.$noComp {string is alpha, unicode} {
run {string is alpha abcü}
} 1
test string-6.18.$noComp {string is ascii, true} {
run {string is ascii abc\x7Fend\x00}
} 1
test string-6.19.$noComp {string is ascii, false} {
list [run {string is ascii -fail var abc\x00def\x80more}] $var
} {0 7}
|
| ︙ | ︙ | |||
579 580 581 582 583 584 585 |
test string-6.23.$noComp {string is boolean, false} {
list [run {string is bool -fail var yada}] $var
} {0 0}
test string-6.24.$noComp {string is digit, true} {
run {string is digit 0123456789}
} 1
test string-6.25.$noComp {string is digit, false} {
| | | 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 |
test string-6.23.$noComp {string is boolean, false} {
list [run {string is bool -fail var yada}] $var
} {0 0}
test string-6.24.$noComp {string is digit, true} {
run {string is digit 0123456789}
} 1
test string-6.25.$noComp {string is digit, false} {
list [run {string is digit -fail var 0123Ü567}] $var
} {0 4}
test string-6.26.$noComp {string is digit, false} {
list [run {string is digit -fail var +123567}] $var
} {0 0}
test string-6.27.$noComp {string is double, true} {
run {string is double 1}
} 1
|
| ︙ | ︙ | |||
702 703 704 705 706 707 708 |
test string-6.59.$noComp {string is integer, false on bad hex} {
list [run {string is integer -fail var 0X345XYZ}] $var
} {0 5}
test string-6.60.$noComp {string is lower, true} {
run {string is lower abc}
} 1
test string-6.61.$noComp {string is lower, unicode true} {
| | | | 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 |
test string-6.59.$noComp {string is integer, false on bad hex} {
list [run {string is integer -fail var 0X345XYZ}] $var
} {0 5}
test string-6.60.$noComp {string is lower, true} {
run {string is lower abc}
} 1
test string-6.61.$noComp {string is lower, unicode true} {
run {string is lower abcüue}
} 1
test string-6.62.$noComp {string is lower, false} {
list [run {string is lower -fail var aBc}] $var
} {0 1}
test string-6.63.$noComp {string is lower, false} {
list [run {string is lower -fail var abc1}] $var
} {0 3}
test string-6.64.$noComp {string is lower, unicode false} {
list [run {string is lower -fail var abÜUE}] $var
} {0 2}
test string-6.65.$noComp {string is space, true} {
run {string is space " \t\n\v\f"}
} 1
test string-6.66.$noComp {string is space, false} {
list [run {string is space -fail var " \t\n\v1\f"}] $var
} {0 4}
|
| ︙ | ︙ | |||
749 750 751 752 753 754 755 |
catch {unset var}
list [run {string is true -fail var no}] $var
} {0 0}
test string-6.75.$noComp {string is upper, true} {
run {string is upper ABC}
} 1
test string-6.76.$noComp {string is upper, unicode true} {
| | | | | 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 |
catch {unset var}
list [run {string is true -fail var no}] $var
} {0 0}
test string-6.75.$noComp {string is upper, true} {
run {string is upper ABC}
} 1
test string-6.76.$noComp {string is upper, unicode true} {
run {string is upper ABCÜUE}
} 1
test string-6.77.$noComp {string is upper, false} {
list [run {string is upper -fail var AbC}] $var
} {0 1}
test string-6.78.$noComp {string is upper, false} {
list [run {string is upper -fail var AB2C}] $var
} {0 2}
test string-6.79.$noComp {string is upper, unicode false} {
list [run {string is upper -fail var ABCüue}] $var
} {0 3}
test string-6.80.$noComp {string is wordchar, true} {
run {string is wordchar abc_123}
} 1
test string-6.81.$noComp {string is wordchar, unicode true} {
run {string is wordchar abcüabÜAB倁\U1D7CA}
} 1
test string-6.82.$noComp {string is wordchar, false} {
list [run {string is wordchar -fail var abcd.ef}] $var
} {0 4}
test string-6.83.$noComp {string is wordchar, unicode false} {
list [run {string is wordchar -fail var abc\x80def}] $var
} {0 3}
|
| ︙ | ︙ | |||
957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 |
} {0 87}
test string-6.130.1.$noComp {string is entier, false on bad octal} {
list [run {string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963}] $var
} {0 87}
test string-6.131.$noComp {string is entier, false on bad hex} {
list [run {string is entier -fail var 0X12345611234123456123456562345612345612345612345612345612345612345612345612345612345345XYZ}] $var
} {0 88}
test string-7.1.$noComp {string last, not enough args} {
list [catch {run {string last a}} msg] $msg
} {1 {wrong # args: should be "string last needleString haystackString ?lastIndex?"}}
test string-7.2.$noComp {string last, bad args} {
list [catch {run {string last a b c}} msg] $msg
} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}
test string-7.3.$noComp {string last, too many args} {
list [catch {run {string last a b c d}} msg] $msg
} {1 {wrong # args: should be "string last needleString haystackString ?lastIndex?"}}
test string-7.4.$noComp {string last} {
run {string la xxx xxxx123xx345x678}
} 1
test string-7.5.$noComp {string last} {
run {string last xx xxxx123xx345x678}
} 7
test string-7.6.$noComp {string last} {
run {string las x xxxx123xx345x678}
} 12
test string-7.7.$noComp {string last, unicode} {
| > > > > > > > > > > > > > > > > > > > > > > | | | | | | | | | | | | | | 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 |
} {0 87}
test string-6.130.1.$noComp {string is entier, false on bad octal} {
list [run {string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963}] $var
} {0 87}
test string-6.131.$noComp {string is entier, false on bad hex} {
list [run {string is entier -fail var 0X12345611234123456123456562345612345612345612345612345612345612345612345612345612345345XYZ}] $var
} {0 88}
test string-6.132.$noComp {string is unicode} {
run {string is unicode \U10FFFD\uD7FF\uE000\uFDCF\uFDF0}
} 1
test string-6.133.$noComp {string is unicode, upper surrogate} {
run {string is unicode \uD800}
} 0
test string-6.134.$noComp {string is unicode, lower surrogate} {
run {string is unicode \uDFFF}
} 0
test string-6.135.$noComp {string is unicode, noncharacter} {
run {string is unicode \uFFFE}
} 0
test string-6.136.$noComp {string is unicode, noncharacter} {
run {string is unicode \uFFFF}
} 0
test string-6.137.$noComp {string is unicode, noncharacter} {
run {string is unicode \uFDD0}
} 0
test string-6.138.$noComp {string is unicode, noncharacter} {
run {string is unicode \uFDEF}
} 0
test string-7.1.$noComp {string last, not enough args} {
list [catch {run {string last a}} msg] $msg
} {1 {wrong # args: should be "string last needleString haystackString ?lastIndex?"}}
test string-7.2.$noComp {string last, bad args} {
list [catch {run {string last a b c}} msg] $msg
} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}
test string-7.3.$noComp {string last, too many args} {
list [catch {run {string last a b c d}} msg] $msg
} {1 {wrong # args: should be "string last needleString haystackString ?lastIndex?"}}
test string-7.4.$noComp {string last} {
run {string la xxx xxxx123xx345x678}
} 1
test string-7.5.$noComp {string last} {
run {string last xx xxxx123xx345x678}
} 7
test string-7.6.$noComp {string last} {
run {string las x xxxx123xx345x678}
} 12
test string-7.7.$noComp {string last, unicode} {
run {string las x xxxx12牦xx345x678}
} 12
test string-7.8.$noComp {string last, unicode} {
run {string las 牦 xxxx12牦xx345x678}
} 6
test string-7.9.$noComp {string last, stop index} {
run {string las 牦 xxxx12牦xx345x678}
} 6
test string-7.10.$noComp {string last, unicode} {
run {string las 牦 xxxx12牦xx345x678}
} 6
test string-7.11.$noComp {string last, start index} {
run {string last 牦 abc牦x 3}
} 3
test string-7.12.$noComp {string last, start index} {
run {string last 牦 abc牦x 2}
} -1
test string-7.13.$noComp {string last, start index} {
## Constrain to last 'a' should work
run {string last ba badbad end-1}
} 3
test string-7.14.$noComp {string last, start index} {
## Constrain to last 'b' should skip last 'ba'
run {string last ba badbad end-2}
} 0
test string-7.15.$noComp {string last, start index} {
run {string last Üa ÜadÜad 0}
} -1
test string-7.16.$noComp {string last, start index} {
run {string last Üa ÜadÜad end-1}
} 3
test string-8.1.$noComp {string bytelength} deprecated {
list [catch {run {string bytelength}} msg] $msg
} {1 {wrong # args: should be "string bytelength string"}}
test string-8.2.$noComp {string bytelength} deprecated {
list [catch {run {string bytelength a b}} msg] $msg
} {1 {wrong # args: should be "string bytelength string"}}
test string-8.3.$noComp {string bytelength} deprecated {
run {string bytelength "\xC7"}
} 2
test string-8.4.$noComp {string bytelength} deprecated {
run {string b ""}
} 0
test string-9.1.$noComp {string length} {
list [catch {run {string length}} msg] $msg
} {1 {wrong # args: should be "string length string"}}
test string-9.2.$noComp {string length} {
list [catch {run {string length a b}} msg] $msg
} {1 {wrong # args: should be "string length string"}}
test string-9.3.$noComp {string length} {
run {string length "a little string"}
} 15
test string-9.4.$noComp {string length} {
run {string le ""}
} 0
test string-9.5.$noComp {string length, unicode} {
run {string le "abcd牦"}
} 5
test string-9.6.$noComp {string length, bytearray object} {
run {string length [binary format a5 foo]}
} 5
test string-9.7.$noComp {string length, bytearray object} {
run {string length [binary format I* {0x50515253 0x52}]}
} 8
|
| ︙ | ︙ | |||
1078 1079 1080 1081 1082 1083 1084 |
test string-10.10.$noComp {string map} {
list [catch {run {string map {a b c} abba}} msg] $msg
} {1 {char map list unbalanced}}
test string-10.11.$noComp {string map, nulls} {
run {string map {\x00 NULL blah \x00nix} {qwerty}}
} {qwerty}
test string-10.12.$noComp {string map, unicode} {
| | | | | | 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 |
test string-10.10.$noComp {string map} {
list [catch {run {string map {a b c} abba}} msg] $msg
} {1 {char map list unbalanced}}
test string-10.11.$noComp {string map, nulls} {
run {string map {\x00 NULL blah \x00nix} {qwerty}}
} {qwerty}
test string-10.12.$noComp {string map, unicode} {
run {string map [list ü ue UE Ü] "aüueUE\x00EU"}
} aueueÜ\x00EU
test string-10.13.$noComp {string map, -nocase unicode} {
run {string map -nocase [list ü ue UE Ü] "aüueUE\x00EU"}
} aueÜÜ\x00EU
test string-10.14.$noComp {string map, -nocase null arguments} {
run {string map -nocase {{} abc} foo}
} foo
test string-10.15.$noComp {string map, one pair case} {
run {string map -nocase {abc 32} aAbCaBaAbAbcAb}
} {a32aBaAb32Ab}
test string-10.16.$noComp {string map, one pair case} {
|
| ︙ | ︙ | |||
1286 1287 1288 1289 1290 1291 1292 |
test string-11.31.$noComp {string match case} {
run {string match a A}
} 0
test string-11.32.$noComp {string match nocase} {
run {string match -n a A}
} 1
test string-11.33.$noComp {string match nocase} {
| | | 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 |
test string-11.31.$noComp {string match case} {
run {string match a A}
} 0
test string-11.32.$noComp {string match nocase} {
run {string match -n a A}
} 1
test string-11.33.$noComp {string match nocase} {
run {string match -nocase aÜ Aü}
} 1
test string-11.34.$noComp {string match nocase} {
run {string match -nocase a*f ABCDEf}
} 1
test string-11.35.$noComp {string match case, false hope} {
# This is true because '_' lies between the A-Z and a-z ranges
run {string match {[A-z]} _}
|
| ︙ | ︙ | |||
1453 1454 1455 1456 1457 1458 1459 |
test string-12.15.$noComp {string range} {
run {string range abcdefghijklmnop end 1000}
} {p}
test string-12.16.$noComp {string range} {
run {string range abcdefghijklmnop end end-1}
} {}
test string-12.17.$noComp {string range, unicode} {
| | | | | 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 |
test string-12.15.$noComp {string range} {
run {string range abcdefghijklmnop end 1000}
} {p}
test string-12.16.$noComp {string range} {
run {string range abcdefghijklmnop end end-1}
} {}
test string-12.17.$noComp {string range, unicode} {
run {string range ab牦cdefghijklmnop 5 5}
} e
test string-12.18.$noComp {string range, unicode} {
run {string range ab牦cdefghijklmnop 2 3}
} 牦c
test string-12.19.$noComp {string range, bytearray object} {
set b [binary format I* {0x50515253 0x52}]
set r1 [run {string range $b 1 end-1}]
set r2 [run {string range $b 1 6}]
run {string equal $r1 $r2}
} 1
test string-12.20.$noComp {string range, out of bounds indices} {
|
| ︙ | ︙ | |||
1540 1541 1542 1543 1544 1545 1546 |
test string-13.10.$noComp {string repeat} {
run {string repeat def 0}
} {}
test string-13.11.$noComp {string repeat} {
run {string repeat def 1}
} def
test string-13.12.$noComp {string repeat} {
| | | | | | 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 |
test string-13.10.$noComp {string repeat} {
run {string repeat def 0}
} {}
test string-13.11.$noComp {string repeat} {
run {string repeat def 1}
} def
test string-13.12.$noComp {string repeat} {
run {string repeat ab牦cd 3}
} ab牦cdab牦cdab牦cd
test string-13.13.$noComp {string repeat} {
run {string repeat \x00 3}
} \x00\x00\x00
test string-13.14.$noComp {string repeat} {
# The string range will ensure us that string repeat gets a unicode string
run {string repeat [run {string range ab牦cd 2 3}] 3}
} 牦c牦c牦c
test string-14.1.$noComp {string replace} {
list [catch {run {string replace}} msg] $msg
} {1 {wrong # args: should be "string replace string first last ?string?"}}
test string-14.2.$noComp {string replace} {
list [catch {run {string replace a 1}} msg] $msg
} {1 {wrong # args: should be "string replace string first last ?string?"}}
|
| ︙ | ︙ | |||
1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 |
test string-14.19.$noComp {string replace} {
run {string replace {} -1 0 A}
} A
test string-14.20.$noComp {string replace} {
run {string replace [makeByteArray abcdefghijklmnop] end-10 end-2\
[makeByteArray NEW]}
} {abcdeNEWop}
test stringComp-14.21.$noComp {Bug 82e7f67325} {
apply {x {
set a [join $x {}]
lappend b [string length [string replace ___! 0 2 $a]]
lappend b [string length [string replace ___! 0 2 $a[unset a]]]
| > > > > > > > > > > > > | 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 |
test string-14.19.$noComp {string replace} {
run {string replace {} -1 0 A}
} A
test string-14.20.$noComp {string replace} {
run {string replace [makeByteArray abcdefghijklmnop] end-10 end-2\
[makeByteArray NEW]}
} {abcdeNEWop}
test string-14.21.$noComp {string replace (surrogates)} {
run {string replace \uD83D? 1 end \uDE02}
} \uD83D\uDE02
test string-14.22.$noComp {string replace (surrogates)} {
run {string replace ?\uDE02 0 end-1 \uD83D}
} \uD83D\uDE02
test string-14.23.$noComp {string replace \xC0 \x80} testbytestring {
run {string length [string replace [testbytestring \xC0]? 1 end [testbytestring \x80]]}
} 2
test string-14.24.$noComp {string replace \xC0 \x80} testbytestring {
run {string length [string replace ?[testbytestring \x80] 0 end-1 [testbytestring \xC0]]}
} 2
test stringComp-14.21.$noComp {Bug 82e7f67325} {
apply {x {
set a [join $x {}]
lappend b [string length [string replace ___! 0 2 $a]]
lappend b [string length [string replace ___! 0 2 $a[unset a]]]
|
| ︙ | ︙ | |||
1801 1802 1803 1804 1805 1806 1807 |
test string-19.3.$noComp {string trimleft, unicode default} {
run {string trimleft \uFEFF\x85\xA0\x00\u1680\u180E\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u2028\u2029\u202F\u205F\u3000\u1361ABC}
} \u1361ABC
test string-20.1.$noComp {string trimright errors} {
list [catch {run {string trimright}} msg] $msg
} {1 {wrong # args: should be "string trimright string ?chars?"}}
| | | | 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 |
test string-19.3.$noComp {string trimleft, unicode default} {
run {string trimleft \uFEFF\x85\xA0\x00\u1680\u180E\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u2028\u2029\u202F\u205F\u3000\u1361ABC}
} \u1361ABC
test string-20.1.$noComp {string trimright errors} {
list [catch {run {string trimright}} msg] $msg
} {1 {wrong # args: should be "string trimright string ?chars?"}}
test string-20.2.$noComp {string trimright errors} -body {
list [catch {run {string trimg a}} msg] $msg
} -match glob -result {1 {unknown or ambiguous subcommand "trimg": must be *cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-20.3.$noComp {string trimright} {
run {string trimright " XYZ "}
} { XYZ}
test string-20.4.$noComp {string trimright} {
run {string trimright " "}
} {}
test string-20.5.$noComp {string trimright} {
|
| ︙ | ︙ | |||
1842 1843 1844 1845 1846 1847 1848 |
lappend result [string map $m [run {string trimright $b x}]]
lappend result [string map $m [run {string trimright $b \xE8}]]
lappend result [string map $m [run {string trimright $b [testbytestring \xE8]}]]
lappend result [string map $m [run {string trimright $b \xA0}]]
lappend result [string map $m [run {string trimright $b [testbytestring \xA0]}]]
lappend result [string map $m [run {string trimright $b \xE8\xA0}]]
lappend result [string map $m [run {string trimright $b [testbytestring \xE8\xA0]}]]
| | | 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 |
lappend result [string map $m [run {string trimright $b x}]]
lappend result [string map $m [run {string trimright $b \xE8}]]
lappend result [string map $m [run {string trimright $b [testbytestring \xE8]}]]
lappend result [string map $m [run {string trimright $b \xA0}]]
lappend result [string map $m [run {string trimright $b [testbytestring \xA0]}]]
lappend result [string map $m [run {string trimright $b \xE8\xA0}]]
lappend result [string map $m [run {string trimright $b [testbytestring \xE8\xA0]}]]
lappend result [string map $m [run {string trimright $b \x00}]]
} [list {*}[lrepeat 4 fooUV] {*}[lrepeat 2 fooU] {*}[lrepeat 2 foo] fooUV]
test string-21.1.$noComp {string wordend} -body {
list [catch {run {string wordend a}} msg] $msg
} -result {1 {wrong # args: should be "string wordend string index"}}
test string-21.2.$noComp {string wordend} -body {
list [catch {run {string wordend a b c}} msg] $msg
|
| ︙ | ︙ | |||
1923 1924 1925 1926 1927 1928 1929 |
} "\uD83D\uDE02Hello world!\uD83D\uDE02"
test string-21.25.$noComp {string trimright, unicode} {
run {string trimright "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD93D\uDE02}
} "\uD83D\uDE02Hello world!\uD83D\uDE02"
test string-22.1.$noComp {string wordstart} -body {
list [catch {run {string word a}} msg] $msg
| | | 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 |
} "\uD83D\uDE02Hello world!\uD83D\uDE02"
test string-21.25.$noComp {string trimright, unicode} {
run {string trimright "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD93D\uDE02}
} "\uD83D\uDE02Hello world!\uD83D\uDE02"
test string-22.1.$noComp {string wordstart} -body {
list [catch {run {string word a}} msg] $msg
} -match glob -result {1 {unknown or ambiguous subcommand "word": must be *cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-22.2.$noComp {string wordstart} -body {
list [catch {run {string wordstart a}} msg] $msg
} -result {1 {wrong # args: should be "string wordstart string index"}}
test string-22.3.$noComp {string wordstart} -body {
list [catch {run {string wordstart a b c}} msg] $msg
} -result {1 {wrong # args: should be "string wordstart string index"}}
test string-22.4.$noComp {string wordstart} -body {
|
| ︙ | ︙ |
Changes to tests/stringObj.test.
| ︙ | ︙ | |||
15 16 17 18 19 20 21 22 23 24 25 26 |
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 testobj [llength [info commands testobj]]
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testdstring [llength [info commands testdstring]]
testConstraint tip389 [expr {[string length \U010000] == 2}]
| > < | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 |
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]]
package require tcltests
testConstraint testobj [llength [info commands testobj]]
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testdstring [llength [info commands testdstring]]
testConstraint tip389 [expr {[string length \U010000] == 2}]
test stringObj-1.1 {string type registration} testobj {
set t [testobj types]
set first [string first "string" $t]
set result [expr {$first >= 0}]
} 1
|
| ︙ | ︙ | |||
204 205 206 207 208 209 210 |
testobj duplicate 1 2
list [teststringobj length 1] [teststringobj length2 1] \
[teststringobj maxchars 1] [teststringobj get 1] \
[teststringobj length 2] [teststringobj length2 2] \
[teststringobj maxchars 2] [teststringobj get 2]
} {5 10 0 abcde 5 5 0 abcde}
test stringObj-8.2 {DupUnicodeInternalRep, mixed width chars} testobj {
| | | | | | | | | | | | | | | | | | | | | < < < < < | | | < < < | | < < < | | | | | 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 |
testobj duplicate 1 2
list [teststringobj length 1] [teststringobj length2 1] \
[teststringobj maxchars 1] [teststringobj get 1] \
[teststringobj length 2] [teststringobj length2 2] \
[teststringobj maxchars 2] [teststringobj get 2]
} {5 10 0 abcde 5 5 0 abcde}
test stringObj-8.2 {DupUnicodeInternalRep, mixed width chars} testobj {
set x abc\xEF\xBF\xAEghi
string length $x
set y $x
list [testobj objtype $x] [testobj objtype $y] [append x "\xAE\xBF\xEF"] \
[set y] [testobj objtype $x] [testobj objtype $y]
} "string string abc\xEF\xBF\xAEghi\xAE\xBF\xEF abc\xEF\xBF\xAEghi string string"
test stringObj-8.3 {DupUnicodeInternalRep, mixed width chars} testobj {
set x abc\xEF\xBF\xAEghi
set y $x
string length $x
list [testobj objtype $x] [testobj objtype $y] [append x "\xAE\xBF\xEF"] \
[set y] [testobj objtype $x] [testobj objtype $y]
} "string string abc\xEF\xBF\xAEghi\xAE\xBF\xEF abc\xEF\xBF\xAEghi string string"
test stringObj-8.4 {DupUnicodeInternalRep, all byte-size chars} testobj {
set x abcdefghi
string length $x
set y $x
list [testobj objtype $x] [testobj objtype $y] [append x jkl] \
[set y] [testobj objtype $x] [testobj objtype $y]
} {string string abcdefghijkl abcdefghi string string}
test stringObj-8.5 {DupUnicodeInternalRep, all byte-size chars} testobj {
set x abcdefghi
set y $x
string length $x
list [testobj objtype $x] [testobj objtype $y] [append x jkl] \
[set y] [testobj objtype $x] [testobj objtype $y]
} {string string abcdefghijkl abcdefghi string string}
test stringObj-9.1 {TclAppendObjToObj, mixed src & dest} {testobj testdstring} {
set x abc\xEF\xBF\xAEghi
testdstring free
testdstring append \xAE\xBF\xEF -1
set y [testdstring get]
string length $x
list [testobj objtype $x] [testobj objtype $y] [append x $y] \
[set y] [testobj objtype $x] [testobj objtype $y]
} "string none abc\xEF\xBF\xAEghi\xAE\xBF\xEF \xAE\xBF\xEF string none"
test stringObj-9.2 {TclAppendObjToObj, mixed src & dest} testobj {
set x abc\xEF\xBF\xAEghi
string length $x
list [testobj objtype $x] [append x $x] [testobj objtype $x] \
[append x $x] [testobj objtype $x]
} "string abc\xEF\xBF\xAEghiabc\xEF\xBF\xAEghi string\
abc\xEF\xBF\xAEghiabc\xEF\xBF\xAEghiabc\xEF\xBF\xAEghiabc\xEF\xBF\xAEghi\
string"
test stringObj-9.3 {TclAppendObjToObj, mixed src & 1-byte dest} {testobj testdstring} {
set x abcdefghi
testdstring free
testdstring append \xAE\xBF\xEF -1
set y [testdstring get]
string length $x
list [testobj objtype $x] [testobj objtype $y] [append x $y] \
[set y] [testobj objtype $x] [testobj objtype $y]
} "string none abcdefghi\xAE\xBF\xEF \xAE\xBF\xEF string none"
test stringObj-9.4 {TclAppendObjToObj, 1-byte src & dest} {testobj testdstring} {
set x abcdefghi
testdstring free
testdstring append jkl -1
set y [testdstring get]
string length $x
list [testobj objtype $x] [testobj objtype $y] [append x $y] \
[set y] [testobj objtype $x] [testobj objtype $y]
} {string none abcdefghijkl jkl string none}
test stringObj-9.5 {TclAppendObjToObj, 1-byte src & dest} testobj {
set x abcdefghi
string length $x
list [testobj objtype $x] [append x $x] [testobj objtype $x] \
[append x $x] [testobj objtype $x]
} {string abcdefghiabcdefghi string abcdefghiabcdefghiabcdefghiabcdefghi\
string}
test stringObj-9.6 {TclAppendObjToObj, 1-byte src & mixed dest} {testobj testdstring} {
set x abc\xEF\xBF\xAEghi
testdstring free
testdstring append jkl -1
set y [testdstring get]
string length $x
list [testobj objtype $x] [testobj objtype $y] [append x $y] \
[set y] [testobj objtype $x] [testobj objtype $y]
} "string none abc\xEF\xBF\xAEghijkl jkl string none"
test stringObj-9.7 {TclAppendObjToObj, integer src & dest} testobj {
set x [expr {4 * 5}]
set y [expr {4 + 5}]
list [testobj objtype $x] [testobj objtype $y] [append x $y] \
[testobj objtype $x] [append x $y] [testobj objtype $x] \
[testobj objtype $y]
} {int int 209 string 2099 string int}
test stringObj-9.8 {TclAppendObjToObj, integer src & dest} testobj {
set x [expr {4 * 5}]
list [testobj objtype $x] [append x $x] [testobj objtype $x] \
[append x $x] [testobj objtype $x]
} {int 2020 string 20202020 string}
test stringObj-9.9 {TclAppendObjToObj, integer src & 1-byte dest} testobj {
set x abcdefghi
set y [expr {4 + 5}]
string length $x
list [testobj objtype $x] [testobj objtype $y] [append x $y] \
[set y] [testobj objtype $x] [testobj objtype $y]
} {string int abcdefghi9 9 string int}
test stringObj-9.10 {TclAppendObjToObj, integer src & mixed dest} testobj {
set x abc\xEF\xBF\xAEghi
set y [expr {4 + 5}]
string length $x
list [testobj objtype $x] [testobj objtype $y] [append x $y] \
[set y] [testobj objtype $x] [testobj objtype $y]
} "string int abc\xEF\xBF\xAEghi9 9 string int"
test stringObj-9.11 {TclAppendObjToObj, mixed src & 1-byte dest index check} testobj {
# bug 2678, in <=8.2.0, the second obj (the one to append) in
# Tcl_AppendObjToObj was not correctly checked to see if it was all one
# byte chars, so a unicode string would be added as one byte chars.
set x abcdef
set len [string length $x]
set y a\xFCb\xE5c\xEF
set len [string length $y]
append x $y
string length $x
set q {}
for {set i 0} {$i < 12} {incr i} {
lappend q [string index $x $i]
}
set q
} "a b c d e f a \xFC b \xE5 c \xEF"
test stringObj-10.1 {Tcl_GetRange with all byte-size chars} {testobj testdstring} {
testdstring free
testdstring append abcdef -1
set x [testdstring get]
list [testobj objtype $x] [set y [string range $x 1 end-1]] \
[testobj objtype $x] [testobj objtype $y]
} [list none bcde string string]
test stringObj-10.2 {Tcl_GetRange with some mixed width chars} {testobj testdstring} {
testdstring free
testdstring append "abcïïdef" -1
set x [testdstring get]
list [testobj objtype $x] [set y [string range $x 1 end-1]] \
[testobj objtype $x] [testobj objtype $y]
} [list none "bcïïde" string string]
test stringObj-10.3 {Tcl_GetRange with some mixed width chars} testobj {
set x "abcïïdef"
string length $x
list [testobj objtype $x] [set y [string range $x 1 end-1]] \
[testobj objtype $x] [testobj objtype $y]
} [list string "bcïïde" string string]
test stringObj-10.4 {Tcl_GetRange with some mixed width chars} testobj {
set a "ïa¿b®cï¿d®"
set result [list]
while {[string length $a] > 0} {
set a [string range $a 1 end-1]
lappend result $a
}
set result
} [list a\xBFb\xAEc\xEF\xBFd \
\xBFb\xAEc\xEF\xBF \
b\xAEc\xEF \
\xAEc \
{}]
test stringObj-11.1 {UpdateStringOfString} testobj {
set x 2345
list [string index $x end] [testobj objtype $x] [incr x] \
[testobj objtype $x]
} {5 string 2346 int}
|
| ︙ | ︙ | |||
390 391 392 393 394 395 396 |
list [string index $x 3] [string index $x end]
} {d i}
test stringObj-12.3 {Tcl_GetUniChar with byte-size chars} testobj {
set x "abcdefghi"
list [string index $x end] [string index $x end-1]
} {i h}
test stringObj-12.4 {Tcl_GetUniChar with mixed width chars} testobj {
| | | | | | | | | | | 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 |
list [string index $x 3] [string index $x end]
} {d i}
test stringObj-12.3 {Tcl_GetUniChar with byte-size chars} testobj {
set x "abcdefghi"
list [string index $x end] [string index $x end-1]
} {i h}
test stringObj-12.4 {Tcl_GetUniChar with mixed width chars} testobj {
string index "\xEFa\xBFb\xAEc\xAE\xBFd\xEF" 0
} "\xEF"
test stringObj-12.5 {Tcl_GetUniChar} testobj {
set x "\xEFa\xBFb\xAEc\xAE\xBFd\xEF"
list [string index $x 4] [string index $x 0]
} "\xAE \xEF"
test stringObj-12.6 {Tcl_GetUniChar} testobj {
string index "\xEFa\xBFb\xAEc\xEF\xBFd\xAE" end
} "\xAE"
test stringObj-13.1 {Tcl_GetCharLength with byte-size chars} testobj {
set a ""
list [string length $a] [string length $a]
} {0 0}
test stringObj-13.2 {Tcl_GetCharLength with byte-size chars} testobj {
string length "a"
} 1
test stringObj-13.3 {Tcl_GetCharLength with byte-size chars} testobj {
set a "abcdef"
list [string length $a] [string length $a]
} {6 6}
test stringObj-13.4 {Tcl_GetCharLength with mixed width chars} testobj {
string length "\xAE"
} 1
test stringObj-13.5 {Tcl_GetCharLength with mixed width chars} testobj {
# string length "○○"
# Use \uXXXX notation below instead of hardcoding the values, otherwise
# the test will fail in multibyte locales.
string length "\xEF\xBF\xAE\xEF\xBF\xAE"
} 6
test stringObj-13.6 {Tcl_GetCharLength with mixed width chars} testobj {
# set a "ïa¿b®cï¿d®"
# Use \uXXXX notation below instead of hardcoding the values, otherwise
# the test will fail in multibyte locales.
set a "\xEFa\xBFb\xAEc\xEF\xBFd\xAE"
list [string length $a] [string length $a]
} {10 10}
test stringObj-13.7 {Tcl_GetCharLength with identity nulls} {testobj testbytestring} {
# SF bug #684699
string length [testbytestring \x00]
} 1
test stringObj-13.8 {Tcl_GetCharLength with identity nulls} {testobj testbytestring} {
|
| ︙ | ︙ | |||
462 463 464 465 466 467 468 |
teststringobj set 1 foo
teststringobj appendself 1 2
} fooo
test stringObj-15.4 {Tcl_Append*ToObj: self appends} testobj {
teststringobj set 1 foo
teststringobj appendself 1 3
} foo
| | | | | | 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 |
teststringobj set 1 foo
teststringobj appendself 1 2
} fooo
test stringObj-15.4 {Tcl_Append*ToObj: self appends} testobj {
teststringobj set 1 foo
teststringobj appendself 1 3
} foo
test stringObj-15.5 {Tcl_Append*ToObj: self appends} {testobj tip389 deprecated} {
teststringobj set 1 foo
teststringobj appendself2 1 0
} foofoo
test stringObj-15.6 {Tcl_Append*ToObj: self appends} {testobj tip389 deprecated} {
teststringobj set 1 foo
teststringobj appendself2 1 1
} foooo
test stringObj-15.7 {Tcl_Append*ToObj: self appends} {testobj tip389 deprecated} {
teststringobj set 1 foo
teststringobj appendself2 1 2
} fooo
test stringObj-15.8 {Tcl_Append*ToObj: self appends} {testobj tip389 deprecated} {
teststringobj set 1 foo
teststringobj appendself2 1 3
} foo
if {[testConstraint testobj]} {
testobj freeallvars
}
|
| ︙ | ︙ |
Changes to tests/subst.test.
| ︙ | ︙ | |||
44 45 46 47 48 49 50 |
test subst-3.1 {backslash substitutions} {
subst {\x\$x\[foo bar]\\}
} "x\$x\[foo bar]\\"
test subst-3.2 {backslash substitutions with utf chars} {
# 'j' is just a char that doesn't mean anything, and \344 is 'ä'
# that also doesn't mean anything, but is multi-byte in UTF-8.
list [subst \j] [subst \\j] [subst \\344] [subst \\\344]
| | | 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 |
test subst-3.1 {backslash substitutions} {
subst {\x\$x\[foo bar]\\}
} "x\$x\[foo bar]\\"
test subst-3.2 {backslash substitutions with utf chars} {
# 'j' is just a char that doesn't mean anything, and \344 is 'ä'
# that also doesn't mean anything, but is multi-byte in UTF-8.
list [subst \j] [subst \\j] [subst \\344] [subst \\\344]
} "j j ä ä"
test subst-4.1 {variable substitutions} {
set a 44
subst {$a}
} {44}
test subst-4.2 {variable substitutions} {
set a 44
|
| ︙ | ︙ |
Changes to tests/tcltest.test.
| ︙ | ︙ | |||
712 713 714 715 716 717 718 |
}
}
# clean up from directory testing
switch -- $::tcl_platform(platform) {
unix {
| | | | 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 |
}
}
# clean up from directory testing
switch -- $::tcl_platform(platform) {
unix {
file attributes $notReadableDir -permissions 0o777
file attributes $notWriteableDir -permissions 0o777
}
default {
catch {testchmod 0o777 $notWriteableDir}
catch {file attributes $notWriteableDir -readonly 0}
}
}
|
| ︙ | ︙ |
Changes to tests/tcltests.tcl.
1 2 3 4 | #! /usr/bin/env tclsh package require tcltest 2.5 namespace import ::tcltest::* | | > > > > > > > > > | < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 |
#! /usr/bin/env tclsh
package require tcltest 2.5
namespace import ::tcltest::*
testConstraint exec [llength [info commands exec]]
testConstraint deprecated [expr {![tcl::build-info no-deprecate]}]
testConstraint debug [tcl::build-info debug]
testConstraint purify [tcl::build-info purify]
testConstraint debugpurify [
expr {
![tcl::build-info memdebug]
&& [testConstraint debug]
&& [testConstraint purify]
}]
testConstraint fcopy [llength [info commands fcopy]]
testConstraint fileevent [llength [info commands fileevent]]
testConstraint thread [expr {![catch {package require Thread 2.7-}]}]
testConstraint notValgrind [expr {![testConstraint valgrind]}]
namespace eval ::tcltests {
proc init {} {
|
| ︙ | ︙ |
Changes to tests/timer.test.
| ︙ | ︙ | |||
363 364 365 366 367 368 369 |
test timer-6.23 {Tcl_AfterCmd procedure, no option, script with NUL} -setup {
foreach i [after info] {
after cancel $i
}
} -body {
set x "hello world"
| | | | | | | | | | | 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 |
test timer-6.23 {Tcl_AfterCmd procedure, no option, script with NUL} -setup {
foreach i [after info] {
after cancel $i
}
} -body {
set x "hello world"
after 1 "set x ab\x00cd"
after 10
update
string length $x
} -result {5}
test timer-6.24 {Tcl_AfterCmd procedure, no option, script with NUL} -setup {
foreach i [after info] {
after cancel $i
}
} -body {
set x "hello world"
after 1 set x ab\x00cd
after 10
update
string length $x
} -result {5}
test timer-6.25 {Tcl_AfterCmd procedure, cancel option, script with NUL} -setup {
foreach i [after info] {
after cancel $i
}
} -body {
set x "hello world"
after 1 set x ab\x00cd
after cancel "set x ab\x00ef"
llength [after info]
} -cleanup {
foreach i [after info] {
after cancel $i
}
} -result {1}
test timer-6.26 {Tcl_AfterCmd procedure, cancel option, script with NUL} -setup {
foreach i [after info] {
after cancel $i
}
} -body {
set x "hello world"
after 1 set x ab\x00cd
after cancel set x ab\x00ef
llength [after info]
} -cleanup {
foreach i [after info] {
after cancel $i
}
} -result {1}
test timer-6.27 {Tcl_AfterCmd procedure, idle option, script with NUL} -setup {
foreach i [after info] {
after cancel $i
}
} -body {
set x "hello world"
after idle "set x ab\x00cd"
update
string length $x
} -result {5}
test timer-6.28 {Tcl_AfterCmd procedure, idle option, script with NUL} -setup {
foreach i [after info] {
after cancel $i
}
} -body {
set x "hello world"
after idle set x ab\x00cd
update
string length $x
} -result {5}
test timer-6.29 {Tcl_AfterCmd procedure, info option, script with NUL} -setup {
foreach i [after info] {
after cancel $i
}
} -body {
set x "hello world"
set id junk
set id [after 10 set x ab\x00cd]
update
string length [lindex [lindex [after info $id] 0] 2]
} -cleanup {
foreach i [after info] {
after cancel $i
}
} -result 5
|
| ︙ | ︙ |
Changes to tests/unixInit.test.
| ︙ | ︙ | |||
122 123 124 125 126 127 128 |
} -result {1 1}
test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} -setup {
unset -nocomplain oldlibrary
if {[info exists env(TCL_LIBRARY)]} {
set oldlibrary $env(TCL_LIBRARY)
}
} -body {
| | | 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 |
} -result {1 1}
test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} -setup {
unset -nocomplain oldlibrary
if {[info exists env(TCL_LIBRARY)]} {
set oldlibrary $env(TCL_LIBRARY)
}
} -body {
# ((str != NULL) && (str[0] != '\x00'))
set env(TCL_LIBRARY) sparkly
lindex [getlibpath] 0
} -cleanup {
unset -nocomplain env(TCL_LIBRARY)
if {[info exists oldlibrary]} {
set env(TCL_LIBRARY) $oldlibrary
unset oldlibrary
|
| ︙ | ︙ | |||
154 155 156 157 158 159 160 |
} -result [list /a/b/tcl1.7 /a/b/tcl[info tclversion]]
test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} -setup {
if {[info exists env(TCL_LIBRARY)]} {
set oldlibrary $env(TCL_LIBRARY)
}
} -body {
# Child process translates env variable from native encoding.
| | | | 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 |
} -result [list /a/b/tcl1.7 /a/b/tcl[info tclversion]]
test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} -setup {
if {[info exists env(TCL_LIBRARY)]} {
set oldlibrary $env(TCL_LIBRARY)
}
} -body {
# Child process translates env variable from native encoding.
set env(TCL_LIBRARY) "§"
lindex [getlibpath] 0
} -cleanup {
unset -nocomplain env(TCL_LIBRARY) env(LANG)
if {[info exists oldlibrary]} {
set env(TCL_LIBRARY) $oldlibrary
unset oldlibrary
}
} -result "§"
test unixInit-2.5 {TclpInitLibraryPath: compiled-in library path} {
# cannot test
} {}
test unixInit-2.6 {TclpInitLibraryPath: executable relative} -setup {
unset -nocomplain oldlibrary
if {[info exists env(TCL_LIBRARY)]} {
set oldlibrary $env(TCL_LIBRARY)
|
| ︙ | ︙ |
Changes to tests/upvar.test.
| ︙ | ︙ | |||
244 245 246 247 248 249 250 251 252 253 254 255 256 257 |
upvar y x
lappend result $x
global x
lappend result $x
}
p1
} {abcde 44}
test upvar-7.1 {upvar to same level} {
set x 44
set y 55
catch {unset uv}
upvar #0 x uv
set uv abc
| > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
upvar y x
lappend result $x
global x
lappend result $x
}
p1
} {abcde 44}
test upvar-6.4 {
retargeting a variable created by upvar to itself is allowed
} -body {
catch {
unset x
}
catch {
unset y
}
set res {}
set x abcde
set res [catch {
upvar 0 x x
} cres copts]
lappend res [dict get $copts -errorcode]
upvar 0 x y
lappend res $y
upvar 0 y y
lappend res $y
return $res
} -cleanup {
upvar 0 {} y
} -result {1 {TCL UPVAR SELF} abcde abcde}
test upvar-7.1 {upvar to same level} {
set x 44
set y 55
catch {unset uv}
upvar #0 x uv
set uv abc
|
| ︙ | ︙ |
Changes to tests/utf.test.
| ︙ | ︙ | |||
45 46 47 48 49 50 51 |
test utf-1.2 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring {
expr {"\x00" eq [testbytestring \xC0\x80]}
} 1
test utf-1.3 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring {
expr {"\xE0" eq [testbytestring \xC3\xA0]}
} 1
test utf-1.4 {Tcl_UniCharToUtf: 3 byte sequences} testbytestring {
| | | | | > > > > > > > > > > > > > > > > > > > | 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 |
test utf-1.2 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring {
expr {"\x00" eq [testbytestring \xC0\x80]}
} 1
test utf-1.3 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring {
expr {"\xE0" eq [testbytestring \xC3\xA0]}
} 1
test utf-1.4 {Tcl_UniCharToUtf: 3 byte sequences} testbytestring {
expr {"乎" eq [testbytestring \xE4\xB9\x8E]}
} 1
test utf-1.5 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} testbytestring {
expr {[format %c 0x110000] eq [testbytestring \xEF\xBF\xBD]}
} 1
test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} testbytestring {
expr {[format %c -1] eq [testbytestring \xEF\xBF\xBD]}
} 1
test utf-1.7.0 {Tcl_UniCharToUtf: 4 byte sequences} {fullutf testbytestring} {
expr {"\U014E4E" eq [testbytestring \xF0\x94\xB9\x8E]}
} 1
test utf-1.7.1 {Tcl_UniCharToUtf: 4 byte sequences} {Uesc ucs2 testbytestring} {
expr {"\U014E4E" eq [testbytestring \xF0\x94\xB9\x8E]}
} 0
test utf-1.8 {Tcl_UniCharToUtf: 3 byte sequence, high surrogate} testbytestring {
expr {"\uD842" eq [testbytestring \xED\xA1\x82]}
} 1
test utf-1.9 {Tcl_UniCharToUtf: 3 byte sequence, low surrogate} testbytestring {
expr {"\uDC42" eq [testbytestring \xED\xB1\x82]}
} 1
test utf-1.10 {Tcl_UniCharToUtf: 3 byte sequence, high surrogate} testbytestring {
expr {[format %c 0xD842] eq [testbytestring \xED\xA1\x82]}
} 1
test utf-1.11 {Tcl_UniCharToUtf: 3 byte sequence, low surrogate} testbytestring {
expr {[format %c 0xDC42] eq [testbytestring \xED\xB1\x82]}
} 1
test utf-1.12 {Tcl_UniCharToUtf: 4 byte sequence, high/low surrogate} {pairsTo4bytes testbytestring} {
expr {"\uD842\uDC42" eq [testbytestring \xF0\xA0\xA1\x82]}
} 1
test utf-1.13.0 {Tcl_UniCharToUtf: Invalid surrogate} {Uesc ucs2} {
expr {"\UD842" eq "\uD842"}
} 1
test utf-1.13.1 {Tcl_UniCharToUtf: Invalid surrogate} {fullutf testbytestring} {
expr {"\UD842" eq [testbytestring \xEF\xBF\xBD]}
} 1
test utf-1.14 {Tcl_UniCharToUtf: surrogate pairs from concat} {
set lo \uDE02
return \uD83D$lo
} \uD83D\uDE02
test utf-1.15 {Tcl_UniCharToUtf: surrogate pairs from concat} {
set hi \uD83D
return $hi\uDE02
} \uD83D\uDE02
test utf-1.16 {Tcl_UniCharToUtf: \xC0 + \x80} testbytestring {
set lo [testbytestring \x80]
string length [testbytestring \xC0]$lo
} 2
test utf-1.17 {Tcl_UniCharToUtf: \xC0 + \x80} testbytestring {
set hi [testbytestring \xC0]
string length $hi[testbytestring \x80]
} 2
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
test utf-2.2 {Tcl_UtfToUniChar: naked trail bytes} testbytestring {
string length [testbytestring \x82\x83\x84]
} 3
|
| ︙ | ︙ | |||
102 103 104 105 106 107 108 |
} 1
test utf-2.6 {Tcl_UtfToUniChar: lead (3-byte) followed by 1 trail} testbytestring {
string length [testbytestring \xE2\xA2]
} 2
test utf-2.7 {Tcl_UtfToUniChar: lead (3-byte) followed by 2 trail} testbytestring {
string length [testbytestring \xE4\xB9\x8E]
} 1
| | | | | | | | | | 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 |
} 1
test utf-2.6 {Tcl_UtfToUniChar: lead (3-byte) followed by 1 trail} testbytestring {
string length [testbytestring \xE2\xA2]
} 2
test utf-2.7 {Tcl_UtfToUniChar: lead (3-byte) followed by 2 trail} testbytestring {
string length [testbytestring \xE4\xB9\x8E]
} 1
test utf-2.8.0 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {ucs2 testbytestring} {
string length [testbytestring \xF0\x90\x80\x80]
} 2
test utf-2.8.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} utf16 {
string length 𐀀
} 2
test utf-2.8.2 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} ucs4 {
string length 𐀀
} 1
test utf-2.9.0 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {ucs2 testbytestring} {
string length [testbytestring \xF4\x8F\xBF\xBF]
} 2
test utf-2.9.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} utf16 {
string length \U10FFFF
} 2
test utf-2.9.2 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} ucs4 {
string length \U10FFFF
} 1
test utf-2.10 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail, underflow} testbytestring {
string length [testbytestring \xF0\x8F\xBF\xBF]
} 4
test utf-2.11 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail, overflow} testbytestring {
# Would decode to U+110000 but that is outside the Unicode range.
|
| ︙ | ︙ | |||
200 201 202 203 204 205 206 |
test utf-6.2 {Tcl_UtfNext} testutfnext {
testutfnext A
} 1
test utf-6.3 {Tcl_UtfNext} testutfnext {
testutfnext AA
} 1
test utf-6.4 {Tcl_UtfNext} {testutfnext testbytestring} {
| | | 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 |
test utf-6.2 {Tcl_UtfNext} testutfnext {
testutfnext A
} 1
test utf-6.3 {Tcl_UtfNext} testutfnext {
testutfnext AA
} 1
test utf-6.4 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext [testbytestring A\xA0]
} 1
test utf-6.5 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext A[testbytestring \xD0]
} 1
test utf-6.6 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext A[testbytestring \xE8]
} 1
|
| ︙ | ︙ | |||
350 351 352 353 354 355 356 |
test utf-6.49 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext [testbytestring \xD0\xA0\xF8]
} 2
test utf-6.50 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext [testbytestring \xE8\xA0]G
} 1
test utf-6.51 {Tcl_UtfNext} testutfnext {
| | | 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 |
test utf-6.49 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext [testbytestring \xD0\xA0\xF8]
} 2
test utf-6.50 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext [testbytestring \xE8\xA0]G
} 1
test utf-6.51 {Tcl_UtfNext} testutfnext {
testutfnext 蠠
} 3
test utf-6.52 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext [testbytestring \xE8\xA0\xD0]
} 1
test utf-6.53 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext [testbytestring \xE8\xA0\xE8]
} 1
|
| ︙ | ︙ | |||
383 384 385 386 387 388 389 |
test utf-6.60 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext [testbytestring \xF2\xA0\xF2]
} 1
test utf-6.61 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext [testbytestring \xF2\xA0\xF8]
} 1
test utf-6.62 {Tcl_UtfNext} testutfnext {
| | | | | | | | 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 |
test utf-6.60 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext [testbytestring \xF2\xA0\xF2]
} 1
test utf-6.61 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext [testbytestring \xF2\xA0\xF8]
} 1
test utf-6.62 {Tcl_UtfNext} testutfnext {
testutfnext 蠠G
} 3
test utf-6.63 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext [testbytestring \xE8\xA0\xA0\xA0]
} 3
test utf-6.64 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext 蠠[testbytestring \xD0]
} 3
test utf-6.65 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext 蠠[testbytestring \xE8]
} 3
test utf-6.66 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext 蠠[testbytestring \xF2]
} 3
test utf-6.67 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext 蠠[testbytestring \xF8]
} 3
test utf-6.68 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext [testbytestring \xF2\xA0\xA0]G
} 1
test utf-6.69.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} {
testutfnext [testbytestring \xF2\xA0\xA0\xA0]
} 1
|
| ︙ | ︙ | |||
561 562 563 564 565 566 567 |
test utf-7.5.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xF2\xF8\xA0\xA0] 2
} 1
test utf-7.6 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xE8]
} 1
test utf-7.6.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
| | | | | | 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 |
test utf-7.5.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xF2\xF8\xA0\xA0] 2
} 1
test utf-7.6 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xE8]
} 1
test utf-7.6.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xE8\xA0\xA0\xA0] 2
} 1
test utf-7.6.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xE8\xF8\xA0\xA0] 2
} 1
test utf-7.7 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xD0]
} 1
test utf-7.7.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xD0\xA0\xA0\xA0] 2
} 1
test utf-7.7.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xD0\xF8\xA0\xA0] 2
} 1
test utf-7.8 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev [testbytestring A\xA0]
} 1
test utf-7.8.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev [testbytestring A\xA0\xA0\xA0\xA0] 2
} 1
test utf-7.8.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev [testbytestring A\xA0\xF8\xA0\xA0] 2
} 1
test utf-7.9 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xF8\xA0]
} 2
test utf-7.9.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xF8\xA0\xA0\xA0] 3
} 2
|
| ︙ | ︙ | |||
615 616 617 618 619 620 621 |
test utf-7.10.5 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} {
testutfprev A[testbytestring \xF2\xA0\xF8\xA0] 3
} 1
test utf-7.11 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xE8\xA0]
} 1
test utf-7.11.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
| | | | | | 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 |
test utf-7.10.5 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} {
testutfprev A[testbytestring \xF2\xA0\xF8\xA0] 3
} 1
test utf-7.11 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xE8\xA0]
} 1
test utf-7.11.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xE8\xA0\xA0\xA0] 3
} 1
test utf-7.11.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xE8\xA0\xF8\xA0] 3
} 1
test utf-7.11.3 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xE8\xA0\xF8] 3
} 1
test utf-7.12 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xD0\xA0]
} 1
test utf-7.12.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xD0\xA0\xA0\xA0] 3
} 1
test utf-7.12.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xD0\xA0\xF8\xA0] 3
} 1
test utf-7.13 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev [testbytestring A\xA0\xA0]
} 2
test utf-7.13.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev [testbytestring A\xA0\xA0\xA0\xA0] 3
} 2
test utf-7.13.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev [testbytestring A\xA0\xA0\xF8\xA0] 3
} 2
test utf-7.14 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xF8\xA0\xA0]
} 3
test utf-7.14.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xF8\xA0\xA0\xA0] 4
} 3
|
| ︙ | ︙ | |||
669 670 671 672 673 674 675 |
test utf-7.15.4 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} {
testutfprev A[testbytestring \xF2\xA0\xA0\xF8] 4
} 3
test utf-7.15.5 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} {
testutfprev A[testbytestring \xF2\xA0\xA0\xF8] 4
} 1
test utf-7.16 {Tcl_UtfPrev} testutfprev {
| | | | | | | | | | | | | 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 |
test utf-7.15.4 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} {
testutfprev A[testbytestring \xF2\xA0\xA0\xF8] 4
} 3
test utf-7.15.5 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} {
testutfprev A[testbytestring \xF2\xA0\xA0\xF8] 4
} 1
test utf-7.16 {Tcl_UtfPrev} testutfprev {
testutfprev A蠠
} 1
test utf-7.16.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xE8\xA0\xA0\xA0] 4
} 1
test utf-7.16.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A蠠[testbytestring \xF8] 4
} 1
test utf-7.17 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xD0\xA0\xA0]
} 3
test utf-7.17.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xD0\xA0\xA0\xA0] 4
} 3
test utf-7.17.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xD0\xA0\xA0\xF8] 4
} 3
test utf-7.18.0 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev [testbytestring A\xA0\xA0\xA0]
} 3
test utf-7.18.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev [testbytestring A\xA0\xA0\xA0\xA0] 4
} 3
test utf-7.18.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev [testbytestring A\xA0\xA0\xA0\xF8] 4
} 3
test utf-7.19 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev [testbytestring A\xF8\xA0\xA0\xA0]
} 4
test utf-7.20.0 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} {
testutfprev [testbytestring A\xF2\xA0\xA0\xA0]
} 4
test utf-7.20.1 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} {
testutfprev [testbytestring A\xF2\xA0\xA0\xA0]
} 1
test utf-7.21 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xE8\xA0\xA0\xA0]
} 4
test utf-7.22 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xD0\xA0\xA0\xA0]
} 4
test utf-7.23 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev [testbytestring A\xA0\xA0\xA0\xA0]
} 4
test utf-7.24 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} {
testutfprev A[testbytestring \xC0\x81]
} 2
test utf-7.25 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} {
testutfprev A[testbytestring \xC0\x81] 2
} 1
|
| ︙ | ︙ | |||
801 802 803 804 805 806 807 |
test utf-7.46 {Tcl_UtfPrev -- no lead byte at start} {testutfprev testbytestring} {
testutfprev [testbytestring \xA0\xA0\xA0\xA0]
} 3
test utf-7.47 {Tcl_UtfPrev, pointing to 3th byte of 3-byte valid sequence} {testutfprev testbytestring} {
testutfprev [testbytestring \xE8\xA0]
} 0
test utf-7.47.1 {Tcl_UtfPrev, pointing to 3th byte of 3-byte valid sequence} testutfprev {
| | | 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 |
test utf-7.46 {Tcl_UtfPrev -- no lead byte at start} {testutfprev testbytestring} {
testutfprev [testbytestring \xA0\xA0\xA0\xA0]
} 3
test utf-7.47 {Tcl_UtfPrev, pointing to 3th byte of 3-byte valid sequence} {testutfprev testbytestring} {
testutfprev [testbytestring \xE8\xA0]
} 0
test utf-7.47.1 {Tcl_UtfPrev, pointing to 3th byte of 3-byte valid sequence} testutfprev {
testutfprev 蠠 2
} 0
test utf-7.47.2 {Tcl_UtfPrev, pointing to 3th byte of 3-byte invalid sequence} {testutfprev testbytestring} {
testutfprev [testbytestring \xE8\xA0\x00] 2
} 0
test utf-7.48.0 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} {
testutfprev A[testbytestring \xF4\x8F\xBF\xBF]
} 4
|
| ︙ | ︙ | |||
844 845 846 847 848 849 850 |
testutfprev A[testbytestring \xF4\x90\x80\x80] 2
} 1
test utf-8.1 {Tcl_UniCharAtIndex: index = 0} {
string index abcd 0
} a
test utf-8.2 {Tcl_UniCharAtIndex: index = 0} {
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 |
testutfprev A[testbytestring \xF4\x90\x80\x80] 2
} 1
test utf-8.1 {Tcl_UniCharAtIndex: index = 0} {
string index abcd 0
} a
test utf-8.2 {Tcl_UniCharAtIndex: index = 0} {
string index 乎ɚ 0
} 乎
test utf-8.3 {Tcl_UniCharAtIndex: index > 0} {
string index abcd 2
} c
test utf-8.4 {Tcl_UniCharAtIndex: index > 0} {
string index 乎ɚÿՃ 2
} ÿ
test utf-8.5.0 {Tcl_UniCharAtIndex: high surrogate} ucs2 {
string index \uD842 0
} \uD842
test utf-8.5.1 {Tcl_UniCharAtIndex: high surrogate} ucs4 {
string index \uD842 0
} \uD842
test utf-8.5.2 {Tcl_UniCharAtIndex: high surrogate} utf16 {
string index \uD842 0
} \uD842
test utf-8.6 {Tcl_UniCharAtIndex: low surrogate} {
string index \uDC42 0
} \uDC42
test utf-8.7.0 {Tcl_UniCharAtIndex: Emoji} ucs2 {
string index \uD83D\uDE00G 0
} \uD83D
test utf-8.7.1 {Tcl_UniCharAtIndex: Emoji} ucs4 {
string index 😀G 0
} 😀
test utf-8.7.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
string index 😀G 0
} 😀
test utf-8.8.0 {Tcl_UniCharAtIndex: Emoji} ucs2 {
string index \uD83D\uDE00G 1
} \uDE00
test utf-8.8.1 {Tcl_UniCharAtIndex: Emoji} ucs4 {
string index 😀G 1
} G
test utf-8.8.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
string index 😀G 1
} {}
test utf-8.9.0 {Tcl_UniCharAtIndex: Emoji} ucs2 {
string index \uD83D\uDE00G 2
} G
test utf-8.9.1 {Tcl_UniCharAtIndex: Emoji} ucs4 {
string index 😀G 2
} {}
test utf-8.9.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
string index 😀G 2
} G
test utf-8.10.0 {Tcl_UniCharAtIndex: Emoji} ucs2 {
string index 😀G 0
} \uFFFD
test utf-8.10.1 {Tcl_UniCharAtIndex: Emoji} ucs4 {
string index 😀G 0
} 😀
test utf-8.10.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
string index 😀G 0
} 😀
test utf-8.11.0 {Tcl_UniCharAtIndex: Emoji} ucs2 {
string index 😀G 1
} G
test utf-8.11.1 {Tcl_UniCharAtIndex: Emoji} ucs4 {
string index 😀G 1
} G
test utf-8.11.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
string index 😀G 1
} {}
test utf-8.12.0 {Tcl_UniCharAtIndex: Emoji} ucs2 {
string index 😀G 2
} {}
test utf-8.12.1 {Tcl_UniCharAtIndex: Emoji} ucs4 {
string index 😀G 2
} {}
test utf-8.12.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
string index 😀G 2
} G
test utf-9.1 {Tcl_UtfAtIndex: index = 0} {
string range abcd 0 2
} abc
test utf-9.2 {Tcl_UtfAtIndex: index > 0} {
string range 乎ɚÿՃklmnop 1 5
} ɚÿՃkl
test utf-9.3.0 {Tcl_UtfAtIndex: index = 0, Emoji} ucs2 {
string range \uD83D\uDE00G 0 0
} \uD83D
test utf-9.3.1 {Tcl_UtfAtIndex: index = 0, Emoji} ucs4 {
string range 😀G 0 0
} 😀
test utf-9.3.2 {Tcl_UtfAtIndex: index = 0, Emoji} utf16 {
string range 😀G 0 0
} 😀
test utf-9.4.0 {Tcl_UtfAtIndex: index > 0, Emoji} ucs2 {
string range \uD83D\uDE00G 1 1
} \uDE00
test utf-9.4.1 {Tcl_UtfAtIndex: index > 0, Emoji} ucs4 {
string range 😀G 1 1
} G
test utf-9.4.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 {
string range 😀G 1 1
} {}
test utf-9.5.0 {Tcl_UtfAtIndex: index > 0, Emoji} ucs2 {
string range \uD83D\uDE00G 2 2
} G
test utf-9.5.1 {Tcl_UtfAtIndex: index > 0, Emoji} ucs4 {
string range 😀G 2 2
} {}
test utf-9.5.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 {
string range 😀G 2 2
} G
test utf-9.6.0 {Tcl_UtfAtIndex: index = 0, Emoji} ucs2 {
string range 😀G 0 0
} \uFFFD
test utf-9.6.1 {Tcl_UtfAtIndex: index = 0, Emoji} ucs4 {
string range 😀G 0 0
} 😀
test utf-9.6.2 {Tcl_UtfAtIndex: index = 0, Emoji} utf16 {
string range 😀G 0 0
} 😀
test utf-9.7.0 {Tcl_UtfAtIndex: index > 0, Emoji} ucs2 {
string range 😀G 1 1
} G
test utf-9.7.1 {Tcl_UtfAtIndex: index > 0, Emoji} ucs4 {
string range 😀G 1 1
} G
test utf-9.7.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 {
string range 😀G 1 1
} {}
test utf-9.8.0 {Tcl_UtfAtIndex: index > 0, Emoji} ucs2 {
string range 😀G 2 2
} {}
test utf-9.8.1 {Tcl_UtfAtIndex: index > 0, Emoji} ucs4 {
string range 😀G 2 2
} {}
test utf-9.8.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 {
string range 😀G 2 2
} G
test utf-10.1 {Tcl_UtfBackslash: dst == NULL} {
set x \n
} {
}
test utf-10.2 {Tcl_UtfBackslash: \u subst} testbytestring {
expr {"\uA2" eq [testbytestring \xC2\xA2]}
} 1
test utf-10.3 {Tcl_UtfBackslash: longer \u subst} testbytestring {
expr {"\u4E21" eq [testbytestring \xE4\xB8\xA1]}
} 1
test utf-10.4 {Tcl_UtfBackslash: stops at first non-hex} testbytestring {
expr {"\u4E2k" eq "[testbytestring \xD3\xA2]k"}
} 1
test utf-10.5 {Tcl_UtfBackslash: stops after 4 hex chars} testbytestring {
expr {"\u4E216" eq "[testbytestring \xE4\xB8\xA1]6"}
} 1
test utf-10.6 {Tcl_UtfBackslash: stops after 5 hex chars} {fullutf testbytestring} {
expr {"\U1E2165" eq "[testbytestring \xF0\x9E\x88\x96]5"}
} 1
test utf-10.7 {Tcl_UtfBackslash: stops after 6 hex chars} {fullutf testbytestring} {
expr {"\U10E2165" eq "[testbytestring \xF4\x8E\x88\x96]5"}
} 1
proc bsCheck {char num {constraints {}}} {
global errNum
test utf-10.$errNum {backslash substitution} $constraints {
scan $char %c value
|
| ︙ | ︙ | |||
1062 1063 1064 1065 1066 1067 1068 | bsCheck \Ua 10 Uesc bsCheck \UA 10 Uesc bsCheck \UA1 161 Uesc bsCheck \U4E21 20001 Uesc bsCheck \U004E21 20001 Uesc bsCheck \U00004E21 20001 Uesc bsCheck \U0000004E21 78 Uesc | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 |
bsCheck \Ua 10 Uesc
bsCheck \UA 10 Uesc
bsCheck \UA1 161 Uesc
bsCheck \U4E21 20001 Uesc
bsCheck \U004E21 20001 Uesc
bsCheck \U00004E21 20001 Uesc
bsCheck \U0000004E21 78 Uesc
bsCheck \U00110000 69632 fullutf
bsCheck \U01100000 69632 fullutf
bsCheck \U11000000 69632 fullutf
bsCheck \U0010FFFF 1114111 fullutf
bsCheck \U010FFFF0 1114111 fullutf
bsCheck \U10FFFF00 1114111 fullutf
bsCheck \UFFFFFFFF 1048575 fullutf
test utf-11.1 {Tcl_UtfToUpper} {
string toupper {}
} {}
test utf-11.2 {Tcl_UtfToUpper} {
string toupper abc
} ABC
test utf-11.3 {Tcl_UtfToUpper} {
string toupper \xE3gh
} \xC3GH
test utf-11.4 {Tcl_UtfToUpper} {
string toupper ǣgh
} ǢGH
test utf-11.5 {Tcl_UtfToUpper Georgian (new in Unicode 11)} {
string toupper აᲐ
} ᲐᲐ
test utf-11.6 {Tcl_UtfToUpper beyond U+FFFF} fullutf {
string toupper 𐐨
} 𐐀
test utf-11.7 {Tcl_UtfToUpper beyond U+FFFF} fullutf {
string toupper 𐐨
} 𐐀
test utf-11.8 {Tcl_UtfToUpper low/high surrogate)} {
string toupper \uDC24\uD824
} \uDC24\uD824
test utf-12.1 {Tcl_UtfToLower} {
string tolower {}
} {}
test utf-12.2 {Tcl_UtfToLower} {
string tolower ABC
} abc
test utf-12.3 {Tcl_UtfToLower} {
string tolower ÃGH
} ãgh
test utf-12.4 {Tcl_UtfToLower} {
string tolower ǢGH
} ǣgh
test utf-12.5 {Tcl_UtfToLower Georgian (new in Unicode 11)} {
string tolower აᲐ
} აა
test utf-12.6 {Tcl_UtfToLower low/high surrogate)} {
string tolower \uDC24\uD824
} \uDC24\uD824
test utf-12.7 {Tcl_UtfToLower beyond U+FFFF} fullutf {
string tolower 𐐀
} 𐐨
test utf-12.8 {Tcl_UtfToLower beyond U+FFFF} fullutf {
string tolower 𐐀
} 𐐨
test utf-13.1 {Tcl_UtfToTitle} {
string totitle {}
} {}
test utf-13.2 {Tcl_UtfToTitle} {
string totitle abc
} Abc
test utf-13.3 {Tcl_UtfToTitle} {
string totitle ãGH
} Ãgh
test utf-13.4 {Tcl_UtfToTitle} {
string totitle dzAB
} Dzab
test utf-13.5 {Tcl_UtfToTitle Georgian (new in Unicode 11)} {
string totitle აᲐ
} აᲐ
test utf-13.6 {Tcl_UtfToTitle Georgian (new in Unicode 11)} {
string totitle Აა
} Აა
test utf-13.7 {Tcl_UtfToTitle low/high surrogate)} {
string totitle \uDC24\uD824
} \uDC24\uD824
test utf-13.8 {Tcl_UtfToTitle beyond U+FFFF} fullutf {
string totitle 𐐨𐐀
} 𐐀𐐨
test utf-13.9 {Tcl_UtfToTitle beyond U+FFFF} fullutf {
string totitle 𐐨𐐀
} 𐐀𐐨
test utf-14.1 {Tcl_UtfNcasecmp} {
string compare -nocase a b
} -1
test utf-14.2 {Tcl_UtfNcasecmp} {
string compare -nocase b a
} 1
test utf-14.3 {Tcl_UtfNcasecmp} {
string compare -nocase B a
} 1
test utf-14.4 {Tcl_UtfNcasecmp} {
string compare -nocase aBcB abca
} 1
test utf-15.1 {Tcl_UniCharToUpper, negative delta} {
string toupper aA
} AA
test utf-15.2 {Tcl_UniCharToUpper, positive delta} {
string toupper Ÿÿ
} ŸŸ
test utf-15.3 {Tcl_UniCharToUpper, no delta} {
string toupper !
} !
test utf-16.1 {Tcl_UniCharToLower, negative delta} {
string tolower aA
} aa
test utf-16.2 {Tcl_UniCharToLower, positive delta} {
string tolower ŸÿꞍDž
} ÿÿɥdž
test utf-17.1 {Tcl_UniCharToLower, no delta} {
string tolower !
} !
test utf-18.1 {Tcl_UniCharToTitle, add one for title} {
string totitle DŽ
} Dž
test utf-18.2 {Tcl_UniCharToTitle, subtract one for title} {
string totitle dž
} Dž
test utf-18.3 {Tcl_UniCharToTitle, subtract delta for title (positive)} {
string totitle ſ
} S
test utf-18.4 {Tcl_UniCharToTitle, subtract delta for title (negative)} {
string totitle ÿ
} Ÿ
test utf-18.5 {Tcl_UniCharToTitle, no delta} {
string totitle !
} !
test utf-19.1 {TclUniCharLen} -body {
list [regexp \\d abc456def foo] $foo
} -cleanup {
|
| ︙ | ︙ | |||
1219 1220 1221 1222 1223 1224 1225 |
string range $two 0 0
set second [string compare $one $two]
expr {($first == $second) ? "agree" : "disagree"}
} agree
test utf-21.1 {TclUniCharIsAlnum} {
# this returns 1 with Unicode 7 compliance
| | | | | | | 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 |
string range $two 0 0
set second [string compare $one $two]
expr {($first == $second) ? "agree" : "disagree"}
} agree
test utf-21.1 {TclUniCharIsAlnum} {
# this returns 1 with Unicode 7 compliance
string is alnum ၀ȟȠ
} 1
test utf-21.2 {unicode alnum char in regc_locale.c} {
# this returns 1 with Unicode 7 compliance
list [regexp {^[[:alnum:]]+$} ၀ȟȠ] [regexp {^\w+$} ၀ȟȠ_‿⁀⁔︳︴﹍﹎﹏_]
} {1 1}
test utf-21.3 {unicode print char in regc_locale.c} {
# this returns 1 with Unicode 7 compliance
regexp {^[[:print:]]+$} ﯁
} 1
test utf-21.4 {TclUniCharIsGraph} {
# [Bug 3464428]
string is graph Ġ
} 1
test utf-21.5 {unicode graph char in regc_locale.c} {
# [Bug 3464428]
regexp {^[[:graph:]]+$} Ġ
} 1
test utf-21.6 {TclUniCharIsGraph} {
# [Bug 3464428]
string is graph \xA0
} 0
test utf-21.7 {unicode graph char in regc_locale.c} {
# [Bug 3464428]
|
| ︙ | ︙ | |||
1270 1271 1272 1273 1274 1275 1276 |
regexp {^[[:cntrl:]]*$} \x00\x1F\xAD\u0605\u061C\u180E\u2066\uFEFF
} 1
test utf-22.1 {TclUniCharIsWordChar} {
string wordend "xyz123_bar fg" 0
} 10
test utf-22.2 {TclUniCharIsWordChar} {
| | | | | | | 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 |
regexp {^[[:cntrl:]]*$} \x00\x1F\xAD\u0605\u061C\u180E\u2066\uFEFF
} 1
test utf-22.1 {TclUniCharIsWordChar} {
string wordend "xyz123_bar fg" 0
} 10
test utf-22.2 {TclUniCharIsWordChar} {
string wordend "x傀z123_bar‼ fg" 0
} 10
test utf-23.1 {TclUniCharIsAlpha} {
# this returns 1 with Unicode 7 compliance
string is alpha ȟȠͿԯ
} 1
test utf-23.2 {unicode alpha char in regc_locale.c} {
# this returns 1 with Unicode 7 compliance
regexp {^[[:alpha:]]+$} ȟȠͿԯ
} 1
test utf-24.1 {TclUniCharIsDigit} {
# this returns 1 with Unicode 7 compliance
string is digit ၀꯰
} 1
test utf-24.2 {unicode digit char in regc_locale.c} {
# this returns 1 with Unicode 7 compliance
list [regexp {^[[:digit:]]+$} ၀꯰] [regexp {^\d+$} ၀꯰]
} {1 1}
test utf-24.3 {TclUniCharIsSpace} {
# this returns 1 with Unicode 7 compliance
string is space \u1680\u180E\u202F
} 1
test utf-24.4 {unicode space char in regc_locale.c} {
|
| ︙ | ︙ | |||
1335 1336 1337 1338 1339 1340 1341 | } variable count 1 UniCharCaseCmpTest < a b UniCharCaseCmpTest > b a UniCharCaseCmpTest > B a UniCharCaseCmpTest > aBcB abca UniCharCaseCmpTest < \uFFFF [format %c 0x10000] ucs4 | | | | 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 |
}
variable count 1
UniCharCaseCmpTest < a b
UniCharCaseCmpTest > b a
UniCharCaseCmpTest > B a
UniCharCaseCmpTest > aBcB abca
UniCharCaseCmpTest < \uFFFF [format %c 0x10000] ucs4
UniCharCaseCmpTest < \uFFFF \U10000 ucs4
UniCharCaseCmpTest > [format %c 0x10000] \uFFFF ucs4
UniCharCaseCmpTest > \U10000 \uFFFF ucs4
test utf-26.1 {Tcl_UniCharDString} -setup {
testobj freeallvars
} -constraints {teststringobj testbytestring} -cleanup {
testobj freeallvars
} -body {
|
| ︙ | ︙ |
Changes to tests/util.test.
| ︙ | ︙ | |||
29 30 31 32 33 34 35 |
proc testIEEE {} {
variable ieeeValues
binary scan [binary format dd -1.0 1.0] c* c
switch -exact -- $c {
{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
# little endian
| | | | | | | | | | | | | | | | 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 |
proc testIEEE {} {
variable ieeeValues
binary scan [binary format dd -1.0 1.0] c* c
switch -exact -- $c {
{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
# little endian
binary scan \x00\x00\x00\x00\x00\x00\xF0\xFF d \
ieeeValues(-Infinity)
binary scan \x00\x00\x00\x00\x00\x00\xF0\xBF d \
ieeeValues(-Normal)
binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \
ieeeValues(-Subnormal)
binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \
ieeeValues(-0)
binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+0)
binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \
ieeeValues(+Subnormal)
binary scan \x00\x00\x00\x00\x00\x00\xF0\x3F d \
ieeeValues(+Normal)
binary scan \x00\x00\x00\x00\x00\x00\xF0\x7F d \
ieeeValues(+Infinity)
binary scan \x00\x00\x00\x00\x00\x00\xF8\x7F d \
ieeeValues(NaN)
binary scan \x00\x00\x00\x00\x00\x00\xF8\xFF d \
ieeeValues(-NaN)
binary scan \xEF\xCD\xAB\x89\x67\x45\xFB\xFF d \
ieeeValues(-NaN(3456789abcdef))
set ieeeValues(littleEndian) 1
return 1
}
{-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} {
binary scan \xFF\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Infinity)
binary scan \xBF\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Normal)
binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Subnormal)
binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-0)
binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+0)
binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Subnormal)
binary scan \x3F\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Normal)
binary scan \x7F\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Infinity)
binary scan \x7F\xF8\x00\x00\x00\x00\x00\x00 d \
ieeeValues(NaN)
binary scan \xFF\xF8\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-NaN)
binary scan \xFF\xFB\x45\x67\x89\xAB\xCD\xEF d \
ieeeValues(-NaN(3456789abcdef))
set ieeeValues(littleEndian) 0
return 1
}
default {
return 0
}
|
| ︙ | ︙ | |||
203 204 205 206 207 208 209 |
test util-4.4 {Tcl_ConcatObj - backslash-space at end of argument} {
concat a {b } c
} {a b c}
test util-4.5 {Tcl_ConcatObj - backslash-space at end of argument} {
concat a { } c
} {a c}
test util-4.6 {Tcl_ConcatObj - utf-8 sequence with "whitespace" char} {
| | | | > > > | 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 |
test util-4.4 {Tcl_ConcatObj - backslash-space at end of argument} {
concat a {b } c
} {a b c}
test util-4.5 {Tcl_ConcatObj - backslash-space at end of argument} {
concat a { } c
} {a c}
test util-4.6 {Tcl_ConcatObj - utf-8 sequence with "whitespace" char} {
# Check for Bug #227512. If this violates C isspace, then it returns \xC3.
concat \xE0
} \xE0
test util-4.7 {Tcl_ConcatObj - refCount safety} testconcatobj {
# Check for Bug #1447328 (actually, bugs in its original "fix"). One of the
# symptoms was Bug #2055782.
testconcatobj
} {}
test util-4.8 {Tcl_ConcatObj - [Bug 26649439c7]} {
concat [list foo] [list #]
} {foo {#}}
proc Wrapper_Tcl_StringMatch {pattern string} {
# Forces use of Tcl_StringMatch, not Tcl_UniCharCaseMatch
switch -glob -- $string $pattern {return 1} default {return 0}
}
test util-5.1 {Tcl_StringMatch} {
Wrapper_Tcl_StringMatch ab*c abc
|
| ︙ | ︙ | |||
235 236 237 238 239 240 241 |
test util-5.5 {Tcl_StringMatch} {
Wrapper_Tcl_StringMatch *3*6*9 0123456789
} 1
test util-5.6 {Tcl_StringMatch} {
Wrapper_Tcl_StringMatch *3*6*9 01234567890
} 0
test util-5.7 {Tcl_StringMatch: UTF-8} {
| | | | | | | | | | | | | | 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 |
test util-5.5 {Tcl_StringMatch} {
Wrapper_Tcl_StringMatch *3*6*9 0123456789
} 1
test util-5.6 {Tcl_StringMatch} {
Wrapper_Tcl_StringMatch *3*6*9 01234567890
} 0
test util-5.7 {Tcl_StringMatch: UTF-8} {
Wrapper_Tcl_StringMatch *u 乏u
} 1
test util-5.8 {Tcl_StringMatch} {
Wrapper_Tcl_StringMatch a?c abc
} 1
test util-5.9 {Tcl_StringMatch: UTF-8} {
# skip one character in string
Wrapper_Tcl_StringMatch a?c a乏c
} 1
test util-5.10 {Tcl_StringMatch} {
Wrapper_Tcl_StringMatch a??c abc
} 0
test util-5.11 {Tcl_StringMatch} {
Wrapper_Tcl_StringMatch ?1??4???8? 0123456789
} 1
test util-5.12 {Tcl_StringMatch} {
Wrapper_Tcl_StringMatch {[abc]bc} abc
} 1
test util-5.13 {Tcl_StringMatch: UTF-8} {
# string += Tcl_UtfToUniChar(string, &ch);
Wrapper_Tcl_StringMatch "\[乏xy\]bc" "乏bc"
} 1
test util-5.14 {Tcl_StringMatch} {
# if ((*pattern == ']') || (*pattern == '\x00'))
# badly formed pattern
Wrapper_Tcl_StringMatch {[]} {[]}
} 0
test util-5.15 {Tcl_StringMatch} {
# if ((*pattern == ']') || (*pattern == '\x00'))
# badly formed pattern
Wrapper_Tcl_StringMatch {[} {[}
} 0
test util-5.16 {Tcl_StringMatch} {
Wrapper_Tcl_StringMatch {a[abc]c} abc
} 1
test util-5.17 {Tcl_StringMatch: UTF-8} {
# pattern += Tcl_UtfToUniChar(pattern, &endChar);
# get 1 UTF-8 character
Wrapper_Tcl_StringMatch "a\[a乏c]c" "a乏c"
} 1
test util-5.18 {Tcl_StringMatch: UTF-8} testbytestring {
# pattern += Tcl_UtfToUniChar(pattern, &endChar);
# proper advance: wrong answer would match on UTF trail byte of 乏
Wrapper_Tcl_StringMatch {a[a乏c]c} [testbytestring a\x8Fc]
} 0
test util-5.19 {Tcl_StringMatch: UTF-8} {
# pattern += Tcl_UtfToUniChar(pattern, &endChar);
# proper advance.
Wrapper_Tcl_StringMatch {a[a乏c]c} "acc"
} 1
test util-5.20 {Tcl_StringMatch} {
Wrapper_Tcl_StringMatch {a[xyz]c} abc
} 0
test util-5.21 {Tcl_StringMatch} {
Wrapper_Tcl_StringMatch {12[2-7]45} 12345
} 1
test util-5.22 {Tcl_StringMatch: UTF-8 range} {
Wrapper_Tcl_StringMatch "\[一-乏]" "0"
} 0
test util-5.23 {Tcl_StringMatch: UTF-8 range} {
Wrapper_Tcl_StringMatch "\[一-乏]" "丳"
} 1
test util-5.24 {Tcl_StringMatch: UTF-8 range} {
Wrapper_Tcl_StringMatch "\[一-乏]" "("
} 0
test util-5.25 {Tcl_StringMatch} {
Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12345
} 1
test util-5.26 {Tcl_StringMatch} {
Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12b45
} 1
|
| ︙ | ︙ | |||
352 353 354 355 356 357 358 |
test util-5.40 {Tcl_StringMatch: skip correct number of ']'} {
Wrapper_Tcl_StringMatch {[A-]x} Ax
} 0
test util-5.41 {Tcl_StringMatch: skip correct number of ']'} {
Wrapper_Tcl_StringMatch {[A-]]x} Ax
} 1
test util-5.42 {Tcl_StringMatch: skip correct number of ']'} {
| | | | | 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 |
test util-5.40 {Tcl_StringMatch: skip correct number of ']'} {
Wrapper_Tcl_StringMatch {[A-]x} Ax
} 0
test util-5.41 {Tcl_StringMatch: skip correct number of ']'} {
Wrapper_Tcl_StringMatch {[A-]]x} Ax
} 1
test util-5.42 {Tcl_StringMatch: skip correct number of ']'} {
Wrapper_Tcl_StringMatch {[A-]]x} \xE1x
} 0
test util-5.43 {Tcl_StringMatch: skip correct number of ']'} {
Wrapper_Tcl_StringMatch \[A-]\xE1]x \xE1x
} 1
test util-5.44 {Tcl_StringMatch: skip correct number of ']'} {
Wrapper_Tcl_StringMatch {[A-]h]x} hx
} 1
test util-5.45 {Tcl_StringMatch} {
# if (*pattern == '\x00')
# badly formed pattern, still treats as a set
Wrapper_Tcl_StringMatch {[a} a
} 1
test util-5.46 {Tcl_StringMatch} {
Wrapper_Tcl_StringMatch {a\*b} a*b
} 1
test util-5.47 {Tcl_StringMatch} {
|
| ︙ | ︙ | |||
384 385 386 387 388 389 390 |
test util-5.50 {Tcl_StringMatch} {
Wrapper_Tcl_StringMatch *. ""
} 0
test util-5.51 {Tcl_StringMatch} {
Wrapper_Tcl_StringMatch "" ""
} 1
test util-5.52 {Tcl_StringMatch} {
| | | 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 |
test util-5.50 {Tcl_StringMatch} {
Wrapper_Tcl_StringMatch *. ""
} 0
test util-5.51 {Tcl_StringMatch} {
Wrapper_Tcl_StringMatch "" ""
} 1
test util-5.52 {Tcl_StringMatch} {
Wrapper_Tcl_StringMatch \[a\x00 a\x80
} 0
test util-6.1 {Tcl_PrintDouble - using tcl_precision} -constraints precision -setup {
set old_precision $::tcl_precision
set ::tcl_precision 12
} -body {
|
| ︙ | ︙ | |||
479 480 481 482 483 484 485 |
test util-8.1 {TclNeedSpace - correct utf-8 handling} {
# Bug 411825
# Note that this test relies on the fact that
# [interp target] calls on Tcl_AppendElement()
# which calls on TclNeedSpace(). If [interp target]
# is ever updated, this test will no longer test
# TclNeedSpace.
| | | | | | | | | 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 |
test util-8.1 {TclNeedSpace - correct utf-8 handling} {
# Bug 411825
# Note that this test relies on the fact that
# [interp target] calls on Tcl_AppendElement()
# which calls on TclNeedSpace(). If [interp target]
# is ever updated, this test will no longer test
# TclNeedSpace.
interp create 吠
interp create [list 吠 foo]
interp alias {} fooset [list 吠 foo] set
set result [interp target {} fooset]
interp delete 吠
set result
} "吠 foo"
test util-8.2 {TclNeedSpace - correct utf-8 handling} testdstring {
# Bug 411825
# This tests the same bug as the previous test, but
# should be more future-proof, as the DString
# operations will likely continue to call TclNeedSpace
testdstring free
testdstring append 吠 -1
testdstring element foo
llength [testdstring get]
} 2
test util-8.3 {TclNeedSpace - correct utf-8 handling} testdstring {
# Bug 411825 - new variant reported by Dossy Shiobara
testdstring free
testdstring append \xA0 -1
testdstring element foo
llength [testdstring get]
} 2
test util-8.4 {TclNeedSpace - correct utf-8 handling} testdstring {
# Another bug uncovered while fixing 411825
testdstring free
testdstring append {\ } -1
|
| ︙ | ︙ |
Changes to tests/var.test.
| ︙ | ︙ | |||
199 200 201 202 203 204 205 |
set result
}
} -result {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
test var-1.19 {TclLookupVar, right error message when parsing variable name} -body {
[format set] thisvar(doesntexist)
} -returnCodes error -result {can't read "thisvar(doesntexist)": no such variable}
test var-1.20 {TclLookupVar, regression on utf-8 variable names} -setup {
| | | | | | | | | | 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 |
set result
}
} -result {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
test var-1.19 {TclLookupVar, right error message when parsing variable name} -body {
[format set] thisvar(doesntexist)
} -returnCodes error -result {can't read "thisvar(doesntexist)": no such variable}
test var-1.20 {TclLookupVar, regression on utf-8 variable names} -setup {
proc p [list € ä] {info vars}
} -body {
# test variable with non-ascii name is available (euro and a-uml chars here):
list \
[p 1 2] \
[apply [list [list € ä] {info vars}] 1 2] \
[apply [list [list [list € €] [list ä ä]] {info vars}]] \
} -cleanup {
rename p {}
} -result [lrepeat 3 [list € ä]]
test var-1.21 {TclLookupVar, regression on utf-8 variable names} -setup {
proc p [list [list € v€] [list ä vä]] {list [set €] [set ä]}
} -body {
# test variable with non-ascii name (and default) is resolvable (euro and a-uml chars here):
list \
[p] \
[apply [list [list € ä] {list [set €] [set ä]}] v€ vä] \
[apply [list [list [list € v€] [list ä vä]] {list [set €] [set ä]}]] \
} -cleanup {
rename p {}
} -result [lrepeat 3 [list v€ vä]]
test var-2.1 {Tcl_LappendObjCmd, create var if new} {
catch {unset x}
lappend x 1 2
} {1 2}
test var-3.1 {MakeUpvar, TCL_NAMESPACE_ONLY not specified for other var} -setup {
|
| ︙ | ︙ | |||
1034 1035 1036 1037 1038 1039 1040 |
set end [getbytes]
}
set leakedBytes [expr {$end - $tmp}]
} -cleanup {
array unset A
rename doit {}
} -result 0
| | | 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 |
set end [getbytes]
}
set leakedBytes [expr {$end - $tmp}]
} -cleanup {
array unset A
rename doit {}
} -result 0
test var-22.1 {leak in localVarName internalrep: Bug 80304238ac} -setup {
proc doit {} {
interp create child
child eval {
proc doit script {
eval $script
set foo bar
}
|
| ︙ | ︙ |
Changes to tests/winDde.test.
| ︙ | ︙ | |||
9 10 11 12 13 14 15 16 |
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
| > < | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 |
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
package require tcltests
testConstraint dde 0
if {[testConstraint win]} {
if {![catch {
::tcltest::loadTestedCommands
set ::ddever [package require dde 1.4.4]
set ::ddelib [info loaded {} Dde]}]} {
testConstraint dde 1
|
| ︙ | ︙ | |||
33 34 35 36 37 38 39 40 41 42 43 44 45 46 |
set scriptName [makeFile {} script1.tcl]
proc createChildProcess {ddeServerName args} {
file delete -force $::scriptName
set f [open $::scriptName w+]
puts $f [list set ddeServerName $ddeServerName]
puts $f [list load $::ddelib Dde]
puts $f {
# DDE child server -
#
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
| > | 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 |
set scriptName [makeFile {} script1.tcl]
proc createChildProcess {ddeServerName args} {
file delete -force $::scriptName
set f [open $::scriptName w+]
fconfigure $f -encoding utf-8
puts $f [list set ddeServerName $ddeServerName]
puts $f [list load $::ddelib Dde]
puts $f {
# DDE child server -
#
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
|
| ︙ | ︙ | |||
92 93 94 95 96 97 98 |
vwait reallyDone
exit
}
close $f
# run the child server script.
set f [open |[list [interpreter] $::scriptName] r]
| | | 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 |
vwait reallyDone
exit
}
close $f
# run the child server script.
set f [open |[list [interpreter] $::scriptName] r]
fconfigure $f -buffering line -encoding utf-8
gets $f line
return $f
}
# -------------------------------------------------------------------------
test winDde-1.0 {check if we are testing the right dll} {win dde} {
set ::ddever
|
| ︙ | ︙ |
Changes to tests/winFCmd.test.
| ︙ | ︙ | |||
25 26 27 28 29 30 31 |
testConstraint testchmod [llength [info commands testchmod]]
testConstraint cdrom 0
testConstraint exdev 0
testConstraint longFileNames 0
# Some things fail under all Continuous Integration systems for subtle reasons
# such as CI often running with elevated privileges in a container.
testConstraint notInCIenv [expr {![info exists ::env(CI)]}]
| | | 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 |
testConstraint testchmod [llength [info commands testchmod]]
testConstraint cdrom 0
testConstraint exdev 0
testConstraint longFileNames 0
# Some things fail under all Continuous Integration systems for subtle reasons
# such as CI often running with elevated privileges in a container.
testConstraint notInCIenv [expr {![info exists ::env(CI)]}]
testConstraint knownMsvcBug [expr {![string match msvc-* [tcl::build-info compiler]]}]
proc createfile {file {string a}} {
set f [open $file w]
puts -nonewline $f $string
close $f
return $string
}
|
| ︙ | ︙ |
Changes to tests/winPipe.test.
| ︙ | ︙ | |||
170 171 172 173 174 175 176 |
catch {close $f} msg
list [contents $path(stdout)] $msg
} {foo stderr32}
test winpipe-1.21 {32 bit comprehensive tests: read/write application} \
{win exec cat32} {
set f [open "|[list $cat32]" r+]
puts $f $big
| | | 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 |
catch {close $f} msg
list [contents $path(stdout)] $msg
} {foo stderr32}
test winpipe-1.21 {32 bit comprehensive tests: read/write application} \
{win exec cat32} {
set f [open "|[list $cat32]" r+]
puts $f $big
puts $f \x1A
flush $f
set r [read $f 64]
catch {close $f}
set r
} "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
test winpipe-4.1 {Tcl_WaitPid} {win exec cat32} {
|
| ︙ | ︙ |
Changes to tests/zipfs.test.
| ︙ | ︙ | |||
268 269 270 271 272 273 274 |
zipfs mkzip
}
} -returnCodes error -cleanup {
interp delete $safe
} -result {not allowed to invoke subcommand mkzip of zipfs}
test zipfs-4.1 {zipfs lmkimg} -constraints zipfs -setup {
| | | | 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 |
zipfs mkzip
}
} -returnCodes error -cleanup {
interp delete $safe
} -result {not allowed to invoke subcommand mkzip of zipfs}
test zipfs-4.1 {zipfs lmkimg} -constraints zipfs -setup {
set baseImage [makeFile "return sourceWorking\n\x1A" base]
set targetImage [makeFile "" target]
set addFile [makeFile "return mountWorking" add.data]
file delete $targetImage
} -body {
zipfs lmkimg $targetImage [list $addFile test/add.tcl] {} $baseImage
zipfs mount ziptest $targetImage
try {
list [source $targetImage] [source //zipfs:/ziptest/test/add.tcl]
} finally {
zipfs unmount ziptest
}
} -cleanup {
removeFile $baseImage
removeFile $targetImage
removeFile $addFile
} -result {sourceWorking mountWorking}
test zipfs-4.2 {zipfs lmkimg: making an image from an image} -constraints zipfs -setup {
set baseImage [makeFile "return sourceWorking\n\x1A" base_image.tcl]
set midImage [makeFile "" mid_image.tcl]
set targetImage [makeFile "" target_image.tcl]
set addFile [makeFile "return mountWorking" add.data]
file delete $midImage $targetImage
} -body {
zipfs lmkimg $midImage [list $addFile test/ko.tcl] {} $baseImage
zipfs lmkimg $targetImage [list $addFile test/ok.tcl] {} $midImage
|
| ︙ | ︙ | |||
312 313 314 315 316 317 318 |
} -cleanup {
removeFile $baseImage
removeFile $midImage
removeFile $targetImage
removeFile $addFile
} -result {ok.tcl equal}
test zipfs-4.3 {zipfs lmkimg: stripping password} -constraints zipfs -setup {
| | | 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 |
} -cleanup {
removeFile $baseImage
removeFile $midImage
removeFile $targetImage
removeFile $addFile
} -result {ok.tcl equal}
test zipfs-4.3 {zipfs lmkimg: stripping password} -constraints zipfs -setup {
set baseImage [makeFile "return sourceWorking\n\x1A" base_image.tcl]
set midImage [makeFile "" mid_image.tcl]
set targetImage [makeFile "" target_image.tcl]
set addFile [makeFile "return mountWorking" add.data]
file delete $midImage $targetImage
} -body {
set pass gorp
zipfs lmkimg $midImage [list $addFile test/add.tcl] $pass $baseImage
|
| ︙ | ︙ | |||
334 335 336 337 338 339 340 |
} -cleanup {
removeFile $baseImage
removeFile $midImage
removeFile $targetImage
removeFile $addFile
} -result {ok.tcl}
test zipfs-4.4 {zipfs lmkimg: final password} -constraints zipfs -setup {
| | | 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 |
} -cleanup {
removeFile $baseImage
removeFile $midImage
removeFile $targetImage
removeFile $addFile
} -result {ok.tcl}
test zipfs-4.4 {zipfs lmkimg: final password} -constraints zipfs -setup {
set baseImage [makeFile "return sourceWorking\n\x1A" base_image.tcl]
set midImage [makeFile "" mid_image.tcl]
set targetImage [makeFile "" target_image.tcl]
set addFile [makeFile "return mountWorking" add.data]
file delete $midImage $targetImage
} -body {
set pass gorp
zipfs lmkimg $midImage [list $addFile test/add.tcl] {} $baseImage
|
| ︙ | ︙ | |||
356 357 358 359 360 361 362 |
} -cleanup {
removeFile $baseImage
removeFile $midImage
removeFile $targetImage
removeFile $addFile
} -result {ok.tcl}
test zipfs-4.5 {zipfs lmkimg: making image from mounted} -constraints zipfs -setup {
| | | 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 |
} -cleanup {
removeFile $baseImage
removeFile $midImage
removeFile $targetImage
removeFile $addFile
} -result {ok.tcl}
test zipfs-4.5 {zipfs lmkimg: making image from mounted} -constraints zipfs -setup {
set baseImage [makeFile "return sourceWorking\n\x1A" base_image.tcl]
set midImage [makeFile "" mid_image.tcl]
set targetImage [makeFile "" target_image.tcl]
set addFile [makeFile "return mountWorking" add.data]
file delete $midImage $targetImage
} -body {
zipfs lmkimg $midImage [list $addFile test/add.tcl] {} $baseImage
zipfs mount ziptest $midImage
|
| ︙ | ︙ |
Changes to tools/checkLibraryDoc.tcl.
| ︙ | ︙ | |||
12 13 14 15 16 17 18 | # 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. # | | | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 |
# 5) Command APIs (e.g., Tcl_ArrayObjCmd.)
# 6) Proc pointers (e.g., Tcl_CloseProc.)
#
# Note: Each list is "a best guess" approximation. If developers write
# non-standard code, this script will produce erroneous results. Each
# list should be carefully checked for accuracy.
#
# Copyright © 1998-1999 Scriptics Corporation.
# All rights reserved.
lappend auto_path "c:/program\ files/tclpro1.2/win32-ix86/bin"
#lappend auto_path "/home/surles/cvs/tclx8.0/tcl/unix"
if {[catch {package require Tclx}]} {
puts "error: could not load TclX. Please set TCL_LIBRARY."
|
| ︙ | ︙ |
Changes to tools/encoding/big5.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 27 28 29 | # BIG5.TXT # Date: 2015-12-02 23:52:00 GMT [KW] # © 2015 Unicode®, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Name: BIG5 to Unicode table (complete) # Unicode version: 1.1 # Table version: 2.0 # Table format: Format A # Date: 2011 October 14 (header updated: 2015 December 02) # # General notes: # # NOTE: this table has been modified to include the 7-bit ASCII # characters that are allowed in BIG5 files. # # This table contains one set of mappings from BIG5 into Unicode. # Note that these data are *possible* mappings only and may not be the # same as those used by actual products, nor may they be the best suited # for all uses. For more information on the mappings between various code # pages incorporating the repertoire of BIG5 and Unicode, consult the # VENDORS mapping data. # # WARNING! It is currently impossible to provide round-trip compatibility # between BIG5 and Unicode. # # A number of characters are not currently mapped because # of conflicts with other mappings. They are as follows: # |
| ︙ | ︙ | |||
60 61 62 63 64 65 66 | # It is also possible to map these characters to their duplicates, or to # the user zone. # # Notes: # # 1. In addition to the above, there is some uncertainty about the # mappings in the range C6A1 - C8FE, and F9DD - F9FE. The ETEN | | | | | | | | | | | | < < | | | | | | | > > > > > > > > | > > > > > > | 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 | # It is also possible to map these characters to their duplicates, or to # the user zone. # # Notes: # # 1. In addition to the above, there is some uncertainty about the # mappings in the range C6A1 - C8FE, and F9DD - F9FE. The ETEN # version of BIG5 organizes the former range differently, and adds # additional characters in the latter range. The correct mappings # these ranges need to be determined. # # 2. There is an uncertainty in the mapping of the Big Five character # 0xA3BC. This character occurs within the Big Five block of tone marks # for bopomofo and is intended to be the tone mark for the first tone in # Mandarin Chinese. We have selected the mapping U+02C9 MODIFIER LETTER # MACRON (Mandarin Chinese first tone) to reflect this semantic. # However, because bopomofo uses the absense of a tone mark to indicate # the first Mandarin tone, most implementations of Big Five represent # this character with a blank space, and so a mapping such as U+2003 EM # SPACE might be preferred. # # Format: Three tab-separated columns # Column #1 is the BIG5 code (in hex as 0xXXXX) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 is the Unicode name (follows a comment sign, '#') # The official names for Unicode characters U+4E00 # to U+9FA5, inclusive, is "CJK UNIFIED IDEOGRAPH-XXXX", # where XXXX is the code point. Including all these # names in this file increases its size substantially # and needlessly. The token "<CJK>" is used for the # name of these characters. If necessary, it can be # expanded algorithmically by a parser or editor. # # The entries are in BIG5 order # # Revision History: # # [v2.0, 2015 December 02] # updates to copyright notice and terms of use # no changes to character mappings # # [v1.0, 2011 October 14] # Updated terms of use to current wording. # Updated contact information. # No changes to the mapping data. # # [v0.0d3, 11 February 1994] # First release. # # Use the Unicode reporting form <http://www.unicode.org/reporting.html> # for any questions or comments or to report errors in the data. # 0x20 0x0020 # SPACE 0x21 0x0021 # EXCLAMATION MARK 0x22 0x0022 # QUOTATION MARK 0x23 0x0023 # NUMBER SIGN 0x24 0x0024 # DOLLAR SIGN 0x25 0x0025 # PERCENT SIGN |
| ︙ | ︙ |
Added tools/encoding/cns11643.txt.
more than 10,000 changes
Changes to tools/encoding/cp1250.txt.
1 2 3 4 5 6 7 | # # Name: cp1250 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 04/15/98 # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # # Name: cp1250 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 04/15/98 # # Contact: Shawn.Steele@microsoft.com # # General notes: none # # Format: Three tab-separated columns # Column #1 is the cp1250 code (in hex) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 is the Unicode name (follows a comment sign, '#') |
| ︙ | ︙ |
Changes to tools/encoding/cp1251.txt.
1 2 3 4 5 6 7 | # # Name: cp1251 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 04/15/98 # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # # Name: cp1251 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 04/15/98 # # Contact: Shawn.Steele@microsoft.com # # General notes: none # # Format: Three tab-separated columns # Column #1 is the cp1251 code (in hex) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 is the Unicode name (follows a comment sign, '#') |
| ︙ | ︙ |
Changes to tools/encoding/cp1252.txt.
1 2 3 4 5 6 7 | # # Name: cp1252 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 04/15/98 # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # # Name: cp1252 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 04/15/98 # # Contact: Shawn.Steele@microsoft.com # # General notes: none # # Format: Three tab-separated columns # Column #1 is the cp1252 code (in hex) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 is the Unicode name (follows a comment sign, '#') |
| ︙ | ︙ |
Changes to tools/encoding/cp1253.txt.
1 2 3 4 5 6 7 | # # Name: cp1253 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 04/15/98 # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # # Name: cp1253 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 04/15/98 # # Contact: Shawn.Steele@microsoft.com # # General notes: none # # Format: Three tab-separated columns # Column #1 is the cp1253 code (in hex) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 is the Unicode name (follows a comment sign, '#') |
| ︙ | ︙ |
Changes to tools/encoding/cp1254.txt.
1 2 3 4 5 6 7 | # # Name: cp1254 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 04/15/98 # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # # Name: cp1254 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 04/15/98 # # Contact: Shawn.Steele@microsoft.com # # General notes: none # # Format: Three tab-separated columns # Column #1 is the cp1254 code (in hex) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 is the Unicode name (follows a comment sign, '#') |
| ︙ | ︙ |
Changes to tools/encoding/cp1255.txt.
1 2 3 4 5 6 7 | # # Name: cp1255 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 1/7/2000 # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # # Name: cp1255 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 1/7/2000 # # Contact: Shawn.Steele@microsoft.com # # General notes: none # # Format: Three tab-separated columns # Column #1 is the cp1255 code (in hex) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 is the Unicode name (follows a comment sign, '#') |
| ︙ | ︙ |
Changes to tools/encoding/cp1256.txt.
1 2 3 4 5 6 7 | # # Name: cp1256 to Unicode table # Unicode version: 2.1 # Table version: 2.01 # Table format: Format A # Date: 01/5/99 # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # # Name: cp1256 to Unicode table # Unicode version: 2.1 # Table version: 2.01 # Table format: Format A # Date: 01/5/99 # # Contact: Shawn.Steele@microsoft.com # # General notes: none # # Format: Three tab-separated columns # Column #1 is the cp1256 code (in hex) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 is the Unicode name (follows a comment sign, '#') |
| ︙ | ︙ |
Changes to tools/encoding/cp1257.txt.
1 2 3 4 5 6 7 | # # Name: cp1257 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 04/15/98 # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # # Name: cp1257 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 04/15/98 # # Contact: Shawn.Steele@microsoft.com # # General notes: none # # Format: Three tab-separated columns # Column #1 is the cp1257 code (in hex) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 is the Unicode name (follows a comment sign, '#') |
| ︙ | ︙ |
Changes to tools/encoding/cp1258.txt.
1 2 3 4 5 6 7 | # # Name: cp1258 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 04/15/98 # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # # Name: cp1258 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 04/15/98 # # Contact: Shawn.Steele@microsoft.com # # General notes: none # # Format: Three tab-separated columns # Column #1 is the cp1258 code (in hex) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 is the Unicode name (follows a comment sign, '#') |
| ︙ | ︙ |
Changes to tools/encoding/cp874.txt.
1 2 3 4 5 6 7 | # # Name: cp874 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 02/28/98 # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # # Name: cp874 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 02/28/98 # # Contact: Shawn.Steele@microsoft.com # # General notes: none # # Format: Three tab-separated columns # Column #1 is the cp874 code (in hex) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 is the Unicode name (follows a comment sign, '#') |
| ︙ | ︙ |
Changes to tools/encoding/cp932.txt.
1 2 3 4 5 6 7 | # # Name: cp932 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 04/15/98 # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # # Name: cp932 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 04/15/98 # # Contact: Shawn.Steele@microsoft.com # # General notes: none # # Format: Three tab-separated columns # Column #1 is the cp932 code (in hex) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 is the Unicode name (follows a comment sign, '#') |
| ︙ | ︙ |
Changes to tools/encoding/cp936.txt.
1 2 3 4 5 6 7 | # # Name: cp936 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 1/7/2000 # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # # Name: cp936 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 1/7/2000 # # Contact: Shawn.Steele@microsoft.com # # General notes: none # # Format: Three tab-separated columns # Column #1 is the cp936 code (in hex) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 is the Unicode name (follows a comment sign, '#') |
| ︙ | ︙ |
Changes to tools/encoding/cp949.txt.
1 2 3 4 5 6 7 | # # Name: cp949 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 1/7/2000 # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # # Name: cp949 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 1/7/2000 # # Contact: Shawn.Steele@microsoft.com # # General notes: none # # Format: Three tab-separated columns # Column #1 is the cp949 code (in hex) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 is the Unicode name (follows a comment sign, '#') |
| ︙ | ︙ |
Changes to tools/encoding/cp950.txt.
1 2 3 4 5 6 7 | # # Name: cp950 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 1/7/2000 # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | # # Name: cp950 to Unicode table # Unicode version: 2.0 # Table version: 2.01 # Table format: Format A # Date: 1/7/2000 # # Contact: Shawn.Steele@microsoft.com # # General notes: none # # Format: Three tab-separated columns # Column #1 is the cp950 code (in hex) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 is the Unicode name (follows a comment sign, '#') |
| ︙ | ︙ |
Changes to tools/encoding/iso8859-1.txt.
1 2 3 | # # Name: ISO/IEC 8859-1:1998 to Unicode # Unicode version: 3.0 | > > > > | | | < < < < < < < < < < < < < < < < | | > > | | | < | 1 2 3 4 5 6 7 8 9 10 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 | # 8859-1.TXT # Date: 2015-12-02 20:19:00 GMT [KW] # © 2015 Unicode®, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Name: ISO/IEC 8859-1:1998 to Unicode # Unicode version: 3.0 # Table version: 2.0 # Table format: Format A # Date: 1999 July 27 (header updated: 2015 December 02) # Authors: Ken Whistler <ken@unicode.org> # # General notes: # # This table contains the data the Unicode Consortium has on how # ISO/IEC 8859-1:1998 characters map into Unicode. # # Format: Three tab-separated columns # Column #1 is the ISO/IEC 8859-1 code (in hex as 0xXX) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 the Unicode name (follows a comment sign, '#') # # The entries are in ISO/IEC 8859-1 order. # # Version history # 1.0 version: updates 0.1 version by adding mappings for all # control characters. # 2.0 version: updates to copyright notice and terms of use; no # changes to character mappings # # Updated versions of this file may be found in: # http://www.unicode.org/Public/MAPPINGS/ # # Any comments or problems, contact us at: # http://www.unicode.org/reporting.html # 0x00 0x0000 # NULL 0x01 0x0001 # START OF HEADING 0x02 0x0002 # START OF TEXT 0x03 0x0003 # END OF TEXT 0x04 0x0004 # END OF TRANSMISSION 0x05 0x0005 # ENQUIRY |
| ︙ | ︙ |
Changes to tools/encoding/iso8859-10.txt.
1 2 3 | # # Name: ISO/IEC 8859-10:1998 to Unicode # Unicode version: 3.0 | > > > > | | | < < < < < < < < < < < < < < < < | > > | | | < | 1 2 3 4 5 6 7 8 9 10 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 | # 8859-10.TXT # Date: 2015-12-02 21:53:00 GMT [KW] # © 2015 Unicode®, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Name: ISO/IEC 8859-10:1998 to Unicode # Unicode version: 3.0 # Table version: 2.0 # Table format: Format A # Date: 1999 October 11 (header updated: 2015 December 02) # Authors: Ken Whistler <ken@unicode.org> # # General notes: # # This table contains the data the Unicode Consortium has on how # ISO/IEC 8859-10:1998 characters map into Unicode. # # Format: Three tab-separated columns # Column #1 is the ISO/IEC 8859-10 code (in hex as 0xXX) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 the Unicode name (follows a comment sign, '#') # # The entries are in ISO/IEC 8859-10 order. # # Version history # 1.0 version new. # 1.1 corrected mistake in mapping of 0xA4 # 2.0 version: updates to copyright notice and terms of use; no # changes to character mappings # # Updated versions of this file may be found in: # http://www.unicode.org/Public/MAPPINGS/ # # Any comments or problems, contact us at: # http://www.unicode.org/reporting.html # 0x00 0x0000 # NULL 0x01 0x0001 # START OF HEADING 0x02 0x0002 # START OF TEXT 0x03 0x0003 # END OF TEXT 0x04 0x0004 # END OF TRANSMISSION 0x05 0x0005 # ENQUIRY |
| ︙ | ︙ |
Added tools/encoding/iso8859-11.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 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 | # 8859-11.TXT # Date: 2015-12-02 21:55:00 GMT [KW] # © 2015 Unicode®, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Name: ISO/IEC 8859-11:2001 to Unicode # Unicode version: 3.2 # Table version: 2.0 # Table format: Format A # Date: 2002 October 7 (header updated: 2015 December 02) # Authors: Ken Whistler <ken@unicode.org> # # General notes: # # This table contains the data the Unicode Consortium has on how # ISO/IEC 8859-11:2001 characters map into Unicode. # # ISO/IEC 8859-11:2001 is equivalent to TIS 620-2533 (1990) with # the addition of 0xA0 NO-BREAK SPACE. # # Format: Three tab-separated columns # Column #1 is the ISO/IEC 8859-11 code (in hex as 0xXX) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 the Unicode name (follows a comment sign, '#') # # The entries are in ISO/IEC 8859-11 order. # # Version history: # 2002 October 7 Created # 2.0 version: updates to copyright notice and terms of use; no # changes to character mappings # # Updated versions of this file may be found in: # http://www.unicode.org/Public/MAPPINGS/ # # Any comments or problems, contact us at: # http://www.unicode.org/reporting.html # 0x00 0x0000 # NULL 0x01 0x0001 # START OF HEADING 0x02 0x0002 # START OF TEXT 0x03 0x0003 # END OF TEXT 0x04 0x0004 # END OF TRANSMISSION 0x05 0x0005 # ENQUIRY 0x06 0x0006 # ACKNOWLEDGE 0x07 0x0007 # BELL 0x08 0x0008 # BACKSPACE 0x09 0x0009 # HORIZONTAL TABULATION 0x0A 0x000A # LINE FEED 0x0B 0x000B # VERTICAL TABULATION 0x0C 0x000C # FORM FEED 0x0D 0x000D # CARRIAGE RETURN 0x0E 0x000E # SHIFT OUT 0x0F 0x000F # SHIFT IN 0x10 0x0010 # DATA LINK ESCAPE 0x11 0x0011 # DEVICE CONTROL ONE 0x12 0x0012 # DEVICE CONTROL TWO 0x13 0x0013 # DEVICE CONTROL THREE 0x14 0x0014 # DEVICE CONTROL FOUR 0x15 0x0015 # NEGATIVE ACKNOWLEDGE 0x16 0x0016 # SYNCHRONOUS IDLE 0x17 0x0017 # END OF TRANSMISSION BLOCK 0x18 0x0018 # CANCEL 0x19 0x0019 # END OF MEDIUM 0x1A 0x001A # SUBSTITUTE 0x1B 0x001B # ESCAPE 0x1C 0x001C # FILE SEPARATOR 0x1D 0x001D # GROUP SEPARATOR 0x1E 0x001E # RECORD SEPARATOR 0x1F 0x001F # UNIT SEPARATOR 0x20 0x0020 # SPACE 0x21 0x0021 # EXCLAMATION MARK 0x22 0x0022 # QUOTATION MARK 0x23 0x0023 # NUMBER SIGN 0x24 0x0024 # DOLLAR SIGN 0x25 0x0025 # PERCENT SIGN 0x26 0x0026 # AMPERSAND 0x27 0x0027 # APOSTROPHE 0x28 0x0028 # LEFT PARENTHESIS 0x29 0x0029 # RIGHT PARENTHESIS 0x2A 0x002A # ASTERISK 0x2B 0x002B # PLUS SIGN 0x2C 0x002C # COMMA 0x2D 0x002D # HYPHEN-MINUS 0x2E 0x002E # FULL STOP 0x2F 0x002F # SOLIDUS 0x30 0x0030 # DIGIT ZERO 0x31 0x0031 # DIGIT ONE 0x32 0x0032 # DIGIT TWO 0x33 0x0033 # DIGIT THREE 0x34 0x0034 # DIGIT FOUR 0x35 0x0035 # DIGIT FIVE 0x36 0x0036 # DIGIT SIX 0x37 0x0037 # DIGIT SEVEN 0x38 0x0038 # DIGIT EIGHT 0x39 0x0039 # DIGIT NINE 0x3A 0x003A # COLON 0x3B 0x003B # SEMICOLON 0x3C 0x003C # LESS-THAN SIGN 0x3D 0x003D # EQUALS SIGN 0x3E 0x003E # GREATER-THAN SIGN 0x3F 0x003F # QUESTION MARK 0x40 0x0040 # COMMERCIAL AT 0x41 0x0041 # LATIN CAPITAL LETTER A 0x42 0x0042 # LATIN CAPITAL LETTER B 0x43 0x0043 # LATIN CAPITAL LETTER C 0x44 0x0044 # LATIN CAPITAL LETTER D 0x45 0x0045 # LATIN CAPITAL LETTER E 0x46 0x0046 # LATIN CAPITAL LETTER F 0x47 0x0047 # LATIN CAPITAL LETTER G 0x48 0x0048 # LATIN CAPITAL LETTER H 0x49 0x0049 # LATIN CAPITAL LETTER I 0x4A 0x004A # LATIN CAPITAL LETTER J 0x4B 0x004B # LATIN CAPITAL LETTER K 0x4C 0x004C # LATIN CAPITAL LETTER L 0x4D 0x004D # LATIN CAPITAL LETTER M 0x4E 0x004E # LATIN CAPITAL LETTER N 0x4F 0x004F # LATIN CAPITAL LETTER O 0x50 0x0050 # LATIN CAPITAL LETTER P 0x51 0x0051 # LATIN CAPITAL LETTER Q 0x52 0x0052 # LATIN CAPITAL LETTER R 0x53 0x0053 # LATIN CAPITAL LETTER S 0x54 0x0054 # LATIN CAPITAL LETTER T 0x55 0x0055 # LATIN CAPITAL LETTER U 0x56 0x0056 # LATIN CAPITAL LETTER V 0x57 0x0057 # LATIN CAPITAL LETTER W 0x58 0x0058 # LATIN CAPITAL LETTER X 0x59 0x0059 # LATIN CAPITAL LETTER Y 0x5A 0x005A # LATIN CAPITAL LETTER Z 0x5B 0x005B # LEFT SQUARE BRACKET 0x5C 0x005C # REVERSE SOLIDUS 0x5D 0x005D # RIGHT SQUARE BRACKET 0x5E 0x005E # CIRCUMFLEX ACCENT 0x5F 0x005F # LOW LINE 0x60 0x0060 # GRAVE ACCENT 0x61 0x0061 # LATIN SMALL LETTER A 0x62 0x0062 # LATIN SMALL LETTER B 0x63 0x0063 # LATIN SMALL LETTER C 0x64 0x0064 # LATIN SMALL LETTER D 0x65 0x0065 # LATIN SMALL LETTER E 0x66 0x0066 # LATIN SMALL LETTER F 0x67 0x0067 # LATIN SMALL LETTER G 0x68 0x0068 # LATIN SMALL LETTER H 0x69 0x0069 # LATIN SMALL LETTER I 0x6A 0x006A # LATIN SMALL LETTER J 0x6B 0x006B # LATIN SMALL LETTER K 0x6C 0x006C # LATIN SMALL LETTER L 0x6D 0x006D # LATIN SMALL LETTER M 0x6E 0x006E # LATIN SMALL LETTER N 0x6F 0x006F # LATIN SMALL LETTER O 0x70 0x0070 # LATIN SMALL LETTER P 0x71 0x0071 # LATIN SMALL LETTER Q 0x72 0x0072 # LATIN SMALL LETTER R 0x73 0x0073 # LATIN SMALL LETTER S 0x74 0x0074 # LATIN SMALL LETTER T 0x75 0x0075 # LATIN SMALL LETTER U 0x76 0x0076 # LATIN SMALL LETTER V 0x77 0x0077 # LATIN SMALL LETTER W 0x78 0x0078 # LATIN SMALL LETTER X 0x79 0x0079 # LATIN SMALL LETTER Y 0x7A 0x007A # LATIN SMALL LETTER Z 0x7B 0x007B # LEFT CURLY BRACKET 0x7C 0x007C # VERTICAL LINE 0x7D 0x007D # RIGHT CURLY BRACKET 0x7E 0x007E # TILDE 0x7F 0x007F # DELETE 0x80 0x0080 # <control> 0x81 0x0081 # <control> 0x82 0x0082 # <control> 0x83 0x0083 # <control> 0x84 0x0084 # <control> 0x85 0x0085 # <control> 0x86 0x0086 # <control> 0x87 0x0087 # <control> 0x88 0x0088 # <control> 0x89 0x0089 # <control> 0x8A 0x008A # <control> 0x8B 0x008B # <control> 0x8C 0x008C # <control> 0x8D 0x008D # <control> 0x8E 0x008E # <control> 0x8F 0x008F # <control> 0x90 0x0090 # <control> 0x91 0x0091 # <control> 0x92 0x0092 # <control> 0x93 0x0093 # <control> 0x94 0x0094 # <control> 0x95 0x0095 # <control> 0x96 0x0096 # <control> 0x97 0x0097 # <control> 0x98 0x0098 # <control> 0x99 0x0099 # <control> 0x9A 0x009A # <control> 0x9B 0x009B # <control> 0x9C 0x009C # <control> 0x9D 0x009D # <control> 0x9E 0x009E # <control> 0x9F 0x009F # <control> 0xA0 0x00A0 # NO-BREAK SPACE 0xA1 0x0E01 # THAI CHARACTER KO KAI 0xA2 0x0E02 # THAI CHARACTER KHO KHAI 0xA3 0x0E03 # THAI CHARACTER KHO KHUAT 0xA4 0x0E04 # THAI CHARACTER KHO KHWAI 0xA5 0x0E05 # THAI CHARACTER KHO KHON 0xA6 0x0E06 # THAI CHARACTER KHO RAKHANG 0xA7 0x0E07 # THAI CHARACTER NGO NGU 0xA8 0x0E08 # THAI CHARACTER CHO CHAN 0xA9 0x0E09 # THAI CHARACTER CHO CHING 0xAA 0x0E0A # THAI CHARACTER CHO CHANG 0xAB 0x0E0B # THAI CHARACTER SO SO 0xAC 0x0E0C # THAI CHARACTER CHO CHOE 0xAD 0x0E0D # THAI CHARACTER YO YING 0xAE 0x0E0E # THAI CHARACTER DO CHADA 0xAF 0x0E0F # THAI CHARACTER TO PATAK 0xB0 0x0E10 # THAI CHARACTER THO THAN 0xB1 0x0E11 # THAI CHARACTER THO NANGMONTHO 0xB2 0x0E12 # THAI CHARACTER THO PHUTHAO 0xB3 0x0E13 # THAI CHARACTER NO NEN 0xB4 0x0E14 # THAI CHARACTER DO DEK 0xB5 0x0E15 # THAI CHARACTER TO TAO 0xB6 0x0E16 # THAI CHARACTER THO THUNG 0xB7 0x0E17 # THAI CHARACTER THO THAHAN 0xB8 0x0E18 # THAI CHARACTER THO THONG 0xB9 0x0E19 # THAI CHARACTER NO NU 0xBA 0x0E1A # THAI CHARACTER BO BAIMAI 0xBB 0x0E1B # THAI CHARACTER PO PLA 0xBC 0x0E1C # THAI CHARACTER PHO PHUNG 0xBD 0x0E1D # THAI CHARACTER FO FA 0xBE 0x0E1E # THAI CHARACTER PHO PHAN 0xBF 0x0E1F # THAI CHARACTER FO FAN 0xC0 0x0E20 # THAI CHARACTER PHO SAMPHAO 0xC1 0x0E21 # THAI CHARACTER MO MA 0xC2 0x0E22 # THAI CHARACTER YO YAK 0xC3 0x0E23 # THAI CHARACTER RO RUA 0xC4 0x0E24 # THAI CHARACTER RU 0xC5 0x0E25 # THAI CHARACTER LO LING 0xC6 0x0E26 # THAI CHARACTER LU 0xC7 0x0E27 # THAI CHARACTER WO WAEN 0xC8 0x0E28 # THAI CHARACTER SO SALA 0xC9 0x0E29 # THAI CHARACTER SO RUSI 0xCA 0x0E2A # THAI CHARACTER SO SUA 0xCB 0x0E2B # THAI CHARACTER HO HIP 0xCC 0x0E2C # THAI CHARACTER LO CHULA 0xCD 0x0E2D # THAI CHARACTER O ANG 0xCE 0x0E2E # THAI CHARACTER HO NOKHUK 0xCF 0x0E2F # THAI CHARACTER PAIYANNOI 0xD0 0x0E30 # THAI CHARACTER SARA A 0xD1 0x0E31 # THAI CHARACTER MAI HAN-AKAT 0xD2 0x0E32 # THAI CHARACTER SARA AA 0xD3 0x0E33 # THAI CHARACTER SARA AM 0xD4 0x0E34 # THAI CHARACTER SARA I 0xD5 0x0E35 # THAI CHARACTER SARA II 0xD6 0x0E36 # THAI CHARACTER SARA UE 0xD7 0x0E37 # THAI CHARACTER SARA UEE 0xD8 0x0E38 # THAI CHARACTER SARA U 0xD9 0x0E39 # THAI CHARACTER SARA UU 0xDA 0x0E3A # THAI CHARACTER PHINTHU 0xDF 0x0E3F # THAI CURRENCY SYMBOL BAHT 0xE0 0x0E40 # THAI CHARACTER SARA E 0xE1 0x0E41 # THAI CHARACTER SARA AE 0xE2 0x0E42 # THAI CHARACTER SARA O 0xE3 0x0E43 # THAI CHARACTER SARA AI MAIMUAN 0xE4 0x0E44 # THAI CHARACTER SARA AI MAIMALAI 0xE5 0x0E45 # THAI CHARACTER LAKKHANGYAO 0xE6 0x0E46 # THAI CHARACTER MAIYAMOK 0xE7 0x0E47 # THAI CHARACTER MAITAIKHU 0xE8 0x0E48 # THAI CHARACTER MAI EK 0xE9 0x0E49 # THAI CHARACTER MAI THO 0xEA 0x0E4A # THAI CHARACTER MAI TRI 0xEB 0x0E4B # THAI CHARACTER MAI CHATTAWA 0xEC 0x0E4C # THAI CHARACTER THANTHAKHAT 0xED 0x0E4D # THAI CHARACTER NIKHAHIT 0xEE 0x0E4E # THAI CHARACTER YAMAKKAN 0xEF 0x0E4F # THAI CHARACTER FONGMAN 0xF0 0x0E50 # THAI DIGIT ZERO 0xF1 0x0E51 # THAI DIGIT ONE 0xF2 0x0E52 # THAI DIGIT TWO 0xF3 0x0E53 # THAI DIGIT THREE 0xF4 0x0E54 # THAI DIGIT FOUR 0xF5 0x0E55 # THAI DIGIT FIVE 0xF6 0x0E56 # THAI DIGIT SIX 0xF7 0x0E57 # THAI DIGIT SEVEN 0xF8 0x0E58 # THAI DIGIT EIGHT 0xF9 0x0E59 # THAI DIGIT NINE 0xFA 0x0E5A # THAI CHARACTER ANGKHANKHU 0xFB 0x0E5B # THAI CHARACTER KHOMUT |
Changes to tools/encoding/iso8859-13.txt.
1 2 3 | # # Name: ISO/IEC 8859-13:1998 to Unicode # Unicode version: 3.0 | > > > > | | | < < < < < < < < < < < < < < < < > > > > > | | | < | 1 2 3 4 5 6 7 8 9 10 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 | # 8859-13.TXT # Date: 2015-12-02 22:03:00 GMT [KW] # © 2015 Unicode®, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Name: ISO/IEC 8859-13:1998 to Unicode # Unicode version: 3.0 # Table version: 2.0 # Table format: Format A # Date: 1999 July 27 (header updated: 2015 December 02) # Authors: Ken Whistler <ken@unicode.org> # # General notes: # # This table contains the data the Unicode Consortium has on how # ISO/IEC 8859-13:1998 characters map into Unicode. # # Format: Three tab-separated columns # Column #1 is the ISO/IEC 8859-13 code (in hex as 0xXX) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 the Unicode name (follows a comment sign, '#') # # The entries are in ISO/IEC 8859-13 order. # # Version history # 1.0 version: created # 2.0 version: updates to copyright notice and terms of use; no # changes to character mappings # # Updated versions of this file may be found in: # http://www.unicode.org/Public/MAPPINGS/ # # Any comments or problems, contact us at: # http://www.unicode.org/reporting.html # 0x00 0x0000 # NULL 0x01 0x0001 # START OF HEADING 0x02 0x0002 # START OF TEXT 0x03 0x0003 # END OF TEXT 0x04 0x0004 # END OF TRANSMISSION 0x05 0x0005 # ENQUIRY |
| ︙ | ︙ |
Changes to tools/encoding/iso8859-14.txt.
1 2 3 | # # Name: ISO/IEC 8859-14:1998 to Unicode # Unicode version: 3.0 | > > > > | | | | < < < < < < < < < < < < < < < < > > > > > | | | < | 1 2 3 4 5 6 7 8 9 10 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 | # 8859-14.TXT # Date: 2015-12-02 22:05:00 GMT [KW] # © 2015 Unicode®, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Name: ISO/IEC 8859-14:1998 to Unicode # Unicode version: 3.0 # Table version: 2.0 # Table format: Format A # Date: 1999 July 27 (header updated: 2015 December 02) # Authors: Markus Kuhn <http://www.cl.cam.ac.uk/~mgk25/> # Ken Whistler <ken@unicode.org> # # General notes: # # This table contains the data the Unicode Consortium has on how # ISO/IEC 8859-14:1998 characters map into Unicode. # # Format: Three tab-separated columns # Column #1 is the ISO/IEC 8859-14 code (in hex as 0xXX) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 the Unicode name (follows a comment sign, '#') # # The entries are in ISO/IEC 8859-14 order. # # Version history # 1.0 version: created # 2.0 version: updates to copyright notice and terms of use; no # changes to character mappings # # Updated versions of this file may be found in: # http://www.unicode.org/Public/MAPPINGS/ # # Any comments or problems, contact us at: # http://www.unicode.org/reporting.html # 0x00 0x0000 # NULL 0x01 0x0001 # START OF HEADING 0x02 0x0002 # START OF TEXT 0x03 0x0003 # END OF TEXT 0x04 0x0004 # END OF TRANSMISSION 0x05 0x0005 # ENQUIRY |
| ︙ | ︙ | |||
294 295 296 297 298 299 300 | 0xF9 0x00F9 # LATIN SMALL LETTER U WITH GRAVE 0xFA 0x00FA # LATIN SMALL LETTER U WITH ACUTE 0xFB 0x00FB # LATIN SMALL LETTER U WITH CIRCUMFLEX 0xFC 0x00FC # LATIN SMALL LETTER U WITH DIAERESIS 0xFD 0x00FD # LATIN SMALL LETTER Y WITH ACUTE 0xFE 0x0177 # LATIN SMALL LETTER Y WITH CIRCUMFLEX 0xFF 0x00FF # LATIN SMALL LETTER Y WITH DIAERESIS | < | 286 287 288 289 290 291 292 | 0xF9 0x00F9 # LATIN SMALL LETTER U WITH GRAVE 0xFA 0x00FA # LATIN SMALL LETTER U WITH ACUTE 0xFB 0x00FB # LATIN SMALL LETTER U WITH CIRCUMFLEX 0xFC 0x00FC # LATIN SMALL LETTER U WITH DIAERESIS 0xFD 0x00FD # LATIN SMALL LETTER Y WITH ACUTE 0xFE 0x0177 # LATIN SMALL LETTER Y WITH CIRCUMFLEX 0xFF 0x00FF # LATIN SMALL LETTER Y WITH DIAERESIS |
Changes to tools/encoding/iso8859-15.txt.
1 2 3 | # # Name: ISO/IEC 8859-15:1999 to Unicode # Unicode version: 3.0 | > > > > | | | | < < < < < < < < < < < < < < < < > > > > > | | | < | 1 2 3 4 5 6 7 8 9 10 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 | # 8859-15.TXT # Date: 2015-12-02 22:06:00 GMT [KW] # © 2015 Unicode®, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Name: ISO/IEC 8859-15:1999 to Unicode # Unicode version: 3.0 # Table version: 2.0 # Table format: Format A # Date: 1999 July 27 (header updated: 2015 December 02) # Authors: Markus Kuhn <http://www.cl.cam.ac.uk/~mgk25/> # Ken Whistler <ken@unicode.org> # # General notes: # # This table contains the data the Unicode Consortium has on how # ISO/IEC 8859-15:1999 characters map into Unicode. # # Format: Three tab-separated columns # Column #1 is the ISO/IEC 8859-15 code (in hex as 0xXX) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 the Unicode name (follows a comment sign, '#') # # The entries are in ISO/IEC 8859-15 order. # # Version history # # Version history # 1.0 version: created # 2.0 version: updates to copyright notice and terms of use; no # changes to character mappings # # Updated versions of this file may be found in: # http://www.unicode.org/Public/MAPPINGS/ # # Any comments or problems, contact us at: # http://www.unicode.org/reporting.html # 0x00 0x0000 # NULL 0x01 0x0001 # START OF HEADING 0x02 0x0002 # START OF TEXT 0x03 0x0003 # END OF TEXT 0x04 0x0004 # END OF TRANSMISSION 0x05 0x0005 # ENQUIRY |
| ︙ | ︙ | |||
296 297 298 299 300 301 302 | 0xF9 0x00F9 # LATIN SMALL LETTER U WITH GRAVE 0xFA 0x00FA # LATIN SMALL LETTER U WITH ACUTE 0xFB 0x00FB # LATIN SMALL LETTER U WITH CIRCUMFLEX 0xFC 0x00FC # LATIN SMALL LETTER U WITH DIAERESIS 0xFD 0x00FD # LATIN SMALL LETTER Y WITH ACUTE 0xFE 0x00FE # LATIN SMALL LETTER THORN 0xFF 0x00FF # LATIN SMALL LETTER Y WITH DIAERESIS | < | 288 289 290 291 292 293 294 | 0xF9 0x00F9 # LATIN SMALL LETTER U WITH GRAVE 0xFA 0x00FA # LATIN SMALL LETTER U WITH ACUTE 0xFB 0x00FB # LATIN SMALL LETTER U WITH CIRCUMFLEX 0xFC 0x00FC # LATIN SMALL LETTER U WITH DIAERESIS 0xFD 0x00FD # LATIN SMALL LETTER Y WITH ACUTE 0xFE 0x00FE # LATIN SMALL LETTER THORN 0xFF 0x00FF # LATIN SMALL LETTER Y WITH DIAERESIS |
Changes to tools/encoding/iso8859-16.txt.
1 2 3 | # # Name: ISO/IEC 8859-16:2001 to Unicode # Unicode version: 3.0 | > > > > | | | < < < < < < < < < < < < < < > > > > > | | | < | 1 2 3 4 5 6 7 8 9 10 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 | # 8859-16.TXT # Date: 2015-12-02 22:08:00 GMT [KW] # © 2015 Unicode®, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Name: ISO/IEC 8859-16:2001 to Unicode # Unicode version: 3.0 # Table version: 2.0 # Table format: Format A # Date: 2001 July 26 (header updated: 2015 December 02) # Authors: Markus Kuhn <http://www.cl.cam.ac.uk/~mgk25/> # # Copyright (c) 1999-2001 Unicode, Inc. All Rights reserved. # # General notes: # # This table contains the data the Unicode Consortium has on how # ISO/IEC 8859-16:2001 characters map into Unicode. # # Format: Three tab-separated columns # Column #1 is the ISO/IEC 8859-16 code (in hex as 0xXX) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 the Unicode name (follows a comment sign, '#') # # The entries are in ISO/IEC 8859-16 order. # # Version history # 1.0 version: created # 2.0 version: updates to copyright notice and terms of use; no # changes to character mappings # # Updated versions of this file may be found in: # http://www.unicode.org/Public/MAPPINGS/ # # Any comments or problems, contact us at: # http://www.unicode.org/reporting.html # 0x00 0x0000 # NULL 0x01 0x0001 # START OF HEADING 0x02 0x0002 # START OF TEXT 0x03 0x0003 # END OF TEXT 0x04 0x0004 # END OF TRANSMISSION 0x05 0x0005 # ENQUIRY |
| ︙ | ︙ |
Changes to tools/encoding/iso8859-2.txt.
1 2 3 | # # Name: ISO 8859-2:1999 to Unicode # Unicode version: 3.0 | > > > > | | | < < < < < < < < < < < < < < < < | | > > | | | < | 1 2 3 4 5 6 7 8 9 10 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 | # 8859-2.TXT # Date: 2015-12-02 21:34:00 GMT [KW] # © 2015 Unicode®, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Name: ISO 8859-2:1999 to Unicode # Unicode version: 3.0 # Table version: 2.0 # Table format: Format A # Date: 1999 July 27 (header updated: 2015 December 02) # Authors: Ken Whistler <ken@unicode.org> # # General notes: # # This table contains the data the Unicode Consortium has on how # ISO/IEC 8859-2:1999 characters map into Unicode. # # Format: Three tab-separated columns # Column #1 is the ISO/IEC 8859-2 code (in hex as 0xXX) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 the Unicode name (follows a comment sign, '#') # # The entries are in ISO/IEC 8859-2 order. # # Version history # 1.0 version: updates 0.1 version by adding mappings for all # control characters. # 2.0 version: updates to copyright notice and terms of use; no # changes to character mappings # # Updated versions of this file may be found in: # http://www.unicode.org/Public/MAPPINGS/ # # Any comments or problems, contact us at: # http://www.unicode.org/reporting.html # 0x00 0x0000 # NULL 0x01 0x0001 # START OF HEADING 0x02 0x0002 # START OF TEXT 0x03 0x0003 # END OF TEXT 0x04 0x0004 # END OF TRANSMISSION 0x05 0x0005 # ENQUIRY |
| ︙ | ︙ |
Changes to tools/encoding/iso8859-3.txt.
1 2 3 | # # Name: ISO/IEC 8859-3:1999 to Unicode # Unicode version: 3.0 | > > > > | | | < < < < < < < < < < < < < < < < | | > > | | | < | 1 2 3 4 5 6 7 8 9 10 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 | # 8859-3.TXT # Date: 2015-12-02 21:39:00 GMT [KW] # © 2015 Unicode®, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Name: ISO/IEC 8859-3:1999 to Unicode # Unicode version: 3.0 # Table version: 2.0 # Table format: Format A # Date: 1999 July 27 (header updated: 2015 December 02) # Authors: Ken Whistler <ken@unicode.org> # # General notes: # # This table contains the data the Unicode Consortium has on how # ISO/IEC 8859-3:1999 characters map into Unicode. # # Format: Three tab-separated columns # Column #1 is the ISO/IEC 8859-3 code (in hex as 0xXX) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 the Unicode name (follows a comment sign, '#') # # The entries are in ISO/IEC 8859-3 order. # # Version history # 1.0 version: updates 0.1 version by adding mappings for all # control characters. # 2.0 version: updates to copyright notice and terms of use; no # changes to character mappings # # Updated versions of this file may be found in: # http://www.unicode.org/Public/MAPPINGS/ # # Any comments or problems, contact us at: # http://www.unicode.org/reporting.html # 0x00 0x0000 # NULL 0x01 0x0001 # START OF HEADING 0x02 0x0002 # START OF TEXT 0x03 0x0003 # END OF TEXT 0x04 0x0004 # END OF TRANSMISSION 0x05 0x0005 # ENQUIRY |
| ︙ | ︙ |
Changes to tools/encoding/iso8859-4.txt.
1 2 3 | # # Name: ISO/IEC 8859-4:1998 to Unicode # Unicode version: 3.0 | > > > > | | | < < < < < < < < < < < < < < < < | | > > | | | < | 1 2 3 4 5 6 7 8 9 10 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 | # 8859-4.TXT # Date: 2015-12-02 21:41:00 GMT [KW] # © 2015 Unicode®, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Name: ISO/IEC 8859-4:1998 to Unicode # Unicode version: 3.0 # Table version: 2.0 # Table format: Format A # Date: 1999 July 27 (header updated: 2015 December 02) # Authors: Ken Whistler <ken@unicode.org> # # General notes: # # This table contains the data the Unicode Consortium has on how # ISO/IEC 8859-4:1998 characters map into Unicode. # # Format: Three tab-separated columns # Column #1 is the ISO/IEC 8859-4 code (in hex as 0xXX) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 the Unicode name (follows a comment sign, '#') # # The entries are in ISO/IEC 8859-4 order. # # Version history # 1.0 version: updates 0.1 version by adding mappings for all # control characters. # 2.0 version: updates to copyright notice and terms of use; no # changes to character mappings # # Updated versions of this file may be found in: # http://www.unicode.org/Public/MAPPINGS/ # # Any comments or problems, contact us at: # http://www.unicode.org/reporting.html # 0x00 0x0000 # NULL 0x01 0x0001 # START OF HEADING 0x02 0x0002 # START OF TEXT 0x03 0x0003 # END OF TEXT 0x04 0x0004 # END OF TRANSMISSION 0x05 0x0005 # ENQUIRY |
| ︙ | ︙ |
Changes to tools/encoding/iso8859-5.txt.
1 2 3 | # # Name: ISO 8859-5:1999 to Unicode # Unicode version: 3.0 | > > > > | | | < < < < < < < < < < < < < < < < | | > > | | | < | 1 2 3 4 5 6 7 8 9 10 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 | # 8859-5.TXT # Date: 2015-12-02 21:43:00 GMT [KW] # © 2015 Unicode®, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Name: ISO 8859-5:1999 to Unicode # Unicode version: 3.0 # Table version: 2.0 # Table format: Format A # Date: 1999 July 27 (header updated: 2015 December 02) # Authors: Ken Whistler <ken@unicode.org> # # General notes: # # This table contains the data the Unicode Consortium has on how # ISO/IEC 8859-5:1999 characters map into Unicode. # # Format: Three tab-separated columns # Column #1 is the ISO/IEC 8859-5 code (in hex as 0xXX) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 the Unicode name (follows a comment sign, '#') # # The entries are in ISO/IEC 8859-5 order. # # Version history # 1.0 version: updates 0.1 version by adding mappings for all # control characters. # 2.0 version: updates to copyright notice and terms of use; no # changes to character mappings # # Updated versions of this file may be found in: # http://www.unicode.org/Public/MAPPINGS/ # # Any comments or problems, contact us at: # http://www.unicode.org/reporting.html # 0x00 0x0000 # NULL 0x01 0x0001 # START OF HEADING 0x02 0x0002 # START OF TEXT 0x03 0x0003 # END OF TEXT 0x04 0x0004 # END OF TRANSMISSION 0x05 0x0005 # ENQUIRY |
| ︙ | ︙ |
Changes to tools/encoding/iso8859-6.txt.
1 2 3 | # # Name: ISO 8859-6:1999 to Unicode # Unicode version: 3.0 | > > > > | | | < < < < < < < < < < < < < < < < | | | | > > | | | < | 1 2 3 4 5 6 7 8 9 10 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 | # 8859-6.TXT # Date: 2015-12-02 21:44:00 GMT [KW] # © 2015 Unicode®, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Name: ISO 8859-6:1999 to Unicode # Unicode version: 3.0 # Table version: 2.0 # Table format: Format A # Date: 1999 July 27 (header updated: 2015 December 02) # Authors: Ken Whistler <ken@unicode.org> # # General notes: # # This table contains the data the Unicode Consortium has on how # ISO/IEC 8859-6:1999 characters map into Unicode. # # Format: Three tab-separated columns # Column #1 is the ISO/IEC 8859-6 code (in hex as 0xXX) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 the Unicode name (follows a comment sign, '#') # # The entries are in ISO/IEC 8859-6 order. # # Version history # 1.0 version: updates 0.1 version by adding mappings for all # control characters. # 0x30..0x39 remapped to the ASCII digits (U+0030..U+0039) instead # of the Arabic digits (U+0660..U+0669). # 2.0 version: updates to copyright notice and terms of use; no # changes to character mappings # # Updated versions of this file may be found in: # http://www.unicode.org/Public/MAPPINGS/ # # Any comments or problems, contact us at: # http://www.unicode.org/reporting.html # 0x00 0x0000 # NULL 0x01 0x0001 # START OF HEADING 0x02 0x0002 # START OF TEXT 0x03 0x0003 # END OF TEXT 0x04 0x0004 # END OF TRANSMISSION 0x05 0x0005 # ENQUIRY |
| ︙ | ︙ |
Changes to tools/encoding/iso8859-7.txt.
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 | # 8859-7.TXT # Date: 2015-12-02 21:47:00 GMT [KW] # © 2015 Unicode®, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Name: ISO 8859-7:2003 to Unicode # Unicode version: 4.0 # Table version: 3.0 # Table format: Format A # Date: 2003-Nov-12 (header updated: 2015 December 02) # Authors: Ken Whistler <ken@unicode.org> # # General notes: # # This table contains the data the Unicode Consortium has on how # ISO 8859-7:2003 characters map into Unicode. # # ISO 8859-7:1987 is equivalent to ISO-IR-126, ELOT 928, # and ECMA 118. ISO 8859-7:2003 adds two currency signs # and one other character not in the earlier standard. # # Format: Three tab-separated columns # Column #1 is the ISO 8859-7 code (in hex as 0xXX) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 the Unicode name (follows a comment sign, '#') # # The entries are in ISO 8859-7 order. # # Version history # 1.0 version updates 0.1 version by adding mappings for all # control characters. # Remap 0xA1 to U+2018 (instead of 0x02BD) to match text of 8859-7 # Remap 0xA2 to U+2019 (instead of 0x02BC) to match text of 8859-7 # # 2.0 version updates 1.0 version by adding mappings for the # three newly added characters 0xA4, 0xA5, 0xAA. # # 3.0 version: updates to copyright notice and terms of use; no # changes to character mappings # # Updated versions of this file may be found in: # http://www.unicode.org/Public/MAPPINGS/ # # Any comments or problems, contact us at: # http://www.unicode.org/reporting.html # 0x00 0x0000 # NULL 0x01 0x0001 # START OF HEADING 0x02 0x0002 # START OF TEXT 0x03 0x0003 # END OF TEXT 0x04 0x0004 # END OF TRANSMISSION 0x05 0x0005 # ENQUIRY |
| ︙ | ︙ | |||
210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 | 0x9D 0x009D # <control> 0x9E 0x009E # <control> 0x9F 0x009F # <control> 0xA0 0x00A0 # NO-BREAK SPACE 0xA1 0x2018 # LEFT SINGLE QUOTATION MARK 0xA2 0x2019 # RIGHT SINGLE QUOTATION MARK 0xA3 0x00A3 # POUND SIGN 0xA6 0x00A6 # BROKEN BAR 0xA7 0x00A7 # SECTION SIGN 0xA8 0x00A8 # DIAERESIS 0xA9 0x00A9 # COPYRIGHT SIGN 0xAB 0x00AB # LEFT-POINTING DOUBLE ANGLE QUOTATION MARK 0xAC 0x00AC # NOT SIGN 0xAD 0x00AD # SOFT HYPHEN 0xAF 0x2015 # HORIZONTAL BAR 0xB0 0x00B0 # DEGREE SIGN 0xB1 0x00B1 # PLUS-MINUS SIGN 0xB2 0x00B2 # SUPERSCRIPT TWO | > > > | 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 | 0x9D 0x009D # <control> 0x9E 0x009E # <control> 0x9F 0x009F # <control> 0xA0 0x00A0 # NO-BREAK SPACE 0xA1 0x2018 # LEFT SINGLE QUOTATION MARK 0xA2 0x2019 # RIGHT SINGLE QUOTATION MARK 0xA3 0x00A3 # POUND SIGN 0xA4 0x20AC # EURO SIGN 0xA5 0x20AF # DRACHMA SIGN 0xA6 0x00A6 # BROKEN BAR 0xA7 0x00A7 # SECTION SIGN 0xA8 0x00A8 # DIAERESIS 0xA9 0x00A9 # COPYRIGHT SIGN 0xAA 0x037A # GREEK YPOGEGRAMMENI 0xAB 0x00AB # LEFT-POINTING DOUBLE ANGLE QUOTATION MARK 0xAC 0x00AC # NOT SIGN 0xAD 0x00AD # SOFT HYPHEN 0xAF 0x2015 # HORIZONTAL BAR 0xB0 0x00B0 # DEGREE SIGN 0xB1 0x00B1 # PLUS-MINUS SIGN 0xB2 0x00B2 # SUPERSCRIPT TWO |
| ︙ | ︙ |
Changes to tools/encoding/iso8859-8.txt.
1 2 3 | # # Name: ISO/IEC 8859-8:1999 to Unicode # Unicode version: 3.0 | > > > > | | | < < < < < < < < < < < < < < < < | > > | | | < | 1 2 3 4 5 6 7 8 9 10 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 | # 8859-8.TXT # Date: 2015-12-02 21:50:00 GMT [KW] # © 2015 Unicode®, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Name: ISO/IEC 8859-8:1999 to Unicode # Unicode version: 3.0 # Table version: 2.0 # Table format: Format A # Date: 2000-Jan-03 (header updated: 2015 December 02) # Authors: Ken Whistler <ken@unicode.org> # # General notes: # # This table contains the data the Unicode Consortium has on how # ISO/IEC 8859-8:1999 characters map into Unicode. # # Format: Three tab-separated columns # Column #1 is the ISO/IEC 8859-8 code (in hex as 0xXX) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 the Unicode name (follows a comment sign, '#') # # The entries are in ISO/IEC 8859-8 order. # # Version history # 1.0 version updates 0.1 version by adding mappings for all # control characters. # 1.1 version updates to the published 8859-8:1999, correcting # the mapping of 0xAF and adding mappings for LRM and RLM. # 2.0 version: updates to copyright notice and terms of use; no # changes to character mappings # # Updated versions of this file may be found in: # http://www.unicode.org/Public/MAPPINGS/ # # Any comments or problems, contact us at: # http://www.unicode.org/reporting.html # 0x00 0x0000 # NULL 0x01 0x0001 # START OF HEADING 0x02 0x0002 # START OF TEXT 0x03 0x0003 # END OF TEXT 0x04 0x0004 # END OF TRANSMISSION 0x05 0x0005 # ENQUIRY |
| ︙ | ︙ | |||
263 264 265 266 267 268 269 | 0xF6 0x05E6 # HEBREW LETTER TSADI 0xF7 0x05E7 # HEBREW LETTER QOF 0xF8 0x05E8 # HEBREW LETTER RESH 0xF9 0x05E9 # HEBREW LETTER SHIN 0xFA 0x05EA # HEBREW LETTER TAV 0xFD 0x200E # LEFT-TO-RIGHT MARK 0xFE 0x200F # RIGHT-TO-LEFT MARK | < | 252 253 254 255 256 257 258 | 0xF6 0x05E6 # HEBREW LETTER TSADI 0xF7 0x05E7 # HEBREW LETTER QOF 0xF8 0x05E8 # HEBREW LETTER RESH 0xF9 0x05E9 # HEBREW LETTER SHIN 0xFA 0x05EA # HEBREW LETTER TAV 0xFD 0x200E # LEFT-TO-RIGHT MARK 0xFE 0x200F # RIGHT-TO-LEFT MARK |
Changes to tools/encoding/iso8859-9.txt.
1 2 3 | # # Name: ISO/IEC 8859-9:1999 to Unicode # Unicode version: 3.0 | > > > > | | | < < < < < < < < < < < < < < < < | | > > | | | < | 1 2 3 4 5 6 7 8 9 10 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 | # 8859-9.TXT # Date: 2015-12-02 21:51:00 GMT [KW] # © 2015 Unicode®, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Name: ISO/IEC 8859-9:1999 to Unicode # Unicode version: 3.0 # Table version: 2.0 # Table format: Format A # Date: 1999 July 27 (header updated: 2015 December 02) # Authors: Ken Whistler <ken@unicode.org> # # General notes: # # This table contains the data the Unicode Consortium has on how # ISO/IEC 8859-9:1999 characters map into Unicode. # # Format: Three tab-separated columns # Column #1 is the ISO/IEC 8859-9 code (in hex as 0xXX) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 the Unicode name (follows a comment sign, '#') # # The entries are in ISO/IEC 8859-9 order. # # ISO/IEC 8859-9 is also equivalent to ISO-IR-148. # # Version history # 1.0 version: updates 0.1 version by adding mappings for all # control characters. # 2.0 version: updates to copyright notice and terms of use; no # changes to character mappings # # Updated versions of this file may be found in: # http://www.unicode.org/Public/MAPPINGS/ # # Any comments or problems, contact us at: # http://www.unicode.org/reporting.html # 0x00 0x0000 # NULL 0x01 0x0001 # START OF HEADING 0x02 0x0002 # START OF TEXT 0x03 0x0003 # END OF TEXT 0x04 0x0004 # END OF TRANSMISSION 0x05 0x0005 # ENQUIRY |
| ︙ | ︙ | |||
299 300 301 302 303 304 305 306 | 0xF9 0x00F9 # LATIN SMALL LETTER U WITH GRAVE 0xFA 0x00FA # LATIN SMALL LETTER U WITH ACUTE 0xFB 0x00FB # LATIN SMALL LETTER U WITH CIRCUMFLEX 0xFC 0x00FC # LATIN SMALL LETTER U WITH DIAERESIS 0xFD 0x0131 # LATIN SMALL LETTER DOTLESS I 0xFE 0x015F # LATIN SMALL LETTER S WITH CEDILLA 0xFF 0x00FF # LATIN SMALL LETTER Y WITH DIAERESIS | < | 288 289 290 291 292 293 294 295 | 0xF9 0x00F9 # LATIN SMALL LETTER U WITH GRAVE 0xFA 0x00FA # LATIN SMALL LETTER U WITH ACUTE 0xFB 0x00FB # LATIN SMALL LETTER U WITH CIRCUMFLEX 0xFC 0x00FC # LATIN SMALL LETTER U WITH DIAERESIS 0xFD 0x0131 # LATIN SMALL LETTER DOTLESS I 0xFE 0x015F # LATIN SMALL LETTER S WITH CEDILLA 0xFF 0x00FF # LATIN SMALL LETTER Y WITH DIAERESIS |
Changes to tools/encoding/jis0201.txt.
1 2 3 | # # Name: JIS X 0201 (1976) to Unicode 1.1 Table # Unicode version: 1.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 | # JIS0201.TXT # Date: 2015-12-02 23:49:00 GMT [KW] # © 2015 Unicode®, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Name: JIS X 0201 (1976) to Unicode 1.1 Table # Unicode version: 1.1 # Table version: 2.0 # Table format: Format A # Date: 2011 October 14 (header updated: 2015 December 02) # # General notes: # # # This table contains one set of mappings from JIS X 0201 into Unicode. # Note that these data are *possible* mappings only and may not be the # same as those used by actual products, nor may they be the best suited # for all uses. For more information on the mappings between various code # pages incorporating the repertoire of JIS X 0201 and Unicode, consult the # VENDORS mapping data. # # # Format: Three tab-separated columns # Column #1 is the shift JIS code (in hex as 0xXX) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 the Unicode (ISO 10646) name (follows a comment sign) # # The entries are in JIS order # # Revision History: # # [v2.0, 2015 December 02] # updates to copyright notice and terms of use # no changes to character mappings # # [v1.0, 2011 October 14] # Updated terms of use to current wording. # Updated contact information. # No changes to the mapping data. # # [v0.9, 8 March 1994] # First release. # # Use the Unicode reporting form <http://www.unicode.org/reporting.html> # for any questions or comments or to report errors in the data. # 0x20 0x0020 # SPACE 0x21 0x0021 # EXCLAMATION MARK 0x22 0x0022 # QUOTATION MARK 0x23 0x0023 # NUMBER SIGN 0x24 0x0024 # DOLLAR SIGN 0x25 0x0025 # PERCENT SIGN |
| ︙ | ︙ |
Changes to tools/encoding/jis0208.txt.
1 2 3 | # # Name: JIS X 0208 (1990) to Unicode # Unicode version: 1.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 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 | # JIS0208.TXT # Date: 2015-12-02 23:50:00 GMT [KW] # © 2015 Unicode®, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Name: JIS X 0208 (1990) to Unicode # Unicode version: 1.1 # Table version: 2.0 # Table format: Format A # Date: 2011 October 14 (header updated: 2015 December 02) # # General notes: # # # This table contains one set of mappings from JIS X 0208 (1990) into Unicode. # Note that these data are *possible* mappings only and may not be the # same as those used by actual products, nor may they be the best suited # for all uses. For more information on the mappings between various code # pages incorporating the repertoire of JIS X 0208 (1990) and Unicode, consult the # VENDORS mapping data. # # # Format: Four tab-separated columns # Column #1 is the shift-JIS code (in hex) # Column #2 is the JIS X 0208 code (in hex as 0xXXXX) # Column #3 is the Unicode (in hex as 0xXXXX) # Column #4 the Unicode name (follows a comment sign, '#') # The official names for Unicode characters U+4E00 # to U+9FA5, inclusive, is "CJK UNIFIED IDEOGRAPH-XXXX", # where XXXX is the code point. Including all these # names in this file increases its size substantially # and needlessly. The token "<CJK>" is used for the # name of these characters. If necessary, it can be # expanded algorithmically by a parser or editor. # # The entries are in JIS X 0208 order # # The following algorithms can be used to change the hex form # of JIS 0208 to other standard forms: # # To change hex to EUC form, add 0x8080 # To change hex to kuten form, first subtract 0x2020. Then # the high and low bytes correspond to the ku and ten of # the kuten form. For example, 0x2121 -> 0x0101 -> 0101; # 0x7426 -> 0x5406 -> 8406 # # Revision History: # # [v2.0, 2015 December 02] # updates to copyright notice and terms of use # no changes to character mappings # # [v1.0, 2011 October 14] # Updated terms of use to current wording. # Updated contact information. # No changes to the mapping data. # # [v0.9, 8 March 1994] # First release. # # Use the Unicode reporting form <http://www.unicode.org/reporting.html> # for any questions or comments or to report errors in the data. # 0x8140 0x2121 0x3000 # IDEOGRAPHIC SPACE 0x8141 0x2122 0x3001 # IDEOGRAPHIC COMMA 0x8142 0x2123 0x3002 # IDEOGRAPHIC FULL STOP 0x8143 0x2124 0xFF0C # FULLWIDTH COMMA 0x8144 0x2125 0xFF0E # FULLWIDTH FULL STOP 0x8145 0x2126 0x30FB # KATAKANA MIDDLE DOT |
| ︙ | ︙ |
Changes to tools/encoding/jis0212.txt.
1 2 3 | # # Name: JIS X 0212 (1990) to Unicode # Unicode version: 1.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 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 | # JIS0212.TXT # Date: 2015-12-02 23:51:00 GMT [KW] # © 2015 Unicode®, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Name: JIS X 0212 (1990) to Unicode # Unicode version: 1.1 # Table version: 2.0 # Table format: Format A # Date: 2011 October 14 (header updated: 2015 December 02) # # General notes: # # # This table contains one set of mappings from JIS X 0212 into Unicode. # Note that these data are *possible* mappings only and may not be the # same as those used by actual products, nor may they be the best suited # for all uses. For more information on the mappings between various code # pages incorporating the repertoire of JIS X 0212 and Unicode, consult the # VENDORS mapping data. # # # Format: Three tab-separated columns # Column #1 is the JIS X 0212 code (in hex as 0xXXXX) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 the Unicode name (follows a comment sign, '#') # The official names for Unicode characters U+4E00 # to U+9FA5, inclusive, is "CJK UNIFIED IDEOGRAPH-XXXX", # where XXXX is the code point. Including all these # names in this file increases its size substantially # and needlessly. The token "<CJK>" is used for the # name of these characters. If necessary, it can be # expanded algorithmically by a parser or editor. # # The entries are in JIS X 0212 order # # The following algorithms can be used to change the hex form # of JIS 0212 to other standard forms: # # To change hex to EUC form, add 0x8080 # To change hex to kuten form, first subtract 0x2020. Then # the high and low bytes correspond to the ku and ten of # the kuten form. For example, 0x2121 -> 0x0101 -> 0101; # 0x6D63 -> 0x4D43 -> 7767 # # Notes: # # 1. JIS X 0212 apparently unified the following two symbols # into a single character at 0x2922: # # LATIN CAPITAL LETTER D WITH STROKE # LATIN CAPITAL LETTER ETH # # However, JIS X 0212 maintains the distinction between # the lowercase forms of these two elements at 0x2942 and 0x2943. # Given the structre of these JIS encodings, it is clear that # 0x2922 and 0x2942 are intended to be a capital/small pair. # Consequently, in the Unicode mapping, 0x2922 is treated as # LATIN CAPITAL LETTER D WITH STROKE. # # Revision History: # # [v2.0, 2015 December 02] # updates to copyright notice and terms of use # no changes to character mappings # # [v1.0, 2011 October 14] # Updated terms of use to current wording. # Updated contact information. # No changes to the mapping data. # # [v0.9, 8 March 1994] # First release. # # Use the Unicode reporting form <http://www.unicode.org/reporting.html> # for any questions or comments or to report errors in the data. # 0x222F 0x02D8 # BREVE 0x2230 0x02C7 # CARON (Mandarin Chinese third tone) 0x2231 0x00B8 # CEDILLA 0x2232 0x02D9 # DOT ABOVE (Mandarin Chinese light tone) 0x2233 0x02DD # DOUBLE ACUTE ACCENT 0x2234 0x00AF # MACRON 0x2235 0x02DB # OGONEK |
| ︙ | ︙ |
Changes to tools/encoding/shiftjis.txt.
1 2 3 | # # Name: Shift-JIS to Unicode # Unicode version: 1.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 53 54 55 56 57 58 59 60 61 62 63 64 65 66 | # SHIFTJIS.TXT # Date: 2015-12-02 23:52:00 GMT [KW] # © 2015 Unicode®, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Name: Shift-JIS to Unicode # Unicode version: 1.1 # Table version: 2.0 # Table format: Format A # Date: 2011 October 14 (header updated: 2015 December 02) # # General notes: # # # This table contains one set of mappings from Shift-JIS into Unicode. # Note that these data are *possible* mappings only and may not be the # same as those used by actual products, nor may they be the best suited # for all uses. For more information on the mappings between various code # pages incorporating the repertoire of Shift-JIS and Unicode, consult the # VENDORS mapping data. # # # Format: Three tab-separated columns # Column #1 is the shift-JIS code (in hex) # Column #2 is the Unicode (in hex as 0xXXXX) # Column #3 the Unicode name (follows a comment sign, '#') # The official names for Unicode characters U+4E00 # to U+9FA5, inclusive, is "CJK UNIFIED IDEOGRAPH-XXXX", # where XXXX is the code point. Including all these # names in this file increases its size substantially # and needlessly. The token "<CJK>" is used for the # name of these characters. If necessary, it can be # expanded algorithmically by a parser or editor. # # The entries are ordered by their Shift-JIS codes as follows: # Single-byte characters precede double-byte characters # The single-byte and double-byte blocks are in ascending # hexadecimal order # There is an alternative order some people might be preferred, # where all the entries are in order of the top (or only) byte. # This alternate order can be generated from the one given here # by a simple sort. # # Revision History: # # [v2.0, 2015 December 02] # updates to copyright notice and terms of use # no changes to character mappings # # [v1.0, 2011 October 14] # Updated terms of use to current wording. # Updated contact information. # No changes to the mapping data. # # [v0.9, 8 March 1994] # First release. # # Use the Unicode reporting form <http://www.unicode.org/reporting.html> # for any questions or comments or to report errors in the data. # 0x20 0x0020 # SPACE 0x21 0x0021 # EXCLAMATION MARK 0x22 0x0022 # QUOTATION MARK 0x23 0x0023 # NUMBER SIGN 0x24 0x0024 # DOLLAR SIGN 0x25 0x0025 # PERCENT SIGN |
| ︙ | ︙ |
Changes to tools/findBadExternals.tcl.
1 2 3 4 5 6 7 8 9 10 11 12 | # 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 |
# findBadExternals.tcl --
#
# This script scans the Tcl load library for exported symbols
# that do not begin with 'Tcl' or 'tcl'. It reports them on the
# standard output. It is used to make sure that the library does
# not inadvertently export externals that may be in conflict with
# other code.
#
# Usage:
#
# tclsh findBadExternals.tcl /path/to/tclXX.so-or-.dll
#
# Copyright © 2005 George Peter Staplin and Kevin Kenny
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#----------------------------------------------------------------------
proc main {argc argv} {
|
| ︙ | ︙ |
Changes to tools/genStubs.tcl.
1 2 3 4 5 6 | # genStubs.tcl -- # # This script generates a set of stub files for a given # interface. # # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 |
# genStubs.tcl --
#
# This script generates a set of stub files for a given
# interface.
#
#
# Copyright © 1998-1999 Scriptics Corporation.
# Copyright © 2007 Daniel A. Steffen <das@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
namespace eval genStubs {
# libraryName --
#
|
| ︙ | ︙ |
Changes to tools/index.tcl.
1 2 3 4 5 6 | # 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 | # index.tcl -- # # This file defines procedures that are used during the first pass of # the man page conversion. It is used to extract information used to # generate a table of contents and a keyword list. # # Copyright © 1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # Global variables used by these scripts: # # state - state variable that controls action of text proc. |
| ︙ | ︙ |
Changes to tools/installData.tcl.
| ︙ | ︙ | |||
8 9 10 11 12 13 14 | # # This file installs a hierarchy of data found in the directory # specified by its first argument into the directory specified # by its second. # #---------------------------------------------------------------------- # | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
#
# This file installs a hierarchy of data found in the directory
# specified by its first argument into the directory specified
# by its second.
#
#----------------------------------------------------------------------
#
# Copyright © 2004 Kevin B. Kenny. All rights reserved.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#----------------------------------------------------------------------
proc copyDir {d1 d2} {
puts [format {%*sCreating %s} [expr {4 * [info level]}] {} \
|
| ︙ | ︙ |
Changes to tools/installVfs.tcl.
1 2 3 4 5 6 7 8 9 10 11 12 |
#!/bin/sh
#\
exec tclsh "$0" ${1+"$@"}
#----------------------------------------------------------------------
#
# installVfs.tcl --
#
# This file wraps the /library file system around a binary
#
#----------------------------------------------------------------------
#
| | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 |
#!/bin/sh
#\
exec tclsh "$0" ${1+"$@"}
#----------------------------------------------------------------------
#
# installVfs.tcl --
#
# This file wraps the /library file system around a binary
#
#----------------------------------------------------------------------
#
# Copyright © 2018 Sean Woods. All rights reserved.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#----------------------------------------------------------------------
proc mapDir {resultvar prefix filepath} {
upvar 1 $resultvar result
if {![info exists result]} {
|
| ︙ | ︙ |
Changes to tools/loadICU.tcl.
| ︙ | ︙ | |||
18 19 20 21 22 23 24 | # None. # # Side effects: # Creates the message catalogs. # #---------------------------------------------------------------------- # | | | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 | # None. # # Side effects: # Creates the message catalogs. # #---------------------------------------------------------------------- # # Copyright © 2004 Kevin B. Kenny. All rights reserved. # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. #---------------------------------------------------------------------- puts stdout "TODO: output in UTF-8 in stead of using \\uhhhh sequences" exit; # Remove those two lines after modifying this tool. |
| ︙ | ︙ |
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 |
# makeHeader.tcl --
#
# This script generates embeddable C source (in a .h file) from a .tcl
# script.
#
# Copyright © 2018 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
package require Tcl 8.6-
namespace eval makeHeader {
|
| ︙ | ︙ |
Changes to tools/mkdepend.tcl.
1 2 3 4 | #============================================================================== # # mkdepend : generate dependency information from C/C++ files # | | | 1 2 3 4 5 6 7 8 9 10 11 12 | #============================================================================== # # mkdepend : generate dependency information from C/C++ files # # Copyright © 1998, Nat Pryce # # Permission is hereby granted, without written agreement and without # license or royalty fees, to use, copy, modify, and distribute this # software and its documentation for any purpose, provided that the # above copyright notice and the following two paragraphs appear in # all copies of this software. # |
| ︙ | ︙ |
Changes to tools/regexpTestLib.tcl.
1 2 3 4 5 6 | # 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 |
# regexpTestLib.tcl --
#
# This file contains tcl procedures used by spencer2testregexp.tcl and
# spencer2regexp.tcl, which are programs written to convert Henry
# Spencer's test suite to tcl test files.
#
# Copyright © 1996 Sun Microsystems, Inc.
proc readInputFile {} {
global inFileName
global lineArray
set fileId [open $inFileName r]
|
| ︙ | ︙ | |||
101 102 103 104 105 106 107 |
puts $fileId "# Commands covered: $fcn"
puts $fileId "#"
puts $fileId "# This Tcl-generated file contains tests for the $fcn tcl command."
puts $fileId "# Sourcing this file into Tcl runs the tests and generates output for"
puts $fileId "# errors. No output means no errors were found. Setting VERBOSE to"
puts $fileId "# -1 will run tests that are known to fail."
puts $fileId "#"
| | | 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 |
puts $fileId "# Commands covered: $fcn"
puts $fileId "#"
puts $fileId "# This Tcl-generated file contains tests for the $fcn tcl command."
puts $fileId "# Sourcing this file into Tcl runs the tests and generates output for"
puts $fileId "# errors. No output means no errors were found. Setting VERBOSE to"
puts $fileId "# -1 will run tests that are known to fail."
puts $fileId "#"
puts $fileId "# Copyright © 1998 Sun Microsystems, Inc."
puts $fileId "#"
puts $fileId "# See the file \"license.terms\" for information on usage and redistribution"
puts $fileId "# of this file, and for a DISCLAIMER OF ALL WARRANTIES."
puts $fileId "#"
puts $fileId "\# SCCS: \%Z\% \%M\% \%I\% \%E\% \%U\%"
puts $fileId "\nproc print \{arg\} \{puts \$arg\}\n"
puts $fileId "if \{\[string compare test \[info procs test\]\] == 1\} \{"
|
| ︙ | ︙ |
Changes to tools/tclOOScript.tcl.
1 2 3 4 5 6 | # 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. # | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
# tclOOScript.h --
#
# This file contains support scripts for TclOO. They are defined here so
# that the code can be definitely run even in safe interpreters; TclOO's
# core setup is safe.
#
# Copyright © 2012-2018 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.
::namespace eval ::oo {
::namespace path {}
|
| ︙ | ︙ |
Changes to tools/tclZIC.tcl.
| ︙ | ︙ | |||
21 22 23 24 25 26 27 | # # 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. # #---------------------------------------------------------------------- # | | | 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | # # This program parses the timezone data in a means analogous to the # 'zic' command, and produces Tcl time zone information files suitable # for loading into the 'clock' namespace. # #---------------------------------------------------------------------- # # Copyright © 2004 Kevin B. Kenny. All rights reserved. # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. #---------------------------------------------------------------------- # Define the names of the Olson files that we need to load. # We avoid the solar time files and the leap seconds. |
| ︙ | ︙ |
Changes to tools/tcltk-man2html-utils.tcl.
1 2 3 4 5 | ## ## 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. ## | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
##
## Utility functions for Man->HTML converter. Note that these
## functions are specifically intended to work with the format as used
## by Tcl and Tk; they do not cope with arbitrary nroff markup.
##
## Copyright © 1995-1997 Roger E. Critchlow Jr
## Copyright © 2004-2011 Donal K. Fellows
set ::manual(report-level) 1
proc manerror {msg} {
global manual
set name {}
set subj {}
|
| ︙ | ︙ | |||
885 886 887 888 889 890 891 |
return [reference-error "Missing end quote" $text]
}
if {$invert([lindex $offsets 1]) in {tcl tk ttk}} {
set offsets [lreplace $offsets 1 1]
}
switch -exact -- $invert([lindex $offsets 1]) {
end-quote {
| > | > | 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 |
return [reference-error "Missing end quote" $text]
}
if {$invert([lindex $offsets 1]) in {tcl tk ttk}} {
set offsets [lreplace $offsets 1 1]
}
switch -exact -- $invert([lindex $offsets 1]) {
end-quote {
if {$offset(quote) > 0} {
append result [string range $text 0 [expr {$offset(quote)-1}]]
}
set body [string range $text [expr {$offset(quote)+2}] \
[expr {$offset(end-quote)-1}]]
set text [string range $text[set text ""] \
[expr {$offset(end-quote)+2}] end]
append result `` [cross-reference $body] ''
continue
}
|
| ︙ | ︙ | |||
912 913 914 915 916 917 918 |
return [append result $text]
}
if {[string match "c.*" $invert([lindex $offsets 1])]} {
set offsets [lreplace $offsets 1 1]
}
switch -exact -- $invert([lindex $offsets 1]) {
url - end-bold {
| > | | > | 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 |
return [append result $text]
}
if {[string match "c.*" $invert([lindex $offsets 1])]} {
set offsets [lreplace $offsets 1 1]
}
switch -exact -- $invert([lindex $offsets 1]) {
url - end-bold {
if {$offset(bold) > 0} {
append result \
[string range $text 0 [expr {$offset(bold)-1}]]
}
set body [string range $text [expr {$offset(bold)+3}] \
[expr {$offset(end-bold)-1}]]
set text [string range $text[set text ""] \
[expr {$offset(end-bold)+4}] end]
regsub {http://[\w/.-]+} $body {<a href="&">&</a>} body
append result <b> [cross-reference $body] </b>
continue
|
| ︙ | ︙ | |||
935 936 937 938 939 940 941 |
}
default {
return [reference-error "Uncaught bold case" $text]
}
}
}
c.tk - c.ttk - c.tcl - c.tdbc - c.itcl {
| > | | > > | > > | > | 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 |
}
default {
return [reference-error "Uncaught bold case" $text]
}
}
}
c.tk - c.ttk - c.tcl - c.tdbc - c.itcl {
if {[lindex $offsets 0] > 0} {
append result [string range $text 0 \
[expr {[lindex $offsets 0]-1}]]
}
regexp -indices -start [lindex $offsets 0] {\w+} $text range
set body [string range $text {*}$range]
set text [string range $text[set text ""] \
[expr {[lindex $range 1]+1}] end]
append result [cross-reference $body]
continue
}
Tcl1 - Tcl2 {
set off [lindex $offsets 0]
if {$off > 0} {
append result [string range $text 0 [expr {$off-1}]]
}
set text [string range $text[set text ""] [expr {$off+3}] end]
append result [cross-reference Tcl]
continue
}
url {
set off [lindex $offsets 0]
if {$off > 0} {
append result [string range $text 0 [expr {$off-1}]]
}
regexp -indices -start $off {http://[\w/.-]+} $text range
set url [string range $text {*}$range]
append result "<a href=\"[string trimright $url .]\">$url</a>"
set text [string range $text[set text ""] \
[expr {[lindex $range 1]+1}] end]
continue
}
|
| ︙ | ︙ |
Changes to tools/tcltk-man2html.tcl.
| ︙ | ︙ | |||
15 16 17 18 19 20 21 | # 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. # | | | | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | # Note well, this program is a hack rather than a piece of software # engineering. In that sense it's probably a good example of things # that a scripting language, like Tcl, can do well. It is offered as # an example of how someone might convert a specific set of man pages # into hypertext, not as a general solution to the problem. If you # try to use this, you'll be very much on your own. # # Copyright © 1995-1997 Roger E. Critchlow Jr # Copyright © 2004-2010 Donal K. Fellows set ::Version "50/8.7" set ::CSSFILE "docs.css" ## ## Source the utility functions that provide most of the ## implementation of the transformation from nroff to html. |
| ︙ | ︙ | |||
678 679 680 681 682 683 684 |
ttk_menubutton.n {flush}
ttk_notebook.n {image text}
ttk_progressbar.n {variable}
ttk_radiobutton.n {variable}
ttk_scale.n {variable}
ttk_scrollbar.n {set}
ttk_spinbox.n {format}
| | | 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 |
ttk_menubutton.n {flush}
ttk_notebook.n {image text}
ttk_progressbar.n {variable}
ttk_radiobutton.n {variable}
ttk_scale.n {variable}
ttk_scrollbar.n {set}
ttk_spinbox.n {format}
ttk_treeview.n {text open focus selection}
ttk_widget.n {image text variable}
TclZlib.3 {binary flush filename text}
}
array set exclude_when_followed_by_map {
canvas.n {
bind widget
focus widget
|
| ︙ | ︙ |
Changes to tools/tsdPerf.c.
1 2 | #include <tcl.h> | | | 1 2 3 4 5 6 7 8 9 10 |
#include <tcl.h>
extern DLLEXPORT Tcl_LibraryInitProc Tsdperf_Init;
static Tcl_ThreadDataKey key;
typedef struct {
Tcl_WideInt value;
} TsdPerf;
|
| ︙ | ︙ |
Changes to tools/uniParse.tcl.
1 2 3 4 5 6 7 8 | # 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 |
# uniParse.tcl --
#
# This program parses the UnicodeData file and generates the
# corresponding tclUniData.c file with compressed character
# data tables. The input to this program should be the latest
# UnicodeData file from:
# ftp://ftp.unicode.org/Public/UNIDATA/UnicodeData.txt
#
# Copyright © 1998-1999 Scriptics Corporation.
# All rights reserved.
namespace eval uni {
set shift 5; # number of bits of data within a page
# This value can be adjusted to find the
# best split to minimize table size
|
| ︙ | ︙ | |||
181 182 183 184 185 186 187 |
puts $f "/*
* 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.
*
| | | 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 |
puts $f "/*
* tclUniData.c --
*
* Declarations of Unicode character information tables. This file is
* automatically generated by the tools/uniParse.tcl script. Do not
* modify this file by hand.
*
* Copyright © 1998 Scriptics Corporation.
* All rights reserved.
*/
/*
* A 16-bit Unicode character is split into two parts in order to index
* into the following tables. The lower OFFSET_BITS comprise an offset
* into a page of characters. The upper bits comprise the page number.
|
| ︙ | ︙ |
Changes to unix/Makefile.in.
| ︙ | ︙ | |||
205 206 207 208 209 210 211 |
# Generic lib name used in rules that apply to tcl and tk
LIB_FILE = ${TCL_LIB_FILE}
TCL_LIB_FLAG = @TCL_LIB_FLAG@
#TCL_LIB_FLAG = -ltcl
# support for embedded libraries on Darwin / Mac OS X
| | | 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 |
# Generic lib name used in rules that apply to tcl and tk
LIB_FILE = ${TCL_LIB_FILE}
TCL_LIB_FLAG = @TCL_LIB_FLAG@
#TCL_LIB_FLAG = -ltcl
# support for embedded libraries on Darwin / Mac OS X
DYLIB_INSTALL_DIR = $(libdir)
#--------------------------------------------------------------------------
# The information below is modified by the configure script when Makefile is
# generated from Makefile.in. You shouldn't normally modify any of this stuff
# by hand.
#--------------------------------------------------------------------------
|
| ︙ | ︙ | |||
264 265 266 267 268 269 270 271 272 273 274 275 276 277 | GDB = gdb LLDB = lldb TRACE = strace TRACE_OPTS = VALGRIND = valgrind VALGRINDARGS = --tool=memcheck --num-callers=24 \ --leak-resolution=high --leak-check=yes --show-reachable=yes -v \ --suppressions=$(TOOL_DIR)/valgrind_suppress #-------------------------------------------------------------------------- # The information below should be usable as is. The configure script won't # modify it and you shouldn't need to modify it either. #-------------------------------------------------------------------------- | > | 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 | GDB = gdb LLDB = lldb TRACE = strace TRACE_OPTS = VALGRIND = valgrind VALGRINDARGS = --tool=memcheck --num-callers=24 \ --leak-resolution=high --leak-check=yes --show-reachable=yes -v \ --keep-debuginfo=yes \ --suppressions=$(TOOL_DIR)/valgrind_suppress #-------------------------------------------------------------------------- # The information below should be usable as is. The configure script won't # modify it and you shouldn't need to modify it either. #-------------------------------------------------------------------------- |
| ︙ | ︙ | |||
667 668 669 670 671 672 673 | $(UNIX_DIR)/tclUnixTime.c \ $(UNIX_DIR)/tclUnixInit.c \ $(UNIX_DIR)/tclUnixCompat.c NOTIFY_SRCS = \ $(UNIX_DIR)/tclEpollNotfy.c \ $(UNIX_DIR)/tclKqueueNotfy.c \ | | > | 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 | $(UNIX_DIR)/tclUnixTime.c \ $(UNIX_DIR)/tclUnixInit.c \ $(UNIX_DIR)/tclUnixCompat.c NOTIFY_SRCS = \ $(UNIX_DIR)/tclEpollNotfy.c \ $(UNIX_DIR)/tclKqueueNotfy.c \ $(UNIX_DIR)/tclSelectNotfy.c \ $(UNIX_DIR)/tclUnixNotfy.c DL_SRCS = \ $(UNIX_DIR)/tclLoadAix.c \ $(UNIX_DIR)/tclLoadDl.c \ $(UNIX_DIR)/tclLoadDl2.c \ $(UNIX_DIR)/tclLoadDld.c \ $(UNIX_DIR)/tclLoadDyld.c \ |
| ︙ | ︙ | |||
897 898 899 900 901 902 903 |
test: test-tcl test-packages
test-tcl: ${TCLTEST_EXE}
$(SHELL_ENV) ./${TCLTEST_EXE} $(TOP_DIR)/tests/all.tcl $(TESTFLAGS)
gdb-test: ${TCLTEST_EXE}
| | < | < < < < | | | 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 |
test: test-tcl test-packages
test-tcl: ${TCLTEST_EXE}
$(SHELL_ENV) ./${TCLTEST_EXE} $(TOP_DIR)/tests/all.tcl $(TESTFLAGS)
gdb-test: ${TCLTEST_EXE}
$(SHELL_ENV) $(GDB) --args ./${TCLTEST_EXE} $(TOP_DIR)/tests/all.tcl \
$(TESTFLAGS) -singleproc 1
lldb-test: ${TCLTEST_EXE}
$(SHELL_ENV) $(LLDB) -- ./${TCLTEST_EXE} $(TOP_DIR)/tests/all.tcl \
$(TESTFLAGS) -singleproc 1
# Useful target to launch a built tcltest with the proper path,...
runtest: ${TCLTEST_EXE}
$(SHELL_ENV) ./${TCLTEST_EXE}
# Useful target for running the test suite with an unwritable current
# directory...
|
| ︙ | ︙ | |||
1011 1012 1013 1014 1015 1016 1017 | install-libraries: libraries @for i in "$(SCRIPT_INSTALL_DIR)" "$(MODULE_INSTALL_DIR)"; \ do \ if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(INSTALL_DATA_DIR) "$$i"; \ fi; \ | | | > | | | < < | > | | | | | | | 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 | install-libraries: libraries @for i in "$(SCRIPT_INSTALL_DIR)" "$(MODULE_INSTALL_DIR)"; \ do \ if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(INSTALL_DATA_DIR) "$$i"; \ fi; \ done; @for i in opt0.4 cookiejar0.2 encoding; \ do \ if [ ! -d "$(SCRIPT_INSTALL_DIR)/$$i" ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)/$$i"; \ else true; \ fi; \ done; @for i in 8.4 8.4/platform 8.5 8.6 8.7; \ do \ if [ ! -d "$(MODULE_INSTALL_DIR)/$$i" ] ; then \ echo "Making directory $(MODULE_INSTALL_DIR)/$$i"; \ $(INSTALL_DATA_DIR) "$(MODULE_INSTALL_DIR)/$$i"; \ fi; \ done; @echo "Installing library files to $(SCRIPT_INSTALL_DIR)/" @for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex \ $(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@ ; do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \ done; @echo "Installing package cookiejar 0.2 files to $(SCRIPT_INSTALL_DIR)/cookiejar0.2/" @for i in $(TOP_DIR)/library/cookiejar/*.tcl \ $(TOP_DIR)/library/cookiejar/*.gz; \ do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \ done @echo "Installing package http 2.10a1 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl \ "$(MODULE_INSTALL_DIR)/8.6/http-2.10a1.tm" @echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/" @for i in $(TOP_DIR)/library/opt/*.tcl; do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done @echo "Installing package msgcat 1.7.1 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl \ "$(MODULE_INSTALL_DIR)/8.7/msgcat-1.7.1.tm" @echo "Installing package tcltest 2.5.4 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl \ "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.4.tm" @echo "Installing package platform 1.0.18 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl \ "$(MODULE_INSTALL_DIR)/8.4/platform-1.0.18.tm" @echo "Installing package platform::shell 1.1.4 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl \ "$(MODULE_INSTALL_DIR)/8.4/platform/shell-1.1.4.tm" @echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/" @for i in $(TOP_DIR)/library/encoding/*.enc; do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/encoding"; \ done |
| ︙ | ︙ | |||
1312 1313 1314 1315 1316 1317 1318 | tclEnsemble.o: $(GENERIC_DIR)/tclEnsemble.c $(COMPILEHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEnsemble.c tclEnv.o: $(GENERIC_DIR)/tclEnv.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEnv.c | | | 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 | tclEnsemble.o: $(GENERIC_DIR)/tclEnsemble.c $(COMPILEHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEnsemble.c tclEnv.o: $(GENERIC_DIR)/tclEnv.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEnv.c tclEvent.o: $(GENERIC_DIR)/tclEvent.c tclUuid.h $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEvent.c tclExecute.o: $(GENERIC_DIR)/tclExecute.c $(COMPILEHDR) $(MATHHDRS) $(NREHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclExecute.c tclFCmd.o: $(GENERIC_DIR)/tclFCmd.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclFCmd.c |
| ︙ | ︙ | |||
1519 1520 1521 1522 1523 1524 1525 | tclVar.o: $(GENERIC_DIR)/tclVar.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclVar.c tclZlib.o: $(GENERIC_DIR)/tclZlib.c $(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZlib.c tclZipfs.o: $(GENERIC_DIR)/tclZipfs.c | | | | 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 | tclVar.o: $(GENERIC_DIR)/tclVar.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclVar.c tclZlib.o: $(GENERIC_DIR)/tclZlib.c $(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZlib.c tclZipfs.o: $(GENERIC_DIR)/tclZipfs.c $(CC) -c $(CC_SWITCHES) -D_GNU_SOURCE \ -DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \ -DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip \ $(GENERIC_DIR)/tclZipfs.c tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS) tclUuid.h $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.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 |
| ︙ | ︙ | |||
1768 1769 1770 1771 1772 1773 1774 | tclUnixFCmd.o: $(UNIX_DIR)/tclUnixFCmd.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixFCmd.c tclUnixFile.o: $(UNIX_DIR)/tclUnixFile.c $(FSHDR) $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixFile.c | | | | | 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 | tclUnixFCmd.o: $(UNIX_DIR)/tclUnixFCmd.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixFCmd.c tclUnixFile.o: $(UNIX_DIR)/tclUnixFile.c $(FSHDR) $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixFile.c tclEpollNotfy.o: $(UNIX_DIR)/tclEpollNotfy.c $(UNIX_DIR)/tclUnixNotfy.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclEpollNotfy.c tclKqueueNotfy.o: $(UNIX_DIR)/tclKqueueNotfy.c $(UNIX_DIR)/tclUnixNotfy.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclKqueueNotfy.c tclSelectNotfy.o: $(UNIX_DIR)/tclSelectNotfy.c $(UNIX_DIR)/tclUnixNotfy.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclSelectNotfy.c tclUnixPipe.o: $(UNIX_DIR)/tclUnixPipe.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixPipe.c tclUnixSock.o: $(UNIX_DIR)/tclUnixSock.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixSock.c |
| ︙ | ︙ | |||
2225 2226 2227 2228 2229 2230 2231 2232 2233 | $(UNIX_DIR)/configure: $(UNIX_DIR)/configure.ac $(UNIX_DIR)/tcl.m4 \ $(UNIX_DIR)/aclocal.m4 cd $(UNIX_DIR); autoconf $(MAC_OSX_DIR)/configure: $(MAC_OSX_DIR)/configure.ac $(UNIX_DIR)/configure cd $(MAC_OSX_DIR); autoconf $(UNIX_DIR)/tclConfig.h.in: $(MAC_OSX_DIR)/configure cd $(MAC_OSX_DIR); autoheader; touch $@ $(TOP_DIR)/manifest.uuid: | > > > > > | | > > > | 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 |
$(UNIX_DIR)/configure: $(UNIX_DIR)/configure.ac $(UNIX_DIR)/tcl.m4 \
$(UNIX_DIR)/aclocal.m4
cd $(UNIX_DIR); autoconf
$(MAC_OSX_DIR)/configure: $(MAC_OSX_DIR)/configure.ac $(UNIX_DIR)/configure
cd $(MAC_OSX_DIR); autoconf
$(UNIX_DIR)/tclConfig.h.in: $(MAC_OSX_DIR)/configure
cd $(MAC_OSX_DIR); autoheader; touch $@
tclUuid.h: $(TOP_DIR)/manifest.uuid
echo "#define TCL_VERSION_UUID \\" >$@
cat $(TOP_DIR)/manifest.uuid >>$@
echo "" >>$@
$(TOP_DIR)/manifest.uuid:
printf "git-" >$(TOP_DIR)/manifest.uuid
(cd $(TOP_DIR); git rev-parse HEAD >>$(TOP_DIR)/manifest.uuid || \
(printf "svn-r" >$(TOP_DIR)/manifest.uuid ; \
svn info --show-item last-changed-revision >>$(TOP_DIR)/manifest.uuid) || \
printf "unknown" >$(TOP_DIR)/manifest.uuid)
dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in genstubs \
$(MAC_OSX_DIR)/configure $(TOP_DIR)/manifest.uuid dist-packages ${NATIVE_TCLSH}
rm -rf $(DISTDIR)
mkdir -p $(DISTDIR)/unix
cp -p $(TOP_DIR)/manifest.uuid $(DISTDIR)
cp -p $(UNIX_DIR)/*.[ch] $(DISTDIR)/unix
|
| ︙ | ︙ | |||
2263 2264 2265 2266 2267 2268 2269 | cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \ $(TOP_DIR)/library/manifest.txt \ $(TOP_DIR)/library/tclIndex $(DISTDIR)/library @for i in $(BUILTIN_PACKAGE_LIST); do \ mkdir $(DISTDIR)/library/$$i;\ cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \ done | | > > > > > | | > > | | 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 | cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \ $(TOP_DIR)/library/manifest.txt \ $(TOP_DIR)/library/tclIndex $(DISTDIR)/library @for i in $(BUILTIN_PACKAGE_LIST); do \ mkdir $(DISTDIR)/library/$$i;\ cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \ done cp -p $(TOP_DIR)/library/cookiejar/*.dat.gz $(DISTDIR)/library/cookiejar @mkdir $(DISTDIR)/library/encoding cp -p $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding @mkdir $(DISTDIR)/library/msgs cp -p $(TOP_DIR)/library/msgs/*.msg $(DISTDIR)/library/msgs @echo cp -r $(TOP_DIR)/library/tzdata $(DISTDIR)/library/tzdata @( cd $(TOP_DIR); find library/tzdata -type f -print ) \ | ( cd $(TOP_DIR) ; xargs tar cf - ) \ | ( cd $(DISTDIR) ; tar xfp - ) @mkdir $(DISTDIR)/doc cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \ $(TOP_DIR)/doc/man.macros $(DISTDIR)/doc @mkdir $(DISTDIR)/compat cp -p $(TOP_DIR)/license.terms $(COMPAT_DIR)/*.[ch] \ $(COMPAT_DIR)/README $(DISTDIR)/compat @mkdir $(DISTDIR)/compat/zlib @echo cp -r $(COMPAT_DIR)/zlib $(DISTDIR)/compat/zlib @( cd $(COMPAT_DIR)/zlib; find . -type f -print ) \ | ( cd $(COMPAT_DIR)/zlib ; xargs tar cf - ) \ | ( cd $(DISTDIR)/compat/zlib ; tar xfp - ) @mkdir $(DISTDIR)/libtommath @echo cp -r $(TOP_DIR)/libtommath $(DISTDIR)/libtommath @( cd $(TOP_DIR)/libtommath; find . -type f -print ) \ | ( cd $(TOP_DIR)/libtommath ; xargs tar cf - ) \ | ( cd $(DISTDIR)/libtommath ; tar xfp - ) @mkdir $(DISTDIR)/tests cp -p $(TOP_DIR)/license.terms $(DISTDIR)/tests cp -p $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \ $(TOP_DIR)/tests/httpd $(TOP_DIR)/tests/*.tcl \ $(TOP_DIR)/tests/auto-files.zip $(DISTDIR)/tests @mkdir $(DISTDIR)/tests/auto0 for i in auto1 auto2 ; \ do \ mkdir $(DISTDIR)/tests/auto0/$$i ;\ cp -p $(TOP_DIR)/tests/auto0/$$i/tclIndex $(TOP_DIR)/tests/auto0/$$i/*.tcl \ $(DISTDIR)/tests/auto0/$$i; \ done; for i in modules modules/mod1 modules/mod2 ; \ do \ mkdir $(DISTDIR)/tests/auto0/$$i ;\ cp -p $(TOP_DIR)/tests/auto0/$$i/*.tm \ $(DISTDIR)/tests/auto0/$$i; \ done; @mkdir $(DISTDIR)/win cp -p $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win cp -p $(TOP_DIR)/win/configure.ac $(TOP_DIR)/win/configure \ $(TOP_DIR)/win/tclConfig.sh.in $(TOP_DIR)/win/tclooConfig.sh \ $(TOP_DIR)/win/tcl.m4 $(TOP_DIR)/win/aclocal.m4 \ $(TOP_DIR)/win/tclsh.exe.manifest.in $(TOP_DIR)/win/tclUuid.h.in \ $(TOP_DIR)/win/gitmanifest.in $(TOP_DIR)/win/svnmanifest.in \ $(TOP_DIR)/win/x86_64-w64-mingw32-nmakehlp.exe $(DISTDIR)/win chmod 775 $(DISTDIR)/win/x86_64-w64-mingw32-nmakehlp.exe cp -p $(TOP_DIR)/win/*.[ch] $(TOP_DIR)/win/*.ico $(TOP_DIR)/win/*.rc \ $(DISTDIR)/win cp -p $(TOP_DIR)/win/*.bat $(DISTDIR)/win cp -p $(TOP_DIR)/win/*.vc $(DISTDIR)/win cp -p $(TOP_DIR)/win/tcl.ds* $(DISTDIR)/win cp -p $(TOP_DIR)/win/README $(DISTDIR)/win cp -p $(TOP_DIR)/license.terms $(DISTDIR)/win |
| ︙ | ︙ | |||
2336 2337 2338 2339 2340 2341 2342 | @mkdir $(DISTDIR)/unix/dltest cp -p $(UNIX_DIR)/dltest/*.c $(UNIX_DIR)/dltest/Makefile.in \ $(UNIX_DIR)/dltest/README $(DISTDIR)/unix/dltest @mkdir $(DISTDIR)/tools cp -p $(TOOL_DIR)/README $(TOOL_DIR)/*.c $(TOOL_DIR)/*.svg \ $(TOOL_DIR)/*.tcl $(TOOL_DIR)/*.bmp \ $(TOOL_DIR)/valgrind_suppress $(DISTDIR)/tools | < < | 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 | @mkdir $(DISTDIR)/unix/dltest cp -p $(UNIX_DIR)/dltest/*.c $(UNIX_DIR)/dltest/Makefile.in \ $(UNIX_DIR)/dltest/README $(DISTDIR)/unix/dltest @mkdir $(DISTDIR)/tools cp -p $(TOOL_DIR)/README $(TOOL_DIR)/*.c $(TOOL_DIR)/*.svg \ $(TOOL_DIR)/*.tcl $(TOOL_DIR)/*.bmp \ $(TOOL_DIR)/valgrind_suppress $(DISTDIR)/tools @mkdir $(DISTDIR)/pkgs cp -p $(TOP_DIR)/pkgs/README $(DISTDIR)/pkgs cp -p $(TOP_DIR)/pkgs/package.list.txt $(DISTDIR)/pkgs for i in `ls $(DISTROOT)/pkgs/*.tar.gz 2> /dev/null`; do \ tar -C $(DISTDIR)/pkgs -xzf "$$i"; \ done cp -p $(TOP_DIR)/.travis.yml $(DISTDIR) |
| ︙ | ︙ | |||
2384 2385 2386 2387 2388 2389 2390 |
html-tk: ${NATIVE_TCLSH}
$(BUILD_HTML) --tk
@EXTRA_BUILD_HTML@
BUILD_HTML = \
@${NATIVE_TCLSH} $(TOOL_DIR)/tcltk-man2html.tcl \
| | > | 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 |
html-tk: ${NATIVE_TCLSH}
$(BUILD_HTML) --tk
@EXTRA_BUILD_HTML@
BUILD_HTML = \
@${NATIVE_TCLSH} $(TOOL_DIR)/tcltk-man2html.tcl \
--useversion=$(MAJOR_VERSION).$(MINOR_VERSION) \
--htmldir="$(HTML_INSTALL_DIR)" \
--srcdir=$(TOP_DIR) $(BUILD_HTML_FLAGS)
#--------------------------------------------------------------------------
# The list of all the targets that do not correspond to real files. This stops
# 'make' from getting confused when someone makes an error in a rule.
#--------------------------------------------------------------------------
|
| ︙ | ︙ |
Changes to unix/README.
1 2 3 4 5 6 7 8 9 10 | Tcl UNIX README --------------- This is the directory where you configure, compile, test, and install UNIX versions of Tcl. This directory also contains source files for Tcl that are specific to UNIX. Some of the files in this directory are used on the PC or MacOSX platform too, but they all depend on UNIX (POSIX/ANSI C) interfaces and some of them only make sense under UNIX. Updated forms of the information found in this file is available at: | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | Tcl UNIX README --------------- This is the directory where you configure, compile, test, and install UNIX versions of Tcl. This directory also contains source files for Tcl that are specific to UNIX. Some of the files in this directory are used on the PC or MacOSX platform too, but they all depend on UNIX (POSIX/ANSI C) interfaces and some of them only make sense under UNIX. Updated forms of the information found in this file is available at: https://www.tcl-tk.org/doc/howto/compile.html#unix For information on platforms where Tcl is known to compile, along with any porting notes for getting it to work on those platforms, see: https://www.tcl-tk.org/software/tcltk/platforms.html The rest of this file contains instructions on how to do this. The release should compile and run either "out of the box" or with trivial changes on any UNIX-like system that approximates POSIX, BSD, or System V. We know that it runs on workstations from Sun, H-P, DEC, IBM, and SGI, as well as PCs running Linux, BSDI, and SCO UNIX. To compile for a PC running Windows, see the README file in the directory ../win. To compile for MacOSX, see the README file in |
| ︙ | ︙ | |||
85 86 87 88 89 90 91 | is also enabled). If STRING is omitted, defaults to 'tcl'. --enable-man-compression=PROG Compress the manpages using PROG. --enable-dtrace Enable tcl DTrace provider (if DTrace is available on the platform), c.f. tclDTrace.d for descriptions of the probes made available, | | | 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 | is also enabled). If STRING is omitted, defaults to 'tcl'. --enable-man-compression=PROG Compress the manpages using PROG. --enable-dtrace Enable tcl DTrace provider (if DTrace is available on the platform), c.f. tclDTrace.d for descriptions of the probes made available, see https://wiki.tcl-lang.org/page/DTrace for more details --with-encoding=ENCODING Specifies the encoding for compile-time configuration values. Defaults to utf-8, which is also sufficient for ASCII. --with-tzdata=FLAG Specifies whether to install timezone data. By default, the configure script tries to detect whether a usable timezone database is present on the system already. |
| ︙ | ︙ |
Changes to unix/configure.
1 2 | #! /bin/sh # Guess values for system-dependent variables and create Makefiles. | | | > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | #! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.71 for tcl 8.7. # # # Copyright (C) 1992-1996, 1998-2017, 2020-2021 Free Software Foundation, # Inc. # # # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## -------------------- ## ## M4sh Initialization. ## ## -------------------- ## |
| ︙ | ︙ | |||
1547 1548 1549 1550 1551 1552 1553 | done fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF tcl configure 8.7 | | | | 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 | done fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF tcl configure 8.7 generated by GNU Autoconf 2.71 Copyright (C) 2021 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit fi ## ------------------------ ## |
| ︙ | ︙ | |||
1779 1780 1781 1782 1783 1784 1785 |
eval ac_res=\$$3
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
printf "%s\n" "$ac_res" >&6; }
eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
} # ac_fn_c_check_func
| | | | | < | < > | < > | 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 |
eval ac_res=\$$3
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
printf "%s\n" "$ac_res" >&6; }
eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
} # ac_fn_c_check_func
# ac_fn_check_decl LINENO SYMBOL VAR INCLUDES EXTRA-OPTIONS FLAG-VAR
# ------------------------------------------------------------------
# Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR
# accordingly. Pass EXTRA-OPTIONS to the compiler, using FLAG-VAR.
ac_fn_check_decl ()
{
as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
as_decl_name=`echo $2|sed 's/ *(.*//'`
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5
printf %s "checking whether $as_decl_name is declared... " >&6; }
if eval test \${$3+y}
then :
printf %s "(cached) " >&6
else $as_nop
as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'`
eval ac_save_FLAGS=\$$6
as_fn_append $6 " $5"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
$4
int
main (void)
{
#ifndef $as_decl_name
|
| ︙ | ︙ | |||
1822 1823 1824 1825 1826 1827 1828 | if ac_fn_c_try_compile "$LINENO" then : eval "$3=yes" else $as_nop eval "$3=no" fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext | > | | | 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 |
if ac_fn_c_try_compile "$LINENO"
then :
eval "$3=yes"
else $as_nop
eval "$3=no"
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
eval $6=\$ac_save_FLAGS
fi
eval ac_res=\$$3
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
printf "%s\n" "$ac_res" >&6; }
eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
} # ac_fn_check_decl
# ac_fn_c_check_type LINENO TYPE VAR INCLUDES
# -------------------------------------------
# Tests whether TYPE exists after having included INCLUDES, setting cache
# variable VAR accordingly.
ac_fn_c_check_type ()
{
|
| ︙ | ︙ | |||
2015 2016 2017 2018 2019 2020 2021 | esac cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by tcl $as_me 8.7, which was | | | 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 |
esac
cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
It was created by tcl $as_me 8.7, which was
generated by GNU Autoconf 2.71. Invocation command line was
$ $0$ac_configure_args_raw
_ACEOF
exec 5>>config.log
{
cat <<_ASUNAME
|
| ︙ | ︙ | |||
2679 2680 2681 2682 2683 2684 2685 | TCL_VERSION=8.7 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=7 | | | 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 |
TCL_VERSION=8.7
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=7
TCL_PATCH_LEVEL="a6"
VERSION=${TCL_VERSION}
EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"}
EXTRA_BUILD_HTML=${EXTRA_BUILD_HTML:-"@:"}
#------------------------------------------------------------------------
# Setup configure arguments for bundled packages
|
| ︙ | ︙ | |||
3646 3647 3648 3649 3650 3651 3652 |
else
if test "$GCC" = yes; then
CFLAGS="-O2"
else
CFLAGS=
fi
fi
| > > > | | 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 |
else
if test "$GCC" = yes; then
CFLAGS="-O2"
else
CFLAGS=
fi
fi
ac_prog_cc_stdc=no
if test x$ac_prog_cc_stdc = xno
then :
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C11 features" >&5
printf %s "checking for $CC option to enable C11 features... " >&6; }
if test ${ac_cv_prog_cc_c11+y}
then :
printf %s "(cached) " >&6
else $as_nop
ac_cv_prog_cc_c11=no
ac_save_CC=$CC
|
| ︙ | ︙ | |||
3670 3671 3672 3673 3674 3675 3676 | ac_cv_prog_cc_c11=$ac_arg fi rm -f core conftest.err conftest.$ac_objext conftest.beam test "x$ac_cv_prog_cc_c11" != "xno" && break done rm -f conftest.$ac_ext CC=$ac_save_CC | < | < | | | | | > > | | | < < | | | > | < > > | | | | < | < | | | | | > > | | | < < | | | > | < > > | | | < < | < | | | | | > > | | | < < | | < | < < > | < | < < < < | 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 |
ac_cv_prog_cc_c11=$ac_arg
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam
test "x$ac_cv_prog_cc_c11" != "xno" && break
done
rm -f conftest.$ac_ext
CC=$ac_save_CC
fi
if test "x$ac_cv_prog_cc_c11" = xno
then :
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5
printf "%s\n" "unsupported" >&6; }
else $as_nop
if test "x$ac_cv_prog_cc_c11" = x
then :
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5
printf "%s\n" "none needed" >&6; }
else $as_nop
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5
printf "%s\n" "$ac_cv_prog_cc_c11" >&6; }
CC="$CC $ac_cv_prog_cc_c11"
fi
ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11
ac_prog_cc_stdc=c11
fi
fi
if test x$ac_prog_cc_stdc = xno
then :
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C99 features" >&5
printf %s "checking for $CC option to enable C99 features... " >&6; }
if test ${ac_cv_prog_cc_c99+y}
then :
printf %s "(cached) " >&6
else $as_nop
ac_cv_prog_cc_c99=no
ac_save_CC=$CC
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
$ac_c_conftest_c99_program
_ACEOF
for ac_arg in '' -std=gnu99 -std=c99 -c99 -qlanglvl=extc1x -qlanglvl=extc99 -AC99 -D_STDC_C99=
do
CC="$ac_save_CC $ac_arg"
if ac_fn_c_try_compile "$LINENO"
then :
ac_cv_prog_cc_c99=$ac_arg
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam
test "x$ac_cv_prog_cc_c99" != "xno" && break
done
rm -f conftest.$ac_ext
CC=$ac_save_CC
fi
if test "x$ac_cv_prog_cc_c99" = xno
then :
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5
printf "%s\n" "unsupported" >&6; }
else $as_nop
if test "x$ac_cv_prog_cc_c99" = x
then :
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5
printf "%s\n" "none needed" >&6; }
else $as_nop
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5
printf "%s\n" "$ac_cv_prog_cc_c99" >&6; }
CC="$CC $ac_cv_prog_cc_c99"
fi
ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99
ac_prog_cc_stdc=c99
fi
fi
if test x$ac_prog_cc_stdc = xno
then :
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C89 features" >&5
printf %s "checking for $CC option to enable C89 features... " >&6; }
if test ${ac_cv_prog_cc_c89+y}
then :
printf %s "(cached) " >&6
else $as_nop
ac_cv_prog_cc_c89=no
ac_save_CC=$CC
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
$ac_c_conftest_c89_program
_ACEOF
for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
do
CC="$ac_save_CC $ac_arg"
if ac_fn_c_try_compile "$LINENO"
then :
ac_cv_prog_cc_c89=$ac_arg
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam
test "x$ac_cv_prog_cc_c89" != "xno" && break
done
rm -f conftest.$ac_ext
CC=$ac_save_CC
fi
if test "x$ac_cv_prog_cc_c89" = xno
then :
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5
printf "%s\n" "unsupported" >&6; }
else $as_nop
if test "x$ac_cv_prog_cc_c89" = x
then :
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5
printf "%s\n" "none needed" >&6; }
else $as_nop
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5
printf "%s\n" "$ac_cv_prog_cc_c89" >&6; }
CC="$CC $ac_cv_prog_cc_c89"
fi
ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89
ac_prog_cc_stdc=c89
fi
fi
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
|
| ︙ | ︙ | |||
4408 4409 4410 4411 4412 4413 4414 |
fi
#--------------------------------------------------------------------
# Look for libraries that we will need when compiling the Tcl shell
#--------------------------------------------------------------------
| < < < < < < < < < | | | > > > > > | | | | | | | | | > < < | < < | | < < < | | < < < < < < < < < < < < > > > | | | > > > | > > | | > | 4402 4403 4404 4405 4406 4407 4408 4409 4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 4470 4471 4472 4473 4474 4475 4476 4477 4478 4479 4480 4481 4482 4483 4484 4485 4486 4487 4488 4489 4490 4491 4492 4493 |
fi
#--------------------------------------------------------------------
# Look for libraries that we will need when compiling the Tcl shell
#--------------------------------------------------------------------
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC options needed to detect all undeclared functions" >&5
printf %s "checking for $CC options needed to detect all undeclared functions... " >&6; }
if test ${ac_cv_c_undeclared_builtin_options+y}
then :
printf %s "(cached) " >&6
else $as_nop
ac_save_CFLAGS=$CFLAGS
ac_cv_c_undeclared_builtin_options='cannot detect'
for ac_arg in '' -fno-builtin; do
CFLAGS="$ac_save_CFLAGS $ac_arg"
# This test program should *not* compile successfully.
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
main (void)
{
(void) strchr;
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
else $as_nop
# This test program should compile successfully.
# No library function is consistently available on
# freestanding implementations, so test against a dummy
# declaration. Include always-available headers on the
# off chance that they somehow elicit warnings.
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <float.h>
#include <limits.h>
#include <stdarg.h>
#include <stddef.h>
extern void ac_decl (int, char *);
int
main (void)
{
(void) ac_decl (0, (char *) 0);
(void) ac_decl;
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
if test x"$ac_arg" = x
then :
ac_cv_c_undeclared_builtin_options='none needed'
else $as_nop
ac_cv_c_undeclared_builtin_options=$ac_arg
fi
break
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
done
CFLAGS=$ac_save_CFLAGS
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_undeclared_builtin_options" >&5
printf "%s\n" "$ac_cv_c_undeclared_builtin_options" >&6; }
case $ac_cv_c_undeclared_builtin_options in #(
'cannot detect') :
{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;}
as_fn_error $? "cannot make $CC report undeclared builtins
See \`config.log' for more details" "$LINENO" 5; } ;; #(
'none needed') :
ac_c_undeclared_builtin_options='' ;; #(
*) :
ac_c_undeclared_builtin_options=$ac_cv_c_undeclared_builtin_options ;;
esac
#--------------------------------------------------------------------
# On a few very rare systems, all of the libm.a stuff is
# already in libc.a. Set compiler flags accordingly.
#--------------------------------------------------------------------
|
| ︙ | ︙ | |||
4971 4972 4973 4974 4975 4976 4977 |
printf "%s\n" "#define HAVE_PTHREAD_ATFORK 1" >>confdefs.h
fi
LIBS=$ac_saved_libs
# TIP #509
| | | < | 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 |
printf "%s\n" "#define HAVE_PTHREAD_ATFORK 1" >>confdefs.h
fi
LIBS=$ac_saved_libs
# TIP #509
ac_fn_check_decl "$LINENO" "PTHREAD_MUTEX_RECURSIVE" "ac_cv_have_decl_PTHREAD_MUTEX_RECURSIVE" "#include <pthread.h>
" "$ac_c_undeclared_builtin_options" "CFLAGS"
if test "x$ac_cv_have_decl_PTHREAD_MUTEX_RECURSIVE" = xyes
then :
ac_have_decl=1
else $as_nop
ac_have_decl=0
fi
printf "%s\n" "#define HAVE_DECL_PTHREAD_MUTEX_RECURSIVE $ac_have_decl" >>confdefs.h
if test $ac_have_decl = 1
then :
tcl_ok=yes
else $as_nop
tcl_ok=no
fi
|
| ︙ | ︙ | |||
5919 5920 5921 5922 5923 5924 5925 |
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cygwin" >&5
printf "%s\n" "$ac_cv_cygwin" >&6; }
if test "$ac_cv_cygwin" = "no"; then
as_fn_error $? "${CC} is not a cygwin compiler." "$LINENO" 5
fi
do64bit_ok=yes
if test "x${SHARED_BUILD}" = "x1"; then
| | | | 5899 5900 5901 5902 5903 5904 5905 5906 5907 5908 5909 5910 5911 5912 5913 5914 5915 |
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cygwin" >&5
printf "%s\n" "$ac_cv_cygwin" >&6; }
if test "$ac_cv_cygwin" = "no"; then
as_fn_error $? "${CC} is not a cygwin compiler." "$LINENO" 5
fi
do64bit_ok=yes
if test "x${SHARED_BUILD}" = "x1"; then
echo "running cd ../win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args --enable-64bit --host=x86_64-w64-mingw32"
# The eval makes quoting arguments work.
if cd ../win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args --enable-64bit --host=x86_64-w64-mingw32; cd ../unix
then :
else
{ echo "configure: error: configure failed for ../win" 1>&2; exit 1; }
fi
fi
;;
dgux*)
|
| ︙ | ︙ | |||
6267 6268 6269 6270 6271 6272 6273 | CFLAGS="$CFLAGS -64" LDFLAGS_ARCH="-64" fi fi ;; | | > > > > > > > > > > > > > > | 6247 6248 6249 6250 6251 6252 6253 6254 6255 6256 6257 6258 6259 6260 6261 6262 6263 6264 6265 6266 6267 6268 6269 6270 6271 6272 6273 6274 6275 6276 6277 6278 6279 6280 6281 6282 6283 6284 6285 6286 6287 6288 |
CFLAGS="$CFLAGS -64"
LDFLAGS_ARCH="-64"
fi
fi
;;
Linux*|GNU*|NetBSD-Debian|DragonFly-*|FreeBSD-*)
SHLIB_CFLAGS="-fPIC -fno-common"
SHLIB_SUFFIX=".so"
CFLAGS_OPTIMIZE="-O2"
# egcs-2.91.66 on Redhat Linux 6.0 generates lots of warnings
# when you inline the string and math operations. Turn this off to
# get rid of the warnings.
#CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D__NO_STRING_INLINES -D__NO_MATH_INLINES"
SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared'
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
LDFLAGS="$LDFLAGS -Wl,--export-dynamic"
case $system in
DragonFly-*|FreeBSD-*)
if test "${TCL_THREADS}" = "1"
then :
# The -pthread needs to go in the LDFLAGS, not LIBS
LIBS=`echo $LIBS | sed s/-pthread//`
CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
LDFLAGS="$LDFLAGS $PTHREAD_LIBS"
fi
;;
esac
if test $doRpath = yes
then :
CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"'
fi
LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
if test "`uname -m`" = "alpha"
|
| ︙ | ︙ | |||
6412 6413 6414 6415 6416 6417 6418 |
fi
LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
# The -pthread needs to go in the CFLAGS, not LIBS
LIBS=`echo $LIBS | sed s/-pthread//`
CFLAGS="$CFLAGS -pthread"
LDFLAGS="$LDFLAGS -pthread"
;;
| < < < < < < < < < < < < < < < < < < < < < < < < < < < | 6406 6407 6408 6409 6410 6411 6412 6413 6414 6415 6416 6417 6418 6419 |
fi
LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
# The -pthread needs to go in the CFLAGS, not LIBS
LIBS=`echo $LIBS | sed s/-pthread//`
CFLAGS="$CFLAGS -pthread"
LDFLAGS="$LDFLAGS -pthread"
;;
Darwin-*)
CFLAGS_OPTIMIZE="-Os"
SHLIB_CFLAGS="-fno-common"
# To avoid discrepancies between what headers configure sees during
# preprocessing tests and compiling tests, move any -isysroot and
# -mmacosx-version-min flags from CFLAGS to CPPFLAGS:
CPPFLAGS="${CPPFLAGS} `echo " ${CFLAGS}" | \
|
| ︙ | ︙ | |||
6790 6791 6792 6793 6794 6795 6796 | ;; OSF1-V*) # Digital OSF/1 SHLIB_CFLAGS="" if test "$SHARED_BUILD" = 1 then : | | | | 6757 6758 6759 6760 6761 6762 6763 6764 6765 6766 6767 6768 6769 6770 6771 6772 6773 6774 6775 |
;;
OSF1-V*)
# Digital OSF/1
SHLIB_CFLAGS=""
if test "$SHARED_BUILD" = 1
then :
SHLIB_LD='${CC} -shared'
else $as_nop
SHLIB_LD='${CC} -non_shared'
fi
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
if test $doRpath = yes
then :
|
| ︙ | ︙ | |||
7200 7201 7202 7203 7204 7205 7206 |
if test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes
then :
case $system in
AIX-*) ;;
BSD/OS*) ;;
CYGWIN_*|MINGW32_*|MSYS_*) ;;
| | | | | 7167 7168 7169 7170 7171 7172 7173 7174 7175 7176 7177 7178 7179 7180 7181 7182 7183 7184 7185 7186 |
if test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes
then :
case $system in
AIX-*) ;;
BSD/OS*) ;;
CYGWIN_*|MINGW32_*|MSYS_*) ;;
HP-UX*) ;;
Darwin-*) ;;
IRIX*) ;;
Linux*|GNU*) ;;
NetBSD-*|OpenBSD-*) ;;
OSF1-*) ;;
SCO_SV-3.2*) ;;
*) SHLIB_CFLAGS="-fPIC" ;;
esac
fi
if test "$tcl_cv_cc_visibility_hidden" != yes
then :
|
| ︙ | ︙ | |||
8792 8793 8794 8795 8796 8797 8798 |
printf "%s\n" "#define HAVE_MTSAFE_GETHOSTBYADDR 1" >>confdefs.h
else
# Avoids picking hidden internal symbol from libc
| | | < | 8759 8760 8761 8762 8763 8764 8765 8766 8767 8768 8769 8770 8771 8772 8773 8774 8775 8776 8777 8778 8779 8780 |
printf "%s\n" "#define HAVE_MTSAFE_GETHOSTBYADDR 1" >>confdefs.h
else
# Avoids picking hidden internal symbol from libc
ac_fn_check_decl "$LINENO" "gethostbyname_r" "ac_cv_have_decl_gethostbyname_r" "#include <netdb.h>
" "$ac_c_undeclared_builtin_options" "CFLAGS"
if test "x$ac_cv_have_decl_gethostbyname_r" = xyes
then :
ac_have_decl=1
else $as_nop
ac_have_decl=0
fi
printf "%s\n" "#define HAVE_DECL_GETHOSTBYNAME_R $ac_have_decl" >>confdefs.h
if test $ac_have_decl = 1
then :
tcl_cv_api_gethostbyname_r=yes
else $as_nop
tcl_cv_api_gethostbyname_r=no
|
| ︙ | ︙ | |||
8961 8962 8963 8964 8965 8966 8967 |
fi
fi
# Avoids picking hidden internal symbol from libc
| | | < | 8927 8928 8929 8930 8931 8932 8933 8934 8935 8936 8937 8938 8939 8940 8941 8942 8943 8944 8945 8946 8947 8948 |
fi
fi
# Avoids picking hidden internal symbol from libc
ac_fn_check_decl "$LINENO" "gethostbyaddr_r" "ac_cv_have_decl_gethostbyaddr_r" "#include <netdb.h>
" "$ac_c_undeclared_builtin_options" "CFLAGS"
if test "x$ac_cv_have_decl_gethostbyaddr_r" = xyes
then :
ac_have_decl=1
else $as_nop
ac_have_decl=0
fi
printf "%s\n" "#define HAVE_DECL_GETHOSTBYADDR_R $ac_have_decl" >>confdefs.h
if test $ac_have_decl = 1
then :
tcl_cv_api_gethostbyaddr_r=yes
else $as_nop
tcl_cv_api_gethostbyaddr_r=no
|
| ︙ | ︙ | |||
9200 9201 9202 9203 9204 9205 9206 9207 9208 9209 9210 9211 9212 9213 |
fi
fi
if test $tcl_ok = no; then
printf "%s\n" "#define NO_FD_SET 1" >>confdefs.h
fi
#------------------------------------------------------------------------
# Options for the notifier. Checks for epoll(7) on Linux, and
# kqueue(2) on {DragonFly,Free,Net,Open}BSD
#------------------------------------------------------------------------
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for advanced notifier support" >&5
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 9165 9166 9167 9168 9169 9170 9171 9172 9173 9174 9175 9176 9177 9178 9179 9180 9181 9182 9183 9184 9185 9186 9187 9188 9189 9190 9191 9192 9193 9194 9195 9196 9197 9198 9199 9200 9201 9202 9203 9204 9205 9206 9207 9208 9209 9210 9211 9212 9213 |
fi
fi
if test $tcl_ok = no; then
printf "%s\n" "#define NO_FD_SET 1" >>confdefs.h
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for pselect" >&5
printf %s "checking for pselect... " >&6; }
if test ${tcl_cv_func_pselect+y}
then :
printf %s "(cached) " >&6
else $as_nop
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/types.h>
int
main (void)
{
void *func = pselect;
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
tcl_cv_func_pselect=yes
else $as_nop
tcl_cv_func_pselect=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_func_pselect" >&5
printf "%s\n" "$tcl_cv_func_pselect" >&6; }
tcl_ok=$tcl_cv_func_pselect
if test $tcl_ok = yes; then
printf "%s\n" "#define HAVE_PSELECT 1" >>confdefs.h
fi
#------------------------------------------------------------------------
# Options for the notifier. Checks for epoll(7) on Linux, and
# kqueue(2) on {DragonFly,Free,Net,Open}BSD
#------------------------------------------------------------------------
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for advanced notifier support" >&5
|
| ︙ | ︙ | |||
9389 9390 9391 9392 9393 9394 9395 9396 9397 9398 9399 9400 9401 9402 |
then :
printf %s "(cached) " >&6
else $as_nop
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <time.h>
int
main (void)
{
extern long timezone;
timezone += 1;
exit (0);
;
| > | 9389 9390 9391 9392 9393 9394 9395 9396 9397 9398 9399 9400 9401 9402 9403 |
then :
printf %s "(cached) " >&6
else $as_nop
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <time.h>
#include <stdlib.h>
int
main (void)
{
extern long timezone;
timezone += 1;
exit (0);
;
|
| ︙ | ︙ | |||
9427 9428 9429 9430 9431 9432 9433 9434 9435 9436 9437 9438 9439 9440 |
then :
printf %s "(cached) " >&6
else $as_nop
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <time.h>
int
main (void)
{
extern time_t timezone;
timezone += 1;
exit (0);
;
| > | 9428 9429 9430 9431 9432 9433 9434 9435 9436 9437 9438 9439 9440 9441 9442 |
then :
printf %s "(cached) " >&6
else $as_nop
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <time.h>
#include <stdlib.h>
int
main (void)
{
extern time_t timezone;
timezone += 1;
exit (0);
;
|
| ︙ | ︙ | |||
10334 10335 10336 10337 10338 10339 10340 | if test "x$ac_cv_func_mkstemps" = xyes then : printf "%s\n" "#define HAVE_MKSTEMPS 1" >>confdefs.h fi | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 10336 10337 10338 10339 10340 10341 10342 10343 10344 10345 10346 10347 10348 10349 |
if test "x$ac_cv_func_mkstemps" = xyes
then :
printf "%s\n" "#define HAVE_MKSTEMPS 1" >>confdefs.h
fi
#--------------------------------------------------------------------
# Darwin specific API checks and defines
#--------------------------------------------------------------------
if test "`uname -s`" = "Darwin" ; then
ac_fn_c_check_func "$LINENO" "getattrlist" "ac_cv_func_getattrlist"
if test "x$ac_cv_func_getattrlist" = xyes
|
| ︙ | ︙ | |||
10952 10953 10954 10955 10956 10957 10958 |
fi
TCL_SHLIB_LD_EXTRAS="-compatibility_version ${TCL_VERSION} -current_version ${TCL_VERSION}`echo ${TCL_PATCH_LEVEL} | awk '{match($0, "\\\.[0-9]+"); print substr($0,RSTART,RLENGTH)}'`"
TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -install_name "${DYLIB_INSTALL_DIR}"/${TCL_LIB_FILE}'
echo "$LDFLAGS " | grep -q -- '-prebind ' && TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -seg1addr 0xA000000'
TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -sectcreate __TEXT __info_plist Tcl-Info.plist'
EXTRA_TCLSH_LIBS='-sectcreate __TEXT __info_plist Tclsh-Info.plist'
| < | 10913 10914 10915 10916 10917 10918 10919 10920 10921 10922 10923 10924 10925 10926 |
fi
TCL_SHLIB_LD_EXTRAS="-compatibility_version ${TCL_VERSION} -current_version ${TCL_VERSION}`echo ${TCL_PATCH_LEVEL} | awk '{match($0, "\\\.[0-9]+"); print substr($0,RSTART,RLENGTH)}'`"
TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -install_name "${DYLIB_INSTALL_DIR}"/${TCL_LIB_FILE}'
echo "$LDFLAGS " | grep -q -- '-prebind ' && TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -seg1addr 0xA000000'
TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -sectcreate __TEXT __info_plist Tcl-Info.plist'
EXTRA_TCLSH_LIBS='-sectcreate __TEXT __info_plist Tclsh-Info.plist'
ac_config_files="$ac_config_files Tcl-Info.plist:../macosx/Tcl-Info.plist.in Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in"
TCL_YEAR="`date +%Y`"
fi
if test "$FRAMEWORK_BUILD" = "1" ; then
|
| ︙ | ︙ | |||
11845 11846 11847 11848 11849 11850 11851 | cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Save the log message, to keep $0 and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" This file was extended by tcl $as_me 8.7, which was | | | 11805 11806 11807 11808 11809 11810 11811 11812 11813 11814 11815 11816 11817 11818 11819 | cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Save the log message, to keep $0 and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" This file was extended by tcl $as_me 8.7, which was generated by GNU Autoconf 2.71. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ |
| ︙ | ︙ | |||
11904 11905 11906 11907 11908 11909 11910 | _ACEOF ac_cs_config=`printf "%s\n" "$ac_configure_args" | sed "$ac_safe_unquote"` ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\''/g"` cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ tcl config.status 8.7 | | | | 11864 11865 11866 11867 11868 11869 11870 11871 11872 11873 11874 11875 11876 11877 11878 11879 11880 11881 | _ACEOF ac_cs_config=`printf "%s\n" "$ac_configure_args" | sed "$ac_safe_unquote"` ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\''/g"` cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ tcl config.status 8.7 configured by $0, generated by GNU Autoconf 2.71, with options \\"\$ac_cs_config\\" Copyright (C) 2021 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." ac_pwd='$ac_pwd' srcdir='$srcdir' test -n "\$AWK" || AWK=awk _ACEOF |
| ︙ | ︙ |
Changes to unix/configure.ac.
| ︙ | ︙ | |||
22 23 24 25 26 27 28 |
/* override */ #undef PACKAGE_STRING
#endif /* _TCLCONFIG */])
])
TCL_VERSION=8.7
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=7
| | | 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 |
/* override */ #undef PACKAGE_STRING
#endif /* _TCLCONFIG */])
])
TCL_VERSION=8.7
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=7
TCL_PATCH_LEVEL="a6"
VERSION=${TCL_VERSION}
EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"}
EXTRA_BUILD_HTML=${EXTRA_BUILD_HTML:-"@:"}
#------------------------------------------------------------------------
# Setup configure arguments for bundled packages
|
| ︙ | ︙ | |||
313 314 315 316 317 318 319 320 321 322 323 324 325 326 |
AC_DEFINE(HAVE_SYS_SELECT_H, 1, [Should we include <sys/select.h>?])
tcl_ok=yes
fi
fi
if test $tcl_ok = no; then
AC_DEFINE(NO_FD_SET, 1, [Do we have fd_set?])
fi
#------------------------------------------------------------------------
# Options for the notifier. Checks for epoll(7) on Linux, and
# kqueue(2) on {DragonFly,Free,Net,Open}BSD
#------------------------------------------------------------------------
AC_MSG_CHECKING([for advanced notifier support])
| > > > > > > > | 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 |
AC_DEFINE(HAVE_SYS_SELECT_H, 1, [Should we include <sys/select.h>?])
tcl_ok=yes
fi
fi
if test $tcl_ok = no; then
AC_DEFINE(NO_FD_SET, 1, [Do we have fd_set?])
fi
AC_CACHE_CHECK([for pselect], tcl_cv_func_pselect, [
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h>]], [[void *func = pselect;]])],[tcl_cv_func_pselect=yes],[tcl_cv_func_pselect=no])])
tcl_ok=$tcl_cv_func_pselect
if test $tcl_ok = yes; then
AC_DEFINE(HAVE_PSELECT, 1, [Should we use pselect()?])
fi
#------------------------------------------------------------------------
# Options for the notifier. Checks for epoll(7) on Linux, and
# kqueue(2) on {DragonFly,Free,Net,Open}BSD
#------------------------------------------------------------------------
AC_MSG_CHECKING([for advanced notifier support])
|
| ︙ | ︙ | |||
550 551 552 553 554 555 556 | #-------------------------------------------------------------------- # Check for support of cfmakeraw, chflags and mkstemps functions #-------------------------------------------------------------------- AC_CHECK_FUNCS(cfmakeraw chflags mkstemps) | < < < < < < < < < < < < | 557 558 559 560 561 562 563 564 565 566 567 568 569 570 |
#--------------------------------------------------------------------
# Check for support of cfmakeraw, chflags and mkstemps functions
#--------------------------------------------------------------------
AC_CHECK_FUNCS(cfmakeraw chflags mkstemps)
#--------------------------------------------------------------------
# Darwin specific API checks and defines
#--------------------------------------------------------------------
if test "`uname -s`" = "Darwin" ; then
AC_CHECK_FUNCS(getattrlist)
AC_CHECK_HEADERS(copyfile.h)
|
| ︙ | ︙ | |||
803 804 805 806 807 808 809 |
if test "`uname -s`" = "Darwin" ; then
SC_ENABLE_FRAMEWORK
TCL_SHLIB_LD_EXTRAS="-compatibility_version ${TCL_VERSION} -current_version ${TCL_VERSION}`echo ${TCL_PATCH_LEVEL} | awk ['{match($0, "\\\.[0-9]+"); print substr($0,RSTART,RLENGTH)}']`"
TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -install_name "${DYLIB_INSTALL_DIR}"/${TCL_LIB_FILE}'
echo "$LDFLAGS " | grep -q -- '-prebind ' && TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -seg1addr 0xA000000'
TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -sectcreate __TEXT __info_plist Tcl-Info.plist'
EXTRA_TCLSH_LIBS='-sectcreate __TEXT __info_plist Tclsh-Info.plist'
| < | 798 799 800 801 802 803 804 805 806 807 808 809 810 811 |
if test "`uname -s`" = "Darwin" ; then
SC_ENABLE_FRAMEWORK
TCL_SHLIB_LD_EXTRAS="-compatibility_version ${TCL_VERSION} -current_version ${TCL_VERSION}`echo ${TCL_PATCH_LEVEL} | awk ['{match($0, "\\\.[0-9]+"); print substr($0,RSTART,RLENGTH)}']`"
TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -install_name "${DYLIB_INSTALL_DIR}"/${TCL_LIB_FILE}'
echo "$LDFLAGS " | grep -q -- '-prebind ' && TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -seg1addr 0xA000000'
TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -sectcreate __TEXT __info_plist Tcl-Info.plist'
EXTRA_TCLSH_LIBS='-sectcreate __TEXT __info_plist Tclsh-Info.plist'
AC_CONFIG_FILES([Tcl-Info.plist:../macosx/Tcl-Info.plist.in Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in])
TCL_YEAR="`date +%Y`"
fi
if test "$FRAMEWORK_BUILD" = "1" ; then
AC_DEFINE(TCL_FRAMEWORK, 1, [Is Tcl built as a framework?])
# Construct a fake local framework structure to make linking with
|
| ︙ | ︙ |
Changes to unix/dltest/pkgooa.c.
| ︙ | ︙ | |||
80 81 82 83 84 85 86 |
(Tcl_Object (*) (Tcl_Interp *, Tcl_Object, const char *,
const char *t))(void *)Pkgooa_StubsOKObjCmd,
/* More entries could be here, but those are not used
* for this test-case. So, being NULL is OK. */
NULL, NULL, NULL, NULL, NULL, NULL, NULL,
NULL, NULL, NULL, NULL, NULL, NULL, NULL,
NULL, NULL, NULL, NULL, NULL, NULL, NULL,
| | > > > | | 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 |
(Tcl_Object (*) (Tcl_Interp *, Tcl_Object, const char *,
const char *t))(void *)Pkgooa_StubsOKObjCmd,
/* More entries could be here, but those are not used
* for this test-case. So, being NULL is OK. */
NULL, NULL, NULL, NULL, NULL, NULL, NULL,
NULL, NULL, NULL, NULL, NULL, NULL, NULL,
NULL, NULL, NULL, NULL, NULL, NULL, NULL,
NULL, NULL, NULL, NULL, NULL, NULL, NULL
#ifdef Tcl_MethodIsPrivate
,NULL
#endif
};
DLLEXPORT int
Pkgooa_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
int code;
/* Any TclOO extension which uses stubs, calls
|
| ︙ | ︙ |
Changes to unix/dltest/pkgua.c.
| ︙ | ︙ | |||
17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 | * Prototypes for procedures defined later in this file: */ static int PkguaEqObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int PkguaQuoteObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* * In the following hash table we are going to store a struct that holds all * the command tokens created by Tcl_CreateObjCommand in an interpreter, * indexed by the interpreter. In this way, we can find which command tokens * we have registered in a specific interpreter, in order to unload them. We * need to keep the various command tokens we have registered, as they are the * only safe way to unregister our registered commands, even if they have been * renamed. | > < < > > | > | > > > > > > > > | | | > | | > | | | > | | 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 |
* Prototypes for procedures defined later in this file:
*/
static int PkguaEqObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int PkguaQuoteObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static void CommandDeleted(ClientData clientData);
/*
* In the following hash table we are going to store a struct that holds all
* the command tokens created by Tcl_CreateObjCommand in an interpreter,
* indexed by the interpreter. In this way, we can find which command tokens
* we have registered in a specific interpreter, in order to unload them. We
* need to keep the various command tokens we have registered, as they are the
* only safe way to unregister our registered commands, even if they have been
* renamed.
*/
typedef struct ThreadSpecificData {
int interpTokenMapInitialised;
Tcl_HashTable interpTokenMap;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
#define MAX_REGISTERED_COMMANDS 2
static void
CommandDeleted(ClientData clientData)
{
Tcl_Command *cmdToken = (Tcl_Command *)clientData;
*cmdToken = NULL;
}
static void
PkguaInitTokensHashTable(void)
{
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)Tcl_GetThreadData((&dataKey), sizeof(ThreadSpecificData));
if (tsdPtr->interpTokenMapInitialised) {
return;
}
Tcl_InitHashTable(&tsdPtr->interpTokenMap, TCL_ONE_WORD_KEYS);
tsdPtr->interpTokenMapInitialised = 1;
}
static void
PkguaFreeTokensHashTable(void)
{
Tcl_HashSearch search;
Tcl_HashEntry *entryPtr;
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)Tcl_GetThreadData((&dataKey), sizeof(ThreadSpecificData));
for (entryPtr = Tcl_FirstHashEntry(&tsdPtr->interpTokenMap, &search);
entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
Tcl_Free((char *) Tcl_GetHashValue(entryPtr));
}
tsdPtr->interpTokenMapInitialised = 0;
}
static Tcl_Command *
PkguaInterpToTokens(
Tcl_Interp *interp)
{
int newEntry;
Tcl_Command *cmdTokens;
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)Tcl_GetThreadData((&dataKey), sizeof(ThreadSpecificData));
Tcl_HashEntry *entryPtr =
Tcl_CreateHashEntry(&tsdPtr->interpTokenMap, (char *) interp, &newEntry);
if (newEntry) {
cmdTokens = (Tcl_Command *)
Tcl_Alloc(sizeof(Tcl_Command) * (MAX_REGISTERED_COMMANDS));
for (newEntry=0 ; newEntry<MAX_REGISTERED_COMMANDS ; ++newEntry) {
cmdTokens[newEntry] = NULL;
}
Tcl_SetHashValue(entryPtr, cmdTokens);
} else {
cmdTokens = (Tcl_Command *) Tcl_GetHashValue(entryPtr);
}
return cmdTokens;
}
static void
PkguaDeleteTokens(
Tcl_Interp *interp)
{
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)Tcl_GetThreadData((&dataKey), sizeof(ThreadSpecificData));
Tcl_HashEntry *entryPtr =
Tcl_FindHashEntry(&tsdPtr->interpTokenMap, (char *) interp);
if (entryPtr) {
Tcl_Free((char *) Tcl_GetHashValue(entryPtr));
Tcl_DeleteHashEntry(entryPtr);
}
}
|
| ︙ | ︙ | |||
195 196 197 198 199 200 201 |
*/
DLLEXPORT int
Pkgua_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
| | | | | | | | | 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 |
*/
DLLEXPORT int
Pkgua_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
int code;
Tcl_Command *cmdTokens;
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
/*
* Initialize our Hash table, where we store the registered command tokens
* for each interpreter.
*/
PkguaInitTokensHashTable();
code = Tcl_PkgProvide(interp, "pkgua", "1.0");
if (code != TCL_OK) {
return code;
}
Tcl_SetVar2(interp, "::pkgua_loaded", NULL, ".", TCL_APPEND_VALUE);
cmdTokens = PkguaInterpToTokens(interp);
cmdTokens[0] =
Tcl_CreateObjCommand(interp, "pkgua_eq", PkguaEqObjCmd, &cmdTokens[0],
CommandDeleted);
cmdTokens[1] =
Tcl_CreateObjCommand(interp, "pkgua_quote", PkguaQuoteObjCmd,
&cmdTokens[1], CommandDeleted);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Pkgua_SafeInit --
|
| ︙ | ︙ |
Changes to unix/tcl.m4.
| ︙ | ︙ | |||
1101 1102 1103 1104 1105 1106 1107 |
[ac_cv_cygwin=yes])
)
if test "$ac_cv_cygwin" = "no"; then
AC_MSG_ERROR([${CC} is not a cygwin compiler.])
fi
do64bit_ok=yes
if test "x${SHARED_BUILD}" = "x1"; then
| | | | 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 |
[ac_cv_cygwin=yes])
)
if test "$ac_cv_cygwin" = "no"; then
AC_MSG_ERROR([${CC} is not a cygwin compiler.])
fi
do64bit_ok=yes
if test "x${SHARED_BUILD}" = "x1"; then
echo "running cd ../win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args --enable-64bit --host=x86_64-w64-mingw32"
# The eval makes quoting arguments work.
if cd ../win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args --enable-64bit --host=x86_64-w64-mingw32; cd ../unix
then :
else
{ echo "configure: error: configure failed for ../win" 1>&2; exit 1; }
fi
fi
;;
dgux*)
|
| ︙ | ︙ | |||
1258 1259 1260 1261 1262 1263 1264 | do64bit_ok=yes SHLIB_LD="ld -64 -shared -rdata_shared" CFLAGS="$CFLAGS -64" LDFLAGS_ARCH="-64" ]) ]) ;; | | > > > > > > > > > > > | > | 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 |
do64bit_ok=yes
SHLIB_LD="ld -64 -shared -rdata_shared"
CFLAGS="$CFLAGS -64"
LDFLAGS_ARCH="-64"
])
])
;;
Linux*|GNU*|NetBSD-Debian|DragonFly-*|FreeBSD-*)
SHLIB_CFLAGS="-fPIC -fno-common"
SHLIB_SUFFIX=".so"
CFLAGS_OPTIMIZE="-O2"
# egcs-2.91.66 on Redhat Linux 6.0 generates lots of warnings
# when you inline the string and math operations. Turn this off to
# get rid of the warnings.
#CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D__NO_STRING_INLINES -D__NO_MATH_INLINES"
SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared'
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
LDFLAGS="$LDFLAGS -Wl,--export-dynamic"
case $system in
DragonFly-*|FreeBSD-*)
AS_IF([test "${TCL_THREADS}" = "1"], [
# The -pthread needs to go in the LDFLAGS, not LIBS
LIBS=`echo $LIBS | sed s/-pthread//`
CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
LDFLAGS="$LDFLAGS $PTHREAD_LIBS"])
;;
esac
AS_IF([test $doRpath = yes], [
CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"'])
LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
AS_IF([test "`uname -m`" = "alpha"], [CFLAGS="$CFLAGS -mieee"])
AS_IF([test $do64bit = yes], [
AC_CACHE_CHECK([if compiler accepts -m64 flag], tcl_cv_cc_m64, [
hold_cflags=$CFLAGS
CFLAGS="$CFLAGS -m64"
AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[]])],
[tcl_cv_cc_m64=yes],[tcl_cv_cc_m64=no])
CFLAGS=$hold_cflags])
AS_IF([test $tcl_cv_cc_m64 = yes], [
CFLAGS="$CFLAGS -m64"
do64bit_ok=yes
])
])
|
| ︙ | ︙ | |||
1352 1353 1354 1355 1356 1357 1358 |
CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"'])
LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
# The -pthread needs to go in the CFLAGS, not LIBS
LIBS=`echo $LIBS | sed s/-pthread//`
CFLAGS="$CFLAGS -pthread"
LDFLAGS="$LDFLAGS -pthread"
;;
| < < < < < < < < < < < < < < < < < < < < < < < < | < | < | 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 |
CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"'])
LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
# The -pthread needs to go in the CFLAGS, not LIBS
LIBS=`echo $LIBS | sed s/-pthread//`
CFLAGS="$CFLAGS -pthread"
LDFLAGS="$LDFLAGS -pthread"
;;
Darwin-*)
CFLAGS_OPTIMIZE="-Os"
SHLIB_CFLAGS="-fno-common"
# To avoid discrepancies between what headers configure sees during
# preprocessing tests and compiling tests, move any -isysroot and
# -mmacosx-version-min flags from CFLAGS to CPPFLAGS:
CPPFLAGS="${CPPFLAGS} `echo " ${CFLAGS}" | \
awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \
if ([$]i~/^(isysroot|mmacosx-version-min)/) print "-"[$]i}'`"
CFLAGS="`echo " ${CFLAGS}" | \
awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \
if (!([$]i~/^(isysroot|mmacosx-version-min)/)) print "-"[$]i}'`"
AS_IF([test $do64bit = yes], [
case `arch` in
ppc)
AC_CACHE_CHECK([if compiler accepts -arch ppc64 flag],
tcl_cv_cc_arch_ppc64, [
hold_cflags=$CFLAGS
CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5"
AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[]])],
[tcl_cv_cc_arch_ppc64=yes],[tcl_cv_cc_arch_ppc64=no])
CFLAGS=$hold_cflags])
AS_IF([test $tcl_cv_cc_arch_ppc64 = yes], [
CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5"
do64bit_ok=yes
]);;
i386)
AC_CACHE_CHECK([if compiler accepts -arch x86_64 flag],
tcl_cv_cc_arch_x86_64, [
hold_cflags=$CFLAGS
CFLAGS="$CFLAGS -arch x86_64"
AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[]])],
[tcl_cv_cc_arch_x86_64=yes],[tcl_cv_cc_arch_x86_64=no])
CFLAGS=$hold_cflags])
AS_IF([test $tcl_cv_cc_arch_x86_64 = yes], [
CFLAGS="$CFLAGS -arch x86_64"
do64bit_ok=yes
]);;
*)
AC_MSG_WARN([Don't know how enable 64-bit on architecture `arch`]);;
|
| ︙ | ︙ | |||
1525 1526 1527 1528 1529 1530 1531 | AC_DEFINE(_OE_SOCKETS, 1, # needed in sys/socket.h [Should OS/390 do the right thing with sockets?]) ;; OSF1-V*) # Digital OSF/1 SHLIB_CFLAGS="" AS_IF([test "$SHARED_BUILD" = 1], [ | | | | 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 |
AC_DEFINE(_OE_SOCKETS, 1, # needed in sys/socket.h
[Should OS/390 do the right thing with sockets?])
;;
OSF1-V*)
# Digital OSF/1
SHLIB_CFLAGS=""
AS_IF([test "$SHARED_BUILD" = 1], [
SHLIB_LD='${CC} -shared'
], [
SHLIB_LD='${CC} -non_shared'
])
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
AS_IF([test $doRpath = yes], [
CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"'
LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'])
|
| ︙ | ︙ | |||
1778 1779 1780 1781 1782 1783 1784 |
# standard manufacturer compiler.
AS_IF([test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes], [
case $system in
AIX-*) ;;
BSD/OS*) ;;
CYGWIN_*|MINGW32_*|MSYS_*) ;;
| | | | | 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 |
# standard manufacturer compiler.
AS_IF([test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes], [
case $system in
AIX-*) ;;
BSD/OS*) ;;
CYGWIN_*|MINGW32_*|MSYS_*) ;;
HP-UX*) ;;
Darwin-*) ;;
IRIX*) ;;
Linux*|GNU*) ;;
NetBSD-*|OpenBSD-*) ;;
OSF1-*) ;;
SCO_SV-3.2*) ;;
*) SHLIB_CFLAGS="-fPIC" ;;
esac])
AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [
AC_DEFINE(MODULE_SCOPE, [extern],
[No Compiler support for module scope symbols])
|
| ︙ | ︙ | |||
2160 2161 2162 2163 2164 2165 2166 |
fi
#
# Its important to include time.h in this check, as some systems
# (like convex) have timezone functions, etc.
#
AC_CACHE_CHECK([long timezone variable], tcl_cv_timezone_long, [
| | > | > | 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 |
fi
#
# Its important to include time.h in this check, as some systems
# (like convex) have timezone functions, etc.
#
AC_CACHE_CHECK([long timezone variable], tcl_cv_timezone_long, [
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <time.h>
#include <stdlib.h>]],
[[extern long timezone;
timezone += 1;
exit (0);]])],
[tcl_cv_timezone_long=yes], [tcl_cv_timezone_long=no])])
if test $tcl_cv_timezone_long = yes ; then
AC_DEFINE(HAVE_TIMEZONE_VAR, 1, [Should we use the global timezone variable?])
else
#
# On some systems (eg IRIX 6.2), timezone is a time_t and not a long.
#
AC_CACHE_CHECK([time_t timezone variable], tcl_cv_timezone_time, [
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <time.h>
#include <stdlib.h>]],
[[extern time_t timezone;
timezone += 1;
exit (0);]])],
[tcl_cv_timezone_time=yes], [tcl_cv_timezone_time=no])])
if test $tcl_cv_timezone_time = yes ; then
AC_DEFINE(HAVE_TIMEZONE_VAR, 1, [Should we use the global timezone variable?])
fi
|
| ︙ | ︙ |
Changes to unix/tcl.pc.in.
1 2 3 4 5 6 7 8 9 10 | # tcl pkg-config source file prefix=@prefix@ exec_prefix=@exec_prefix@ libdir=@libdir@ includedir=@includedir@ libfile=@TCL_LIB_FILE@ Name: Tool Command Language Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses. | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
# tcl pkg-config source file
prefix=@prefix@
exec_prefix=@exec_prefix@
libdir=@libdir@
includedir=@includedir@
libfile=@TCL_LIB_FILE@
Name: Tool Command Language
Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses.
URL: https://www.tcl-tk.org/
Version: @TCL_VERSION@@TCL_PATCH_LEVEL@
Requires.private: zlib >= 1.2.3, libtommath >= 1.2.0
Libs: -L${libdir} @TCL_LIB_FLAG@ @TCL_STUB_LIB_FLAG@
Libs.private: @TCL_LIBS@
Cflags: -I${includedir}
|
Changes to unix/tcl.spec.
1 2 3 4 5 6 |
# This file is the basis for a binary Tcl RPM for Linux.
%{!?directory:%define directory /usr/local}
Name: tcl
Summary: Tcl scripting language development environment
| | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
# This file is the basis for a binary Tcl RPM for Linux.
%{!?directory:%define directory /usr/local}
Name: tcl
Summary: Tcl scripting language development environment
Version: 8.7a6
Release: 2
License: BSD
Group: Development/Languages
Source: http://prdownloads.sourceforge.net/tcl/tcl%{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
the Tk toolkit, Tcl provides the fastest and most powerful way to
|
| ︙ | ︙ |
Changes to unix/tclAppInit.c.
| ︙ | ︙ | |||
11 12 13 14 15 16 17 18 19 | * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef BUILD_tcl #undef STATIC_BUILD #include "tcl.h" #ifdef TCL_TEST | > > > > | | | | 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 | * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef BUILD_tcl #undef STATIC_BUILD #include "tcl.h" #if TCL_MAJOR_VERSION < 9 && TCL_MINOR_VERSION < 7 # define Tcl_LibraryInitProc Tcl_PackageInitProc # define Tcl_StaticLibrary Tcl_StaticPackage #endif #ifdef TCL_TEST extern Tcl_LibraryInitProc Tcltest_Init; extern Tcl_LibraryInitProc Tcltest_SafeInit; #endif /* TCL_TEST */ #ifdef TCL_XT_TEST extern void XtToolkitInitialize(void); extern Tcl_LibraryInitProc Tclxttest_Init; #endif /* TCL_XT_TEST */ /* * The following #if block allows you to change the AppInit function by using * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The * #if checks for that #define and uses Tcl_AppInit if it does not exist. */ |
| ︙ | ︙ | |||
75 76 77 78 79 80 81 |
{
#ifdef TCL_XT_TEST
XtToolkitInitialize();
#endif
#ifdef TCL_LOCAL_MAIN_HOOK
TCL_LOCAL_MAIN_HOOK(&argc, &argv);
| | > | 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 |
{
#ifdef TCL_XT_TEST
XtToolkitInitialize();
#endif
#ifdef TCL_LOCAL_MAIN_HOOK
TCL_LOCAL_MAIN_HOOK(&argc, &argv);
#elif (TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6) && (!defined(_WIN32) || defined(UNICODE))
/* 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. */
}
|
| ︙ | ︙ | |||
120 121 122 123 124 125 126 |
}
#endif
#ifdef TCL_TEST
if (Tcltest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
| | | 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 |
}
#endif
#ifdef TCL_TEST
if (Tcltest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticLibrary(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit);
#endif /* TCL_TEST */
/*
* Call the init procedures for included packages. Each call should look
* like this:
*
* if (Mod_Init(interp) == TCL_ERROR) {
|
| ︙ | ︙ |
Changes to unix/tclConfig.h.in.
| ︙ | ︙ | |||
179 180 181 182 183 184 185 186 187 188 189 190 191 192 | #undef HAVE_OPEN64 /* Define to 1 if you have the `opendir' function. */ #undef HAVE_OPENDIR /* Define to 1 if you have the `OSSpinLockLock' function. */ #undef HAVE_OSSPINLOCKLOCK /* Define to 1 if you have the `pthread_atfork' function. */ #undef HAVE_PTHREAD_ATFORK /* Define to 1 if you have the `pthread_attr_setstacksize' function. */ #undef HAVE_PTHREAD_ATTR_SETSTACKSIZE | > > > | 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 | #undef HAVE_OPEN64 /* Define to 1 if you have the `opendir' function. */ #undef HAVE_OPENDIR /* Define to 1 if you have the `OSSpinLockLock' function. */ #undef HAVE_OSSPINLOCKLOCK /* Should we use pselect()? */ #undef HAVE_PSELECT /* Define to 1 if you have the `pthread_atfork' function. */ #undef HAVE_PTHREAD_ATFORK /* Define to 1 if you have the `pthread_attr_setstacksize' function. */ #undef HAVE_PTHREAD_ATTR_SETSTACKSIZE |
| ︙ | ︙ | |||
342 343 344 345 346 347 348 | /* Do we have gettimeofday()? */ #undef NO_GETTOD /* Do we have getwd() */ #undef NO_GETWD | < < < | 345 346 347 348 349 350 351 352 353 354 355 356 357 358 | /* Do we have gettimeofday()? */ #undef NO_GETTOD /* Do we have getwd() */ #undef NO_GETWD /* Do we have memmove()? */ #undef NO_MEMMOVE /* Do we have realpath() */ #undef NO_REALPATH /* Do we have <stdlib.h>? */ |
| ︙ | ︙ |
Changes to unix/tclEpollNotfy.c.
| ︙ | ︙ | |||
93 94 95 96 97 98 99 |
/* Pointer to head of file handler list. */
struct PlatformReadyFileHandlerList firstReadyFileHandlerPtr;
/* Pointer to head of list of FileHandlers
* associated with regular files (S_IFREG)
* that are ready for I/O. */
pthread_mutex_t notifierMutex;
/* Mutex protecting notifier termination in
| | > < | | | | | | < < < | | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 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 |
/* Pointer to head of file handler list. */
struct PlatformReadyFileHandlerList firstReadyFileHandlerPtr;
/* Pointer to head of list of FileHandlers
* associated with regular files (S_IFREG)
* that are ready for I/O. */
pthread_mutex_t notifierMutex;
/* Mutex protecting notifier termination in
* TclpFinalizeNotifier. */
#ifdef HAVE_EVENTFD
int triggerEventFd; /* eventfd(2) used by other threads to wake
* up this thread for inter-thread IPC. */
#else
int triggerPipe[2]; /* pipe(2) used by other threads to wake
* up this thread for inter-thread IPC. */
#endif /* HAVE_EVENTFD */
int eventsFd; /* epoll(7) file descriptor used to wait for
* fds */
struct epoll_event *readyEvents;
/* Pointer to at most maxReadyEvents events
* returned by epoll_wait(2). */
size_t maxReadyEvents; /* Count of epoll_events in readyEvents. */
int asyncPending; /* True when signal triggered thread. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
/*
* Forward declarations.
*/
static void PlatformEventsControl(FileHandler *filePtr,
ThreadSpecificData *tsdPtr, int op, int isNew);
static void PlatformEventsInit(void);
static int PlatformEventsTranslate(struct epoll_event *event);
static int PlatformEventsWait(struct epoll_event *events,
size_t numEvents, struct timeval *timePtr);
/*
* Incorporate the base notifier implementation.
*/
#include "tclUnixNotfy.c"
/*
*----------------------------------------------------------------------
*
* TclpInitNotifier --
*
* Initializes the platform specific notifier state.
*
* Results:
* Returns a handle to the notifier state for this thread.
*
* Side effects:
* If no initNotifierProc notifier hook exists, PlatformEventsInit is
* called.
*
*----------------------------------------------------------------------
*/
ClientData
TclpInitNotifier(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
PlatformEventsInit();
return tsdPtr;
}
/*
*----------------------------------------------------------------------
*
* PlatformEventsControl --
*
* This function registers interest for the file descriptor and the mask
|
| ︙ | ︙ | |||
217 218 219 220 221 222 223 | * - If it is not associated with a regular file, the file descriptor is * added, modified concerning its mask of events of interest, or * deleted from the epoll file descriptor of the calling thread. * *---------------------------------------------------------------------- */ | | | | > | | > | > > > | | | | | | | | | | | > | < > | | | > | > | | 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 |
* - If it is not associated with a regular file, the file descriptor is
* added, modified concerning its mask of events of interest, or
* deleted from the epoll file descriptor of the calling thread.
*
*----------------------------------------------------------------------
*/
static void
PlatformEventsControl(
FileHandler *filePtr,
ThreadSpecificData *tsdPtr,
int op,
int isNew)
{
struct epoll_event newEvent;
struct PlatformEventData *newPedPtr;
Tcl_StatBuf fdStat;
newEvent.events = 0;
if (filePtr->mask & (TCL_READABLE | TCL_EXCEPTION)) {
newEvent.events |= EPOLLIN;
}
if (filePtr->mask & TCL_WRITABLE) {
newEvent.events |= EPOLLOUT;
}
if (isNew) {
newPedPtr = (struct PlatformEventData *)
ckalloc(sizeof(struct PlatformEventData));
newPedPtr->filePtr = filePtr;
newPedPtr->tsdPtr = tsdPtr;
filePtr->pedPtr = newPedPtr;
}
newEvent.data.ptr = filePtr->pedPtr;
/*
* N.B. As discussed in Tcl_WaitForEvent(), epoll(7) does not support
* regular files (S_IFREG). Therefore, filePtr is in these cases simply
* added or deleted from the list of FileHandlers associated with regular
* files belonging to tsdPtr.
*/
if (TclOSfstat(filePtr->fd, &fdStat) == -1) {
Tcl_Panic("fstat: %s", strerror(errno));
}
if (epoll_ctl(tsdPtr->eventsFd, op, filePtr->fd, &newEvent) == -1) {
switch (errno) {
case EPERM:
switch (op) {
case EPOLL_CTL_ADD:
if (isNew) {
LIST_INSERT_HEAD(&tsdPtr->firstReadyFileHandlerPtr, filePtr,
readyNode);
}
break;
case EPOLL_CTL_DEL:
LIST_REMOVE(filePtr, readyNode);
break;
}
break;
default:
Tcl_Panic("epoll_ctl: %s", strerror(errno));
}
}
return;
}
/*
*----------------------------------------------------------------------
*
* TclpFinalizeNotifier --
*
* This function closes the eventfd and the epoll file descriptor and
* frees the epoll_event structs owned by the thread of the caller. The
* above operations are protected by tsdPtr->notifierMutex, which is
* destroyed thereafter.
*
* Results:
|
| ︙ | ︙ | |||
295 296 297 298 299 300 301 | * * tsdPtr->notifierMutex is destroyed. * *---------------------------------------------------------------------- */ void | | | | 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 |
*
* tsdPtr->notifierMutex is destroyed.
*
*----------------------------------------------------------------------
*/
void
TclpFinalizeNotifier(
TCL_UNUSED(ClientData))
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
pthread_mutex_lock(&tsdPtr->notifierMutex);
#ifdef HAVE_EVENTFD
if (tsdPtr->triggerEventFd) {
close(tsdPtr->triggerEventFd);
|
| ︙ | ︙ | |||
358 359 360 361 362 363 364 | * PlatformEventsControl(). * - readyEvents and maxReadyEvents are initialised with 512 * epoll_events. * *---------------------------------------------------------------------- */ | | | | | 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 |
* PlatformEventsControl().
* - readyEvents and maxReadyEvents are initialised with 512
* epoll_events.
*
*----------------------------------------------------------------------
*/
static void
PlatformEventsInit(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
FileHandler *filePtr;
errno = pthread_mutex_init(&tsdPtr->notifierMutex, NULL);
if (errno) {
Tcl_Panic("Tcl_InitNotifier: %s", "could not create mutex");
}
filePtr = (FileHandler *) ckalloc(sizeof(FileHandler));
#ifdef HAVE_EVENTFD
tsdPtr->triggerEventFd = eventfd(0, EFD_CLOEXEC | EFD_NONBLOCK);
if (tsdPtr->triggerEventFd <= 0) {
Tcl_Panic("Tcl_InitNotifier: %s", "could not create trigger eventfd");
}
filePtr->fd = tsdPtr->triggerEventFd;
#else /* !HAVE_EVENTFD */
if (pipe2(tsdPtr->triggerPipe, O_CLOEXEC | O_NONBLOCK) != 0) {
Tcl_Panic("Tcl_InitNotifier: %s", "could not create trigger pipe");
}
filePtr->fd = tsdPtr->triggerPipe[0];
#endif /* HAVE_EVENTFD */
tsdPtr->triggerFilePtr = filePtr;
if ((tsdPtr->eventsFd = epoll_create1(EPOLL_CLOEXEC)) == -1) {
Tcl_Panic("epoll_create1: %s", strerror(errno));
}
filePtr->mask = TCL_READABLE;
PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_ADD, 1);
if (!tsdPtr->readyEvents) {
tsdPtr->maxReadyEvents = 512;
tsdPtr->readyEvents = (struct epoll_event *) ckalloc(
tsdPtr->maxReadyEvents * sizeof(tsdPtr->readyEvents[0]));
}
LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr);
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
412 413 414 415 416 417 418 | * * Side effects: * None. * *---------------------------------------------------------------------- */ | | | 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 |
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
PlatformEventsTranslate(
struct epoll_event *eventPtr)
{
int mask;
mask = 0;
if (eventPtr->events & (EPOLLIN | EPOLLHUP)) {
|
| ︙ | ︙ | |||
453 454 455 456 457 458 459 |
* If timePtr specifies a positive value, it is updated to reflect the
* amount of time that has passed; if its value would {under, over}flow,
* it is set to zero.
*
*----------------------------------------------------------------------
*/
| | | 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 |
* If timePtr specifies a positive value, it is updated to reflect the
* amount of time that has passed; if its value would {under, over}flow,
* it is set to zero.
*
*----------------------------------------------------------------------
*/
static int
PlatformEventsWait(
struct epoll_event *events,
size_t numEvents,
struct timeval *timePtr)
{
int numFound;
struct timeval tv0, tv1, tv_delta;
|
| ︙ | ︙ | |||
476 477 478 479 480 481 482 |
*/
if (!timePtr) {
timeout = -1;
} else if (!timePtr->tv_sec && !timePtr->tv_usec) {
timeout = 0;
} else {
| | | | > > > > | | < < < < < < | | | < < < < | < | | | | | | < < < | | | | | | | | < | | < < < < | | | | | < | | | < < < < | | | | | | | | | | | | | | | | | < | | | < < < | < | < > | > | | < | < | | | | | | | | < | | | | | | | | | | | | | | | | | | | | | | | | | | | < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < | | | | | > | | | | > | < | < | | | | | | | > | | | < | | | | | | | | | | | | | | | | | | | | | | | | > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 |
*/
if (!timePtr) {
timeout = -1;
} else if (!timePtr->tv_sec && !timePtr->tv_usec) {
timeout = 0;
} else {
timeout = (int) timePtr->tv_sec * 1000;
if (timePtr->tv_usec) {
timeout += (int) timePtr->tv_usec / 1000;
}
}
/*
* Call (and possibly block on) epoll_wait(2) and substract the delta of
* gettimeofday(2) before and after the call from timePtr if the latter is
* not NULL. Return the number of events returned by epoll_wait(2).
*/
gettimeofday(&tv0, NULL);
numFound = epoll_wait(tsdPtr->eventsFd, events, (int) numEvents, timeout);
gettimeofday(&tv1, NULL);
if (timePtr && (timePtr->tv_sec && timePtr->tv_usec)) {
timersub(&tv1, &tv0, &tv_delta);
if (!timercmp(&tv_delta, timePtr, >)) {
timersub(timePtr, &tv_delta, timePtr);
} else {
timePtr->tv_sec = 0;
timePtr->tv_usec = 0;
}
}
if (tsdPtr->asyncPending) {
tsdPtr->asyncPending = 0;
TclAsyncMarkFromNotifier();
}
return numFound;
}
/*
*----------------------------------------------------------------------
*
* TclpCreateFileHandler --
*
* This function registers a file handler with the epoll notifier of the
* thread of the caller.
*
* Results:
* None.
*
* Side effects:
* Creates a new file handler structure.
* PlatformEventsControl() is called for the new file handler structure.
*
*----------------------------------------------------------------------
*/
void
TclpCreateFileHandler(
int fd, /* Handle of stream to watch. */
int mask, /* OR'ed combination of TCL_READABLE,
* TCL_WRITABLE, and TCL_EXCEPTION: indicates
* conditions under which proc should be
* called. */
Tcl_FileProc *proc, /* Function to call for each selected
* event. */
ClientData clientData) /* Arbitrary data to pass to proc. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL);
int isNew = (filePtr == NULL);
if (isNew) {
filePtr = (FileHandler *) ckalloc(sizeof(FileHandler));
filePtr->fd = fd;
filePtr->readyMask = 0;
filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
tsdPtr->firstFileHandlerPtr = filePtr;
}
filePtr->proc = proc;
filePtr->clientData = clientData;
filePtr->mask = mask;
PlatformEventsControl(filePtr, tsdPtr,
isNew ? EPOLL_CTL_ADD : EPOLL_CTL_MOD, isNew);
}
/*
*----------------------------------------------------------------------
*
* TclpDeleteFileHandler --
*
* Cancel a previously-arranged callback arrangement for a file on the
* epoll file descriptor of the thread of the caller.
*
* Results:
* None.
*
* Side effects:
* If a callback was previously registered on file, remove it.
* PlatformEventsControl() is called for the file handler structure.
* The PlatformEventData struct associated with the new file handler
* structure is freed.
*
*----------------------------------------------------------------------
*/
void
TclpDeleteFileHandler(
int fd) /* Stream id for which to remove callback
* function. */
{
FileHandler *filePtr, *prevPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* Find the entry for the given file (and return if there isn't one).
*/
filePtr = LookUpFileHandler(tsdPtr, fd, &prevPtr);
if (filePtr == NULL) {
return;
}
/*
* Update the check masks for this file.
*/
PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_DEL, 0);
if (filePtr->pedPtr) {
ckfree(filePtr->pedPtr);
}
/*
* Clean up information in the callback record.
*/
if (prevPtr == NULL) {
tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
} else {
prevPtr->nextPtr = filePtr->nextPtr;
}
ckfree(filePtr);
}
/*
*----------------------------------------------------------------------
*
* TclpWaitForEvent --
*
* This function is called by Tcl_DoOneEvent to wait for new events on
* the message queue. If the block time is 0, then TclpWaitForEvent just
* polls without blocking.
*
* The waiting logic is implemented in PlatformEventsWait.
*
* Results:
* Returns -1 if PlatformEventsWait() would block forever, otherwise
* returns 0.
*
* Side effects:
* Queues file events that are detected by PlatformEventsWait().
*
*----------------------------------------------------------------------
*/
int
TclpWaitForEvent(
const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
{
FileHandler *filePtr;
Tcl_Time vTime;
struct timeval timeout, *timeoutPtr;
/* Impl. notes: timeout & timeoutPtr are used
* if, and only if threads are not enabled.
* They are the arguments for the regular
* epoll_wait() used when the core is not
* thread-enabled. */
int mask, numFound, numEvent;
struct PlatformEventData *pedPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
int numQueued;
ssize_t i;
/*
* Set up the timeout structure. Note that if there are no events to check
* for, we return with a negative result rather than blocking forever.
*/
if (timePtr != NULL) {
/*
* TIP #233 (Virtualized Time). Is virtual time in effect? And do we
* actually have something to scale? If yes to both then we call the
* handler to do this scaling.
*/
if (timePtr->sec != 0 || timePtr->usec != 0) {
vTime = *timePtr;
TclScaleTime(&vTime);
timePtr = &vTime;
}
timeout.tv_sec = timePtr->sec;
timeout.tv_usec = timePtr->usec;
timeoutPtr = &timeout;
} else {
timeoutPtr = NULL;
}
/*
* Walk the list of FileHandlers associated with regular files (S_IFREG)
* belonging to tsdPtr, queue Tcl events for them, and update their mask
* of events of interest.
*
* As epoll(7) does not support regular files, the behaviour of
* {select,poll}(2) is simply simulated here: fds associated with regular
* files are added to this list by PlatformEventsControl() and processed
* here before calling (and possibly blocking) on PlatformEventsWait().
*/
numQueued = 0;
LIST_FOREACH(filePtr, &tsdPtr->firstReadyFileHandlerPtr, readyNode) {
mask = 0;
if (filePtr->mask & TCL_READABLE) {
mask |= TCL_READABLE;
}
if (filePtr->mask & TCL_WRITABLE) {
mask |= TCL_WRITABLE;
}
/*
* Don't bother to queue an event if the mask was previously non-zero
* since an event must still be on the queue.
*/
if (filePtr->readyMask == 0) {
FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)
ckalloc(sizeof(FileHandlerEvent));
fileEvPtr->header.proc = FileHandlerEventProc;
fileEvPtr->fd = filePtr->fd;
Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
numQueued++;
}
filePtr->readyMask = mask;
}
/*
* If any events were queued in the above loop, force PlatformEventsWait()
* to poll as there already are events that need to be processed at this
* point.
*/
if (numQueued) {
timeout.tv_sec = 0;
timeout.tv_usec = 0;
timeoutPtr = &timeout;
}
/*
* Wait or poll for new events, queue Tcl events for the FileHandlers
* corresponding to them, and update the FileHandlers' mask of events of
* interest registered by the last call to Tcl_CreateFileHandler().
*
* Events for the eventfd(2)/trigger pipe are processed here in order to
* facilitate inter-thread IPC. If another thread intends to wake up this
* thread whilst it's blocking on PlatformEventsWait(), it write(2)s to
* the eventfd(2)/trigger pipe (see Tcl_AlertNotifier(),) which in turn
* will cause PlatformEventsWait() to return immediately.
*/
numFound = PlatformEventsWait(tsdPtr->readyEvents,
tsdPtr->maxReadyEvents, timeoutPtr);
for (numEvent = 0; numEvent < numFound; numEvent++) {
pedPtr = (struct PlatformEventData *)
tsdPtr->readyEvents[numEvent].data.ptr;
filePtr = pedPtr->filePtr;
mask = PlatformEventsTranslate(&tsdPtr->readyEvents[numEvent]);
#ifdef HAVE_EVENTFD
if (filePtr->fd == tsdPtr->triggerEventFd) {
uint64_t eventFdVal;
i = read(tsdPtr->triggerEventFd, &eventFdVal, sizeof(eventFdVal));
if ((i != sizeof(eventFdVal)) && (errno != EAGAIN)) {
Tcl_Panic("%s: read from %p->triggerEventFd: %s",
"Tcl_WaitForEvent", (void *) tsdPtr, strerror(errno));
}
continue;
}
#else /* !HAVE_EVENTFD */
if (filePtr->fd == tsdPtr->triggerPipe[0]) {
char triggerPipeVal;
i = read(tsdPtr->triggerPipe[0], &triggerPipeVal,
sizeof(triggerPipeVal));
if ((i != sizeof(triggerPipeVal)) && (errno != EAGAIN)) {
Tcl_Panic("%s: read from %p->triggerPipe[0]: %s",
"Tcl_WaitForEvent", (void *) tsdPtr, strerror(errno));
}
continue;
}
#endif /* HAVE_EVENTFD */
if (!mask) {
continue;
}
/*
* Don't bother to queue an event if the mask was previously non-zero
* since an event must still be on the queue.
*/
if (filePtr->readyMask == 0) {
FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)
ckalloc(sizeof(FileHandlerEvent));
fileEvPtr->header.proc = FileHandlerEventProc;
fileEvPtr->fd = filePtr->fd;
Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
}
filePtr->readyMask = mask;
}
return 0;
}
/*
*----------------------------------------------------------------------
*
* TclAsyncNotifier --
*
* This procedure sets the async mark of an async handler to a
* given value, if it is called from the target thread.
*
* Result:
* True, when the handler will be marked, false otherwise.
*
* Side effects:
* The signal may be resent to the target thread.
*
*----------------------------------------------------------------------
*/
int
TclAsyncNotifier(
int sigNumber, /* Signal number. */
Tcl_ThreadId threadId, /* Target thread. */
ClientData clientData, /* Notifier data. */
int *flagPtr, /* Flag to mark. */
int value) /* Value of mark. */
{
#if TCL_THREADS
/*
* WARNING:
* This code most likely runs in a signal handler. Thus,
* only few async-signal-safe system calls are allowed,
* e.g. pthread_self(), sem_post(), write().
*/
if (pthread_equal(pthread_self(), (pthread_t) threadId)) {
ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
*flagPtr = value;
if (tsdPtr != NULL && !tsdPtr->asyncPending) {
tsdPtr->asyncPending = 1;
TclpAlertNotifier(tsdPtr);
return 1;
}
return 0;
}
/*
* Re-send the signal to the proper target thread.
*/
pthread_kill((pthread_t) threadId, sigNumber);
#else
(void)sigNumber;
(void)threadId;
(void)clientData;
(void)flagPtr;
(void)value;
#endif
return 0;
}
#endif /* NOTIFIER_EPOLL && TCL_THREADS */
#else
TCL_MAC_EMPTY_FILE(unix_tclEpollNotfy_c)
#endif /* !HAVE_COREFOUNDATION */
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Changes to unix/tclKqueueNotfy.c.
| ︙ | ︙ | |||
27 28 29 30 31 32 33 |
/*
* This structure is used to keep track of the notifier info for a registered
* file.
*/
struct PlatformEventData;
typedef struct FileHandler {
| | > | 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 |
/*
* This structure is used to keep track of the notifier info for a registered
* file.
*/
struct PlatformEventData;
typedef struct FileHandler {
int fd; /* File descriptor that this is describing a
* handler for. */
int mask; /* Mask of desired events: TCL_READABLE,
* etc. */
int readyMask; /* Mask of events that have been seen since
* the last time file handlers were invoked
* for this file. */
Tcl_FileProc *proc; /* Function to call, in the style of
* Tcl_CreateFileHandler. */
|
| ︙ | ︙ | |||
89 90 91 92 93 94 95 |
/* Pointer to head of file handler list. */
struct PlatformReadyFileHandlerList firstReadyFileHandlerPtr;
/* Pointer to head of list of FileHandlers
* associated with regular files (S_IFREG)
* that are ready for I/O. */
pthread_mutex_t notifierMutex;
/* Mutex protecting notifier termination in
| | > < < | < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < | < | < < < < < < < < < < < < | < < < < < < < < < < < | 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 |
/* Pointer to head of file handler list. */
struct PlatformReadyFileHandlerList firstReadyFileHandlerPtr;
/* Pointer to head of list of FileHandlers
* associated with regular files (S_IFREG)
* that are ready for I/O. */
pthread_mutex_t notifierMutex;
/* Mutex protecting notifier termination in
* TclpFinalizeNotifier. */
int triggerPipe[2]; /* pipe(2) used by other threads to wake
* up this thread for inter-thread IPC. */
int eventsFd; /* kqueue(2) file descriptor used to wait for
* fds. */
struct kevent *readyEvents; /* Pointer to at most maxReadyEvents events
* returned by kevent(2). */
size_t maxReadyEvents; /* Count of kevents in readyEvents. */
int asyncPending; /* True when signal triggered thread. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
/*
* Forward declarations of internal functions.
*/
static void PlatformEventsControl(FileHandler *filePtr,
ThreadSpecificData *tsdPtr, int op, int isNew);
static int PlatformEventsTranslate(struct kevent *eventPtr);
static int PlatformEventsWait(struct kevent *events,
size_t numEvents, struct timeval *timePtr);
/*
* Incorporate the base notifier implementation.
*/
#include "tclUnixNotfy.c"
/*
*----------------------------------------------------------------------
*
* PlatformEventsControl --
*
* This function registers interest for the file descriptor and the mask
|
| ︙ | ︙ | |||
205 206 207 208 209 210 211 | * deleted from the epoll file descriptor of the calling thread. * - If deleting a file descriptor, kevent(2) is called twice specifying * EVFILT_READ first and then EVFILT_WRITE (see note below.) * *---------------------------------------------------------------------- */ | | | | > | | | | | > > > | | | | | | | 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 |
* deleted from the epoll file descriptor of the calling thread.
* - If deleting a file descriptor, kevent(2) is called twice specifying
* EVFILT_READ first and then EVFILT_WRITE (see note below.)
*
*----------------------------------------------------------------------
*/
static void
PlatformEventsControl(
FileHandler *filePtr,
ThreadSpecificData *tsdPtr,
int op,
int isNew)
{
int numChanges;
struct kevent changeList[2];
struct PlatformEventData *newPedPtr;
Tcl_StatBuf fdStat;
if (isNew) {
newPedPtr = (struct PlatformEventData *)
ckalloc(sizeof(struct PlatformEventData));
newPedPtr->filePtr = filePtr;
newPedPtr->tsdPtr = tsdPtr;
filePtr->pedPtr = newPedPtr;
}
/*
* N.B. As discussed in Tcl_WaitForEvent(), kqueue(2) does not reproduce
* the `always ready' {select,poll}(2) behaviour for regular files
* (S_IFREG) prior to FreeBSD 11.0-RELEASE. Therefore, filePtr is in these
* cases simply added or deleted from the list of FileHandlers associated
* with regular files belonging to tsdPtr.
*/
if (TclOSfstat(filePtr->fd, &fdStat) == -1) {
Tcl_Panic("fstat: %s", strerror(errno));
} else if ((fdStat.st_mode & S_IFMT) == S_IFREG
|| (fdStat.st_mode & S_IFMT) == S_IFDIR
|| (fdStat.st_mode & S_IFMT) == S_IFLNK
) {
switch (op) {
case EV_ADD:
if (isNew) {
LIST_INSERT_HEAD(&tsdPtr->firstReadyFileHandlerPtr, filePtr,
readyNode);
}
break;
case EV_DELETE:
LIST_REMOVE(filePtr, readyNode);
break;
}
return;
}
numChanges = 0;
switch (op) {
case EV_ADD:
if (filePtr->mask & (TCL_READABLE | TCL_EXCEPTION)) {
EV_SET(&changeList[numChanges], (uintptr_t) filePtr->fd,
EVFILT_READ, op, 0, 0, filePtr->pedPtr);
numChanges++;
}
if (filePtr->mask & TCL_WRITABLE) {
EV_SET(&changeList[numChanges], (uintptr_t) filePtr->fd,
EVFILT_WRITE, op, 0, 0, filePtr->pedPtr);
numChanges++;
}
if (numChanges) {
if (kevent(tsdPtr->eventsFd, changeList, numChanges, NULL, 0,
NULL) == -1) {
Tcl_Panic("kevent: %s", strerror(errno));
}
}
break;
case EV_DELETE:
/*
* N.B. kqueue(2) has separate filters for readability and writability
* fd events. We therefore need to ensure that fds are ompletely
* removed from the kqueue(2) fd when deleting. This is exacerbated
* by changes to filePtr->mask w/o calls to PlatforEventsControl()
* after e.g. an exec(3) in a child process.
*
* As one of these calls can fail, two separate kevent(2) calls are
* made for EVFILT_{READ,WRITE}.
*/
EV_SET(&changeList[0], (uintptr_t) filePtr->fd, EVFILT_READ, op, 0, 0,
NULL);
if ((kevent(tsdPtr->eventsFd, changeList, 1, NULL, 0, NULL) == -1)
&& (errno != ENOENT)) {
Tcl_Panic("kevent: %s", strerror(errno));
}
EV_SET(&changeList[0], (uintptr_t) filePtr->fd, EVFILT_WRITE, op, 0, 0,
NULL);
if ((kevent(tsdPtr->eventsFd, changeList, 1, NULL, 0, NULL) == -1)
&& (errno != ENOENT)) {
Tcl_Panic("kevent: %s", strerror(errno));
}
break;
}
}
/*
*----------------------------------------------------------------------
*
* TclpFinalizeNotifier --
*
* This function closes the pipe and the kqueue file descriptors and
* frees the kevent structs owned by the thread of the caller. The above
* operations are protected by tsdPtr->notifierMutex, which is destroyed
* thereafter.
*
* Results:
|
| ︙ | ︙ | |||
321 322 323 324 325 326 327 | * * tsdPtr->notifierMutex is destroyed. * *---------------------------------------------------------------------- */ void | | | | 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 |
*
* tsdPtr->notifierMutex is destroyed.
*
*----------------------------------------------------------------------
*/
void
TclpFinalizeNotifier(
TCL_UNUSED(ClientData))
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
pthread_mutex_lock(&tsdPtr->notifierMutex);
if (tsdPtr->triggerPipe[0]) {
close(tsdPtr->triggerPipe[0]);
tsdPtr->triggerPipe[0] = -1;
|
| ︙ | ︙ | |||
352 353 354 355 356 357 358 |
Tcl_Panic("pthread_mutex_destroy: %s", strerror(errno));
}
}
/*
*----------------------------------------------------------------------
*
| | > > | | | | 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 |
Tcl_Panic("pthread_mutex_destroy: %s", strerror(errno));
}
}
/*
*----------------------------------------------------------------------
*
* TclpInitNotifier --
*
* Initializes the platform specific notifier state.
*
* This function abstracts creating a kqueue fd via the kqueue system
* call and allocating memory for the kevents structs in tsdPtr for the
* thread of the caller.
*
* Results:
* Returns a handle to the notifier state for this thread.
*
* Side effects:
* The following per-thread entities are initialised:
* - notifierMutex is initialised.
* - The pipe(2) is created; fcntl(2) is called on both fds to set
* FD_CLOEXEC and O_NONBLOCK.
* - The kqueue(2) fd is created; fcntl(2) is called on it to set
* FD_CLOEXEC.
* - A FileHandler struct is allocated and initialised for the event-
* fd(2), registering interest for TCL_READABLE on it via Platform-
* EventsControl().
* - readyEvents and maxReadyEvents are initialised with 512 kevents.
*
*----------------------------------------------------------------------
*/
ClientData
TclpInitNotifier(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
int i, fdFl;
FileHandler *filePtr;
errno = pthread_mutex_init(&tsdPtr->notifierMutex, NULL);
if (errno) {
|
| ︙ | ︙ | |||
405 406 407 408 409 410 411 |
}
}
if ((tsdPtr->eventsFd = kqueue()) == -1) {
Tcl_Panic("kqueue: %s", strerror(errno));
} else if (fcntl(tsdPtr->eventsFd, F_SETFD, FD_CLOEXEC) == -1) {
Tcl_Panic("fcntl: %s", strerror(errno));
}
| | | | > > | | | 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 |
}
}
if ((tsdPtr->eventsFd = kqueue()) == -1) {
Tcl_Panic("kqueue: %s", strerror(errno));
} else if (fcntl(tsdPtr->eventsFd, F_SETFD, FD_CLOEXEC) == -1) {
Tcl_Panic("fcntl: %s", strerror(errno));
}
filePtr = (FileHandler *) ckalloc(sizeof(FileHandler));
filePtr->fd = tsdPtr->triggerPipe[0];
filePtr->mask = TCL_READABLE;
PlatformEventsControl(filePtr, tsdPtr, EV_ADD, 1);
if (!tsdPtr->readyEvents) {
tsdPtr->maxReadyEvents = 512;
tsdPtr->readyEvents = (struct kevent *) ckalloc(
tsdPtr->maxReadyEvents * sizeof(tsdPtr->readyEvents[0]));
}
LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr);
return tsdPtr;
}
/*
*----------------------------------------------------------------------
*
* PlatformEventsTranslate --
*
* This function translates the platform-specific mask of returned
* events in eventPtr to a mask of TCL_* bits.
*
* Results:
* Returns the translated mask.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
PlatformEventsTranslate(
struct kevent *eventPtr)
{
int mask;
mask = 0;
if (eventPtr->filter == EVFILT_READ) {
mask |= TCL_READABLE;
if (eventPtr->flags & EV_ERROR) {
mask |= TCL_EXCEPTION;
}
}
if (eventPtr->filter == EVFILT_WRITE) {
mask |= TCL_WRITABLE;
if (eventPtr->flags & EV_ERROR) {
mask |= TCL_EXCEPTION;
}
}
return mask;
}
/*
*----------------------------------------------------------------------
*
* PlatformEventsWait --
*
* This function abstracts waiting for I/O events via the kevent system
* call.
|
| ︙ | ︙ | |||
479 480 481 482 483 484 485 |
* If timePtr specifies a positive value, it is updated to reflect the
* amount of time that has passed; if its value would {under, over}flow,
* it is set to zero.
*
*----------------------------------------------------------------------
*/
| | | 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 |
* If timePtr specifies a positive value, it is updated to reflect the
* amount of time that has passed; if its value would {under, over}flow,
* it is set to zero.
*
*----------------------------------------------------------------------
*/
static int
PlatformEventsWait(
struct kevent *events,
size_t numEvents,
struct timeval *timePtr)
{
int numFound;
struct timeval tv0, tv1, tv_delta;
|
| ︙ | ︙ | |||
528 529 530 531 532 533 534 535 536 537 538 539 540 |
if (!timercmp(&tv_delta, timePtr, >)) {
timersub(timePtr, &tv_delta, timePtr);
} else {
timePtr->tv_sec = 0;
timePtr->tv_usec = 0;
}
}
return numFound;
}
/*
*----------------------------------------------------------------------
*
| > > > > | | < < < < < < | | | < < < < | < | | | | | | < < < | | | | | | | < | | | < < < | < | | | < | | | < < < < | | | | | | | | | | | | | | | | | < | | | | < < < | | | < > | > | | < | < | | | | | | | | | < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 |
if (!timercmp(&tv_delta, timePtr, >)) {
timersub(timePtr, &tv_delta, timePtr);
} else {
timePtr->tv_sec = 0;
timePtr->tv_usec = 0;
}
}
if (tsdPtr->asyncPending) {
tsdPtr->asyncPending = 0;
TclAsyncMarkFromNotifier();
}
return numFound;
}
/*
*----------------------------------------------------------------------
*
* TclpCreateFileHandler --
*
* This function registers a file handler with the kqueue notifier
* of the thread of the caller.
*
* Results:
* None.
*
* Side effects:
* Creates a new file handler structure.
* PlatformEventsControl() is called for the new file handler structure.
*
*----------------------------------------------------------------------
*/
void
TclpCreateFileHandler(
int fd, /* Handle of stream to watch. */
int mask, /* OR'ed combination of TCL_READABLE,
* TCL_WRITABLE, and TCL_EXCEPTION: indicates
* conditions under which proc should be
* called. */
Tcl_FileProc *proc, /* Function to call for each selected
* event. */
ClientData clientData) /* Arbitrary data to pass to proc. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL);
int isNew = (filePtr == NULL);
if (isNew) {
filePtr = (FileHandler *) ckalloc(sizeof(FileHandler));
filePtr->fd = fd;
filePtr->readyMask = 0;
filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
tsdPtr->firstFileHandlerPtr = filePtr;
}
filePtr->proc = proc;
filePtr->clientData = clientData;
filePtr->mask = mask;
PlatformEventsControl(filePtr, tsdPtr, EV_ADD, isNew);
}
/*
*----------------------------------------------------------------------
*
* TclpDeleteFileHandler --
*
* Cancel a previously-arranged callback arrangement for a file on the
* kqueue of the thread of the caller.
*
* Results:
* None.
*
* Side effects:
* If a callback was previously registered on file, remove it.
* PlatformEventsControl() is called for the file handler structure.
* The PlatformEventData struct associated with the new file handler
* structure is freed.
*
*----------------------------------------------------------------------
*/
void
TclpDeleteFileHandler(
int fd) /* Stream id for which to remove callback
* function. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
FileHandler *filePtr, *prevPtr;
/*
* Find the entry for the given file (and return if there isn't one).
*/
filePtr = LookUpFileHandler(tsdPtr, fd, &prevPtr);
if (filePtr == NULL) {
return;
}
/*
* Update the check masks for this file.
*/
PlatformEventsControl(filePtr, tsdPtr, EV_DELETE, 0);
if (filePtr->pedPtr) {
ckfree(filePtr->pedPtr);
}
/*
* Clean up information in the callback record.
*/
if (prevPtr == NULL) {
tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
} else {
prevPtr->nextPtr = filePtr->nextPtr;
}
ckfree(filePtr);
}
/*
*----------------------------------------------------------------------
*
* TclpWaitForEvent --
*
* This function is called by Tcl_DoOneEvent to wait for new events on
* the message queue. If the block time is 0, then TclpWaitForEvent just
* polls without blocking.
*
* The waiting logic is implemented in PlatformEventsWait.
*
* Results:
* Returns -1 if PlatformEventsWait() would block forever, otherwise
* returns 0.
*
* Side effects:
* Queues file events that are detected by PlatformEventsWait().
*
*----------------------------------------------------------------------
*/
int
TclpWaitForEvent(
const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
{
FileHandler *filePtr;
int mask;
Tcl_Time vTime;
struct timeval timeout, *timeoutPtr;
/* Impl. notes: timeout & timeoutPtr are used
* if, and only if threads are not enabled.
* They are the arguments for the regular
* epoll_wait() used when the core is not
* thread-enabled. */
int numFound, numEvent;
struct PlatformEventData *pedPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
int numQueued;
ssize_t i;
char buf[1];
/*
* Set up the timeout structure. Note that if there are no events to check
* for, we return with a negative result rather than blocking forever.
*/
if (timePtr != NULL) {
/*
* TIP #233 (Virtualized Time). Is virtual time in effect? And do we
* actually have something to scale? If yes to both then we call the
* handler to do this scaling.
*/
if (timePtr->sec != 0 || timePtr->usec != 0) {
vTime = *timePtr;
TclScaleTime(&vTime);
timePtr = &vTime;
}
timeout.tv_sec = timePtr->sec;
timeout.tv_usec = timePtr->usec;
timeoutPtr = &timeout;
} else {
timeoutPtr = NULL;
}
/*
* Walk the list of FileHandlers associated with regular files (S_IFREG)
* belonging to tsdPtr, queue Tcl events for them, and update their mask
* of events of interest.
*
* kqueue(2), unlike epoll(7), does support regular files, but EVFILT_READ
* only `[r]eturns when the file pointer is not at the end of file' as
* opposed to unconditionally. While FreeBSD 11.0-RELEASE adds support for
* this mode (NOTE_FILE_POLL,) this is not used for reasons of
* compatibility.
*
* Therefore, the behaviour of {select,poll}(2) is simply simulated here:
* fds associated with regular files are added to this list by
* PlatformEventsControl() and processed here before calling (and possibly
* blocking) on PlatformEventsWait().
*/
numQueued = 0;
LIST_FOREACH(filePtr, &tsdPtr->firstReadyFileHandlerPtr, readyNode) {
mask = 0;
if (filePtr->mask & TCL_READABLE) {
mask |= TCL_READABLE;
}
if (filePtr->mask & TCL_WRITABLE) {
mask |= TCL_WRITABLE;
}
/*
* Don't bother to queue an event if the mask was previously non-zero
* since an event must still be on the queue.
*/
if (filePtr->readyMask == 0) {
FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)
ckalloc(sizeof(FileHandlerEvent));
fileEvPtr->header.proc = FileHandlerEventProc;
fileEvPtr->fd = filePtr->fd;
Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
numQueued++;
}
filePtr->readyMask = mask;
}
/*
* If any events were queued in the above loop, force PlatformEventsWait()
* to poll as there already are events that need to be processed at this
* point.
*/
if (numQueued) {
timeout.tv_sec = 0;
timeout.tv_usec = 0;
timeoutPtr = &timeout;
}
/*
* Wait or poll for new events, queue Tcl events for the FileHandlers
* corresponding to them, and update the FileHandlers' mask of events of
* interest registered by the last call to Tcl_CreateFileHandler().
*
* Events for the trigger pipe are processed here in order to facilitate
* inter-thread IPC. If another thread intends to wake up this thread
* whilst it's blocking on PlatformEventsWait(), it write(2)s to the other
* end of the pipe (see Tcl_AlertNotifier(),) which in turn will cause
* PlatformEventsWait() to return immediately.
*/
numFound = PlatformEventsWait(tsdPtr->readyEvents,
tsdPtr->maxReadyEvents, timeoutPtr);
for (numEvent = 0; numEvent < numFound; numEvent++) {
pedPtr = (struct PlatformEventData *)
tsdPtr->readyEvents[numEvent].udata;
filePtr = pedPtr->filePtr;
mask = PlatformEventsTranslate(&tsdPtr->readyEvents[numEvent]);
if (filePtr->fd == tsdPtr->triggerPipe[0]) {
i = read(tsdPtr->triggerPipe[0], buf, 1);
if ((i == -1) && (errno != EAGAIN)) {
Tcl_Panic("Tcl_WaitForEvent: read from %p->triggerPipe: %s",
(void *) tsdPtr, strerror(errno));
}
continue;
}
if (!mask) {
continue;
}
/*
* Don't bother to queue an event if the mask was previously non-zero
* since an event must still be on the queue.
*/
if (filePtr->readyMask == 0) {
FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)
ckalloc(sizeof(FileHandlerEvent));
fileEvPtr->header.proc = FileHandlerEventProc;
fileEvPtr->fd = filePtr->fd;
Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
}
filePtr->readyMask |= mask;
}
return 0;
}
/*
*----------------------------------------------------------------------
*
* TclAsyncNotifier --
*
* This procedure sets the async mark of an async handler to a
* given value, if it is called from the target thread.
*
* Result:
* True, when the handler will be marked, false otherwise.
*
* Side effects:
* The signal may be resent to the target thread.
*
*----------------------------------------------------------------------
*/
int
TclAsyncNotifier(
int sigNumber, /* Signal number. */
Tcl_ThreadId threadId, /* Target thread. */
ClientData clientData, /* Notifier data. */
int *flagPtr, /* Flag to mark. */
int value) /* Value of mark. */
{
#if TCL_THREADS
/*
* WARNING:
* This code most likely runs in a signal handler. Thus,
* only few async-signal-safe system calls are allowed,
* e.g. pthread_self(), sem_post(), write().
*/
if (pthread_equal(pthread_self(), (pthread_t) threadId)) {
ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
*flagPtr = value;
if (tsdPtr != NULL && !tsdPtr->asyncPending) {
tsdPtr->asyncPending = 1;
TclpAlertNotifier(tsdPtr);
return 1;
}
return 0;
}
/*
* Re-send the signal to the proper target thread.
*/
pthread_kill((pthread_t) threadId, sigNumber);
#else
(void)sigNumber;
(void)threadId;
(void)clientData;
(void)flagPtr;
(void)value;
#endif
return 0;
}
#endif /* NOTIFIER_KQUEUE && TCL_THREADS */
#else
TCL_MAC_EMPTY_FILE(unix_tclKqueueNotfy_c)
#endif /* !HAVE_COREFOUNDATION */
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Changes to unix/tclLoadDyld.c.
| ︙ | ︙ | |||
332 333 334 335 336 337 338 |
static void *
FindSymbol(
Tcl_Interp *interp, /* For error reporting. */
Tcl_LoadHandle loadHandle, /* Handle from TclpDlopen. */
const char *symbol) /* Symbol name to look up. */
{
Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *)loadHandle->clientData;
| | | | 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 |
static void *
FindSymbol(
Tcl_Interp *interp, /* For error reporting. */
Tcl_LoadHandle loadHandle, /* Handle from TclpDlopen. */
const char *symbol) /* Symbol name to look up. */
{
Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *)loadHandle->clientData;
Tcl_LibraryInitProc *proc = NULL;
const char *errMsg = NULL;
Tcl_DString ds;
const char *native;
native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
if (dyldLoadHandle->dlHandle) {
#if TCL_DYLD_USE_DLFCN
proc = (Tcl_LibraryInitProc *)dlsym(dyldLoadHandle->dlHandle, native);
if (!proc) {
errMsg = dlerror();
}
#endif /* TCL_DYLD_USE_DLFCN */
} else {
#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
NSSymbol nsSymbol = NULL;
|
| ︙ | ︙ | |||
396 397 398 399 400 401 402 |
NSLinkEditError(&editError, &errorNumber, &errorName, &errMsg);
}
} else if (dyldLoadHandle->modulePtr) {
nsSymbol = NSLookupSymbolInModule(
dyldLoadHandle->modulePtr->module, native);
}
if (nsSymbol) {
| | | 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 |
NSLinkEditError(&editError, &errorNumber, &errorName, &errMsg);
}
} else if (dyldLoadHandle->modulePtr) {
nsSymbol = NSLookupSymbolInModule(
dyldLoadHandle->modulePtr->module, native);
}
if (nsSymbol) {
proc = (Tcl_LibraryInitProc *)NSAddressOfSymbol(nsSymbol);
}
Tcl_DStringFree(&newName);
#endif /* TCL_DYLD_USE_NSMODULE */
}
Tcl_DStringFree(&ds);
if (errMsg && (interp != NULL)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
| ︙ | ︙ |
Changes to unix/tclLoadNext.c.
| ︙ | ︙ | |||
129 130 131 132 133 134 135 |
static void *
FindSymbol(
Tcl_Interp *interp,
Tcl_LoadHandle loadHandle,
const char *symbol)
{
| | | 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 |
static void *
FindSymbol(
Tcl_Interp *interp,
Tcl_LoadHandle loadHandle,
const char *symbol)
{
Tcl_LibraryInitProc *proc = NULL;
if (symbol) {
char sym[strlen(symbol) + 2];
sym[0] = '_';
sym[1] = 0;
strcat(sym, symbol);
|
| ︙ | ︙ |
Changes to unix/tclLoadOSF.c.
| ︙ | ︙ | |||
85 86 87 88 89 90 91 |
/*
* First try the full path the user gave us. This is particularly
* important if the cwd is inside a vfs, and we are trying to load using a
* relative path.
*/
native = Tcl_FSGetNativePath(pathPtr);
| | | | 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 |
/*
* First try the full path the user gave us. This is particularly
* important if the cwd is inside a vfs, and we are trying to load using a
* relative path.
*/
native = Tcl_FSGetNativePath(pathPtr);
lm = (Tcl_LibraryInitProc *) load(native, LDR_NOFLAGS);
if (lm == LDR_NULL_MODULE) {
/*
* Let the OS loader examine the binary search path for whatever
* string the user gave us which hopefully refers to a file on the
* binary path
*/
Tcl_DString ds;
native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
lm = (Tcl_LibraryInitProc *) load(native, LDR_NOFLAGS);
Tcl_DStringFree(&ds);
}
if (lm == LDR_NULL_MODULE) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't load file \"%s\": %s",
fileName, Tcl_PosixError(interp)));
|
| ︙ | ︙ |
Changes to unix/tclLoadShl.c.
| ︙ | ︙ | |||
124 125 126 127 128 129 130 |
static void*
FindSymbol(
Tcl_Interp *interp,
Tcl_LoadHandle loadHandle,
const char *symbol)
{
Tcl_DString newName;
| | | 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 |
static void*
FindSymbol(
Tcl_Interp *interp,
Tcl_LoadHandle loadHandle,
const char *symbol)
{
Tcl_DString newName;
Tcl_LibraryInitProc *proc = NULL;
shl_t handle = (shl_t) loadHandle->clientData;
/*
* Some versions of the HP system software still use "_" at the beginning
* of exported symbols while others don't; try both forms of each name.
*/
|
| ︙ | ︙ |
Changes to unix/tclSelectNotfy.c.
| ︙ | ︙ | |||
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 | * pipe. Hence writing to this file descriptor will cause the select() system * call to return and wake up the notifier thread. * * You must hold the notifierMutex lock before writing to the pipe. */ static int triggerPipe = -1; /* * The notifierMutex locks access to all of the global notifier state. */ static pthread_mutex_t notifierInitMutex = PTHREAD_MUTEX_INITIALIZER; static pthread_mutex_t notifierMutex = PTHREAD_MUTEX_INITIALIZER; /* * The following static indicates if the notifier thread is running. * * You must hold the notifierInitMutex before accessing this variable. */ static int notifierThreadRunning = 0; /* * The notifier thread signals the notifierCV when it has finished * initializing the triggerPipe and right before the notifier thread | > > > > > > > | | 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 | * pipe. Hence writing to this file descriptor will cause the select() system * call to return and wake up the notifier thread. * * You must hold the notifierMutex lock before writing to the pipe. */ static int triggerPipe = -1; static int otherPipe = -1; /* * The notifierMutex locks access to all of the global notifier state. */ static pthread_mutex_t notifierInitMutex = PTHREAD_MUTEX_INITIALIZER; static pthread_mutex_t notifierMutex = PTHREAD_MUTEX_INITIALIZER; /* * The following static indicates if the notifier thread is running. * * You must hold the notifierInitMutex before accessing this variable. */ static int notifierThreadRunning = 0; /* * The following static flag indicates that async handlers are pending. */ static int asyncPending = 0; /* * The notifier thread signals the notifierCV when it has finished * initializing the triggerPipe and right before the notifier thread * terminates. This condition is used to deal with the signal mask, too. */ static pthread_cond_t notifierCV = PTHREAD_COND_INITIALIZER; /* * The pollState bits: * |
| ︙ | ︙ | |||
186 187 188 189 190 191 192 193 194 195 196 197 198 199 | #define POLL_DONE 0x2 /* * This is the thread ID of the notifier thread that does select. */ static Tcl_ThreadId notifierThread; #endif /* TCL_THREADS */ /* * Static routines defined in this file. */ #if TCL_THREADS | > > > > > > > > > > | 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 | #define POLL_DONE 0x2 /* * This is the thread ID of the notifier thread that does select. */ static Tcl_ThreadId notifierThread; /* * Signal mask information for notifier thread. */ static sigset_t notifierSigMask; #ifndef HAVE_PSELECT static sigset_t allSigMask; #endif /* HAVE_PSELECT */ #endif /* TCL_THREADS */ /* * Static routines defined in this file. */ #if TCL_THREADS |
| ︙ | ︙ | |||
212 213 214 215 216 217 218 |
#if defined(__CYGWIN__)
#ifdef __cplusplus
extern "C" {
#endif
typedef struct {
void *hwnd; /* Messaging window. */
unsigned int *message; /* Message payload. */
| | | | 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 |
#if defined(__CYGWIN__)
#ifdef __cplusplus
extern "C" {
#endif
typedef struct {
void *hwnd; /* Messaging window. */
unsigned int *message; /* Message payload. */
size_t wParam; /* Event-specific "word" parameter. */
size_t lParam; /* Event-specific "long" parameter. */
int time; /* Event timestamp. */
int x; /* Event location (where meaningful). */
int y;
int lPrivate;
} MSG;
typedef struct {
|
| ︙ | ︙ | |||
240 241 242 243 244 245 246 | #ifdef __clang__ #pragma clang diagnostic ignored "-Wignored-attributes" #endif extern void __stdcall CloseHandle(void *); extern void *__stdcall CreateEventW(void *, unsigned char, unsigned char, void *); extern void *__stdcall CreateWindowExW(void *, const void *, const void *, | | | > > | > > > | | | < < < | | | | | > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < < | > | | | < < < < | | | | | | | | | | | | | | | | | | | | | | | | | | > > > > > > | | > > | | | | | | | | | < | | < < < < | | < < < < < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < | | | < < < | | < | | | < | | | < < < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < | | 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 |
#ifdef __clang__
#pragma clang diagnostic ignored "-Wignored-attributes"
#endif
extern void __stdcall CloseHandle(void *);
extern void *__stdcall CreateEventW(void *, unsigned char, unsigned char,
void *);
extern void *__stdcall CreateWindowExW(void *, const void *, const void *,
unsigned int, int, int, int, int, void *, void *,
void *, void *);
extern unsigned int __stdcall DefWindowProcW(void *, int, void *, void *);
extern unsigned char __stdcall DestroyWindow(void *);
extern int __stdcall DispatchMessageW(const MSG *);
extern unsigned char __stdcall GetMessageW(MSG *, void *, int, int);
extern void __stdcall MsgWaitForMultipleObjects(unsigned int, void *,
unsigned char, unsigned int, unsigned int);
extern unsigned char __stdcall PeekMessageW(MSG *, void *, int, int, int);
extern unsigned char __stdcall PostMessageW(void *, unsigned int, void *,
void *);
extern void __stdcall PostQuitMessage(int);
extern void *__stdcall RegisterClassW(const WNDCLASSW *);
extern unsigned char __stdcall ResetEvent(void *);
extern unsigned char __stdcall TranslateMessage(const MSG *);
/*
* Threaded-cygwin specific constants and functions in this file:
*/
#if TCL_THREADS && defined(__CYGWIN__)
static const wchar_t className[] = L"TclNotifier";
static unsigned int __stdcall NotifierProc(void *hwnd, unsigned int message,
void *wParam, void *lParam);
#endif /* TCL_THREADS && defined(__CYGWIN__) */
#ifdef __cplusplus
}
#endif
#endif /* TCL_THREADS && __CYGWIN__ */
/*
* Incorporate the base notifier implementation.
*/
#include "tclUnixNotfy.c"
/*
*----------------------------------------------------------------------
*
* TclpInitNotifier --
*
* Initializes the platform specific notifier state.
*
* Results:
* Returns a handle to the notifier state for this thread.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
ClientData
TclpInitNotifier(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
#if TCL_THREADS
tsdPtr->eventReady = 0;
/*
* Initialize thread specific condition variable for this thread.
*/
if (tsdPtr->waitCVinitialized == 0) {
#ifdef __CYGWIN__
WNDCLASSW clazz;
clazz.style = 0;
clazz.cbClsExtra = 0;
clazz.cbWndExtra = 0;
clazz.hInstance = TclWinGetTclInstance();
clazz.hbrBackground = NULL;
clazz.lpszMenuName = NULL;
clazz.lpszClassName = className;
clazz.lpfnWndProc = (void *) NotifierProc;
clazz.hIcon = NULL;
clazz.hCursor = NULL;
RegisterClassW(&clazz);
tsdPtr->hwnd = CreateWindowExW(NULL, clazz.lpszClassName,
clazz.lpszClassName, 0, 0, 0, 0, 0, NULL, NULL,
clazz.hInstance, NULL);
tsdPtr->event = CreateEventW(NULL, 1 /* manual */,
0 /* !signaled */, NULL);
#else /* !__CYGWIN__ */
pthread_cond_init(&tsdPtr->waitCV, NULL);
#endif /* __CYGWIN__ */
tsdPtr->waitCVinitialized = 1;
}
pthread_mutex_lock(¬ifierInitMutex);
#if defined(HAVE_PTHREAD_ATFORK)
/*
* Install pthread_atfork handlers to clean up the notifier in the child
* of a fork.
*/
if (!atForkInit) {
int result = pthread_atfork(NULL, NULL, AtForkChild);
if (result) {
Tcl_Panic("Tcl_InitNotifier: %s", "pthread_atfork failed");
}
atForkInit = 1;
}
#endif /* HAVE_PTHREAD_ATFORK */
notifierCount++;
pthread_mutex_unlock(¬ifierInitMutex);
#endif /* TCL_THREADS */
return tsdPtr;
}
/*
*----------------------------------------------------------------------
*
* TclpFinalizeNotifier --
*
* This function is called to cleanup the notifier state before a thread
* is terminated.
*
* Results:
* None.
*
* Side effects:
* May terminate the background notifier thread if this is the last
* notifier instance.
*
*----------------------------------------------------------------------
*/
void
TclpFinalizeNotifier(
TCL_UNUSED(void *))
{
#if TCL_THREADS
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
pthread_mutex_lock(¬ifierInitMutex);
notifierCount--;
/*
* If this is the last thread to use the notifier, close the notifier pipe
* and wait for the background thread to terminate.
*/
if (notifierCount == 0 && triggerPipe != -1) {
if (write(triggerPipe, "q", 1) != 1) {
Tcl_Panic("Tcl_FinalizeNotifier: %s",
"unable to write 'q' to triggerPipe");
}
close(triggerPipe);
pthread_mutex_lock(¬ifierMutex);
while(triggerPipe != -1) {
pthread_cond_wait(¬ifierCV, ¬ifierMutex);
}
pthread_mutex_unlock(¬ifierMutex);
if (notifierThreadRunning) {
int result = pthread_join((pthread_t) notifierThread, NULL);
if (result) {
Tcl_Panic("Tcl_FinalizeNotifier: %s",
"unable to join notifier thread");
}
notifierThreadRunning = 0;
/*
* If async marks are outstanding, perform actions now.
*/
if (asyncPending) {
asyncPending = 0;
TclAsyncMarkFromNotifier();
}
}
}
/*
* Clean up any synchronization objects in the thread local storage.
*/
#ifdef __CYGWIN__
DestroyWindow(tsdPtr->hwnd);
CloseHandle(tsdPtr->event);
#else /* !__CYGWIN__ */
pthread_cond_destroy(&tsdPtr->waitCV);
#endif /* __CYGWIN__ */
tsdPtr->waitCVinitialized = 0;
pthread_mutex_unlock(¬ifierInitMutex);
#endif /* TCL_THREADS */
}
/*
*----------------------------------------------------------------------
*
* TclpCreateFileHandler --
*
* This function registers a file handler with the select notifier.
*
* Results:
* None.
*
* Side effects:
* Creates a new file handler structure.
*
*----------------------------------------------------------------------
*/
void
TclpCreateFileHandler(
int fd, /* Handle of stream to watch. */
int mask, /* OR'ed combination of TCL_READABLE,
* TCL_WRITABLE, and TCL_EXCEPTION: indicates
* conditions under which proc should be
* called. */
Tcl_FileProc *proc, /* Function to call for each selected
* event. */
ClientData clientData) /* Arbitrary data to pass to proc. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL);
if (filePtr == NULL) {
filePtr = (FileHandler *) ckalloc(sizeof(FileHandler));
filePtr->fd = fd;
filePtr->readyMask = 0;
filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
tsdPtr->firstFileHandlerPtr = filePtr;
}
filePtr->proc = proc;
filePtr->clientData = clientData;
filePtr->mask = mask;
/*
* Update the check masks for this file.
*/
if (mask & TCL_READABLE) {
FD_SET(fd, &tsdPtr->checkMasks.readable);
} else {
FD_CLR(fd, &tsdPtr->checkMasks.readable);
}
if (mask & TCL_WRITABLE) {
FD_SET(fd, &tsdPtr->checkMasks.writable);
} else {
FD_CLR(fd, &tsdPtr->checkMasks.writable);
}
if (mask & TCL_EXCEPTION) {
FD_SET(fd, &tsdPtr->checkMasks.exception);
} else {
FD_CLR(fd, &tsdPtr->checkMasks.exception);
}
if (tsdPtr->numFdBits <= fd) {
tsdPtr->numFdBits = fd + 1;
}
}
/*
*----------------------------------------------------------------------
*
* TclpDeleteFileHandler --
*
* Cancel a previously-arranged callback arrangement for a file.
*
* Results:
* None.
*
* Side effects:
* If a callback was previously registered on file, remove it.
*
*----------------------------------------------------------------------
*/
void
TclpDeleteFileHandler(
int fd) /* Stream id for which to remove callback
* function. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
FileHandler *filePtr, *prevPtr;
int i;
/*
* Find the entry for the given file (and return if there isn't one).
*/
filePtr = LookUpFileHandler(tsdPtr, fd, &prevPtr);
if (filePtr == NULL) {
return;
}
/*
* Update the check masks for this file.
*/
if (filePtr->mask & TCL_READABLE) {
FD_CLR(fd, &tsdPtr->checkMasks.readable);
}
if (filePtr->mask & TCL_WRITABLE) {
FD_CLR(fd, &tsdPtr->checkMasks.writable);
}
if (filePtr->mask & TCL_EXCEPTION) {
FD_CLR(fd, &tsdPtr->checkMasks.exception);
}
/*
* Find current max fd.
*/
if (fd + 1 == tsdPtr->numFdBits) {
int numFdBits = 0;
for (i = fd - 1; i >= 0; i--) {
if (FD_ISSET(i, &tsdPtr->checkMasks.readable)
|| FD_ISSET(i, &tsdPtr->checkMasks.writable)
|| FD_ISSET(i, &tsdPtr->checkMasks.exception)) {
numFdBits = i + 1;
break;
}
}
tsdPtr->numFdBits = numFdBits;
}
/*
* Clean up information in the callback record.
*/
if (prevPtr == NULL) {
tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
} else {
prevPtr->nextPtr = filePtr->nextPtr;
}
ckfree(filePtr);
}
#if TCL_THREADS && defined(__CYGWIN__)
static unsigned int __stdcall
NotifierProc(
void *hwnd,
unsigned int message,
void *wParam,
void *lParam)
|
| ︙ | ︙ | |||
621 622 623 624 625 626 627 |
return 0;
}
#endif /* TCL_THREADS && __CYGWIN__ */
/*
*----------------------------------------------------------------------
*
| | | < < < | | | | | | | | | | | | | | | | < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | > < | > > > > > > > > | 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 |
return 0;
}
#endif /* TCL_THREADS && __CYGWIN__ */
/*
*----------------------------------------------------------------------
*
* TclpWaitForEvent --
*
* This function is called by Tcl_DoOneEvent to wait for new events on
* the message queue. If the block time is 0, then Tcl_WaitForEvent just
* polls without blocking.
*
* Results:
* Returns -1 if the select would block forever, otherwise returns 0.
*
* Side effects:
* Queues file events that are detected by the select.
*
*----------------------------------------------------------------------
*/
int
TclpWaitForEvent(
const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
{
FileHandler *filePtr;
int mask;
Tcl_Time vTime;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
#if TCL_THREADS
int waitForFiles;
# ifdef __CYGWIN__
MSG msg;
# endif /* __CYGWIN__ */
#else /* !TCL_THREADS */
/*
* Impl. notes: timeout & timeoutPtr are used if, and only if threads are
* not enabled. They are the arguments for the regular select() used when
* the core is not thread-enabled.
*/
struct timeval timeout, *timeoutPtr;
int numFound;
#endif /* TCL_THREADS */
/*
* Set up the timeout structure. Note that if there are no events to check
* for, we return with a negative result rather than blocking forever.
*/
if (timePtr != NULL) {
/*
* TIP #233 (Virtualized Time). Is virtual time in effect? And do we
* actually have something to scale? If yes to both then we call the
* handler to do this scaling.
*/
if (timePtr->sec != 0 || timePtr->usec != 0) {
vTime = *timePtr;
TclScaleTime(&vTime);
timePtr = &vTime;
}
#if !TCL_THREADS
timeout.tv_sec = timePtr->sec;
timeout.tv_usec = timePtr->usec;
timeoutPtr = &timeout;
} else if (tsdPtr->numFdBits == 0) {
/*
* If there are no threads, no timeout, and no fds registered, then
* there are no events possible and we must avoid deadlock. Note that
* this is not entirely correct because there might be a signal that
* could interrupt the select call, but we don't handle that case if
* we aren't using threads.
*/
return -1;
} else {
timeoutPtr = NULL;
#endif /* !TCL_THREADS */
}
#if TCL_THREADS
/*
* Start notifier thread and place this thread on the list of interested
* threads, signal the notifier thread, and wait for a response or a
* timeout.
*/
StartNotifierThread("Tcl_WaitForEvent");
pthread_mutex_lock(¬ifierMutex);
if (timePtr != NULL && timePtr->sec == 0 && (timePtr->usec == 0
#if defined(__APPLE__) && defined(__LP64__)
/*
* On 64-bit Darwin, pthread_cond_timedwait() appears to have a
* bug that causes it to wait forever when passed an absolute time
* which has already been exceeded by the system time; as a
* workaround, when given a very brief timeout, just do a poll.
* [Bug 1457797]
*/
|| timePtr->usec < 10
#endif /* __APPLE__ && __LP64__ */
)) {
/*
* Cannot emulate a polling select with a polling condition variable.
* Instead, pretend to wait for files and tell the notifier thread
* what we are doing. The notifier thread makes sure it goes through
* select with its select mask in the same state as ours currently is.
* We block until that happens.
*/
waitForFiles = 1;
tsdPtr->pollState = POLL_WANT;
timePtr = NULL;
} else {
waitForFiles = (tsdPtr->numFdBits > 0);
tsdPtr->pollState = 0;
}
if (waitForFiles) {
/*
* Add the ThreadSpecificData structure of this thread to the list of
* ThreadSpecificData structures of all threads that are waiting on
* file events.
*/
tsdPtr->nextPtr = waitingListPtr;
if (waitingListPtr) {
waitingListPtr->prevPtr = tsdPtr;
}
tsdPtr->prevPtr = 0;
waitingListPtr = tsdPtr;
tsdPtr->onList = 1;
if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) {
Tcl_Panic("Tcl_WaitForEvent: %s",
"unable to write to triggerPipe");
}
}
FD_ZERO(&tsdPtr->readyMasks.readable);
FD_ZERO(&tsdPtr->readyMasks.writable);
FD_ZERO(&tsdPtr->readyMasks.exception);
if (!tsdPtr->eventReady) {
#ifdef __CYGWIN__
if (!PeekMessageW(&msg, NULL, 0, 0, 0)) {
unsigned int timeout;
if (timePtr) {
timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
} else {
timeout = 0xFFFFFFFF;
}
pthread_mutex_unlock(¬ifierMutex);
MsgWaitForMultipleObjects(1, &tsdPtr->event, 0, timeout, 1279);
pthread_mutex_lock(¬ifierMutex);
}
#else /* !__CYGWIN__ */
if (timePtr != NULL) {
Tcl_Time now;
struct timespec ptime;
Tcl_GetTime(&now);
ptime.tv_sec = timePtr->sec + now.sec +
(timePtr->usec + now.usec) / 1000000;
ptime.tv_nsec = 1000 * ((timePtr->usec + now.usec) % 1000000);
pthread_cond_timedwait(&tsdPtr->waitCV, ¬ifierMutex, &ptime);
} else {
pthread_cond_wait(&tsdPtr->waitCV, ¬ifierMutex);
}
#endif /* __CYGWIN__ */
}
tsdPtr->eventReady = 0;
#ifdef __CYGWIN__
while (PeekMessageW(&msg, NULL, 0, 0, 0)) {
/*
* Retrieve and dispatch the message.
*/
unsigned int result = GetMessageW(&msg, NULL, 0, 0);
if (result == 0) {
PostQuitMessage(msg.wParam);
/* What to do here? */
} else if (result != (unsigned int) -1) {
TranslateMessage(&msg);
DispatchMessageW(&msg);
}
}
ResetEvent(tsdPtr->event);
#endif /* __CYGWIN__ */
if (waitForFiles && tsdPtr->onList) {
/*
* Remove the ThreadSpecificData structure of this thread from the
* waiting list. Alert the notifier thread to recompute its select
* masks - skipping this caused a hang when trying to close a pipe
* which the notifier thread was still doing a select on.
*/
if (tsdPtr->prevPtr) {
tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
} else {
waitingListPtr = tsdPtr->nextPtr;
}
if (tsdPtr->nextPtr) {
tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
}
tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
tsdPtr->onList = 0;
if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) {
Tcl_Panic("Tcl_WaitForEvent: %s",
"unable to write to triggerPipe");
}
}
#else /* !TCL_THREADS */
tsdPtr->readyMasks = tsdPtr->checkMasks;
numFound = select(tsdPtr->numFdBits, &tsdPtr->readyMasks.readable,
&tsdPtr->readyMasks.writable, &tsdPtr->readyMasks.exception,
timeoutPtr);
/*
* Some systems don't clear the masks after an error, so we have to do it
* here.
*/
if (numFound == -1) {
FD_ZERO(&tsdPtr->readyMasks.readable);
FD_ZERO(&tsdPtr->readyMasks.writable);
FD_ZERO(&tsdPtr->readyMasks.exception);
}
#endif /* TCL_THREADS */
/*
* Queue all detected file events before returning.
*/
for (filePtr = tsdPtr->firstFileHandlerPtr; (filePtr != NULL);
filePtr = filePtr->nextPtr) {
mask = 0;
if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.readable)) {
mask |= TCL_READABLE;
}
if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.writable)) {
mask |= TCL_WRITABLE;
}
if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.exception)) {
mask |= TCL_EXCEPTION;
}
if (!mask) {
continue;
}
/*
* Don't bother to queue an event if the mask was previously non-zero
* since an event must still be on the queue.
*/
if (filePtr->readyMask == 0) {
FileHandlerEvent *fileEvPtr =
(FileHandlerEvent *) ckalloc(sizeof(FileHandlerEvent));
fileEvPtr->header.proc = FileHandlerEventProc;
fileEvPtr->fd = filePtr->fd;
Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
}
filePtr->readyMask = mask;
}
#if TCL_THREADS
pthread_mutex_unlock(¬ifierMutex);
#endif /* TCL_THREADS */
return 0;
}
/*
*----------------------------------------------------------------------
*
* TclAsyncNotifier --
*
* This procedure sets the async mark of an async handler to a
* given value, if it is called from the notifier thread.
*
* Result:
* True, when the handler will be marked, false otherwise.
*
* Side effetcs:
* The trigger pipe is written when called from the notifier
* thread.
*
*----------------------------------------------------------------------
*/
int
TclAsyncNotifier(
int sigNumber, /* Signal number. */
TCL_UNUSED(Tcl_ThreadId), /* Target thread. */
TCL_UNUSED(ClientData), /* Notifier data. */
int *flagPtr, /* Flag to mark. */
int value) /* Value of mark. */
{
#if TCL_THREADS
/*
* WARNING:
* This code most likely runs in a signal handler. Thus,
* only few async-signal-safe system calls are allowed,
* e.g. pthread_self(), sem_post(), write().
*/
if (pthread_equal(pthread_self(), (pthread_t) notifierThread)) {
if (notifierThreadRunning) {
*flagPtr = value;
if (!asyncPending) {
asyncPending = 1;
write(triggerPipe, "S", 1);
}
return 1;
}
return 0;
}
/*
* Re-send the signal to the notifier thread.
*/
pthread_kill((pthread_t) notifierThread, sigNumber);
#else
(void)sigNumber;
(void)flagPtr;
(void)value;
#endif
return 0;
}
/*
*----------------------------------------------------------------------
*
* NotifierThreadProc --
*
* This routine is the initial (and only) function executed by the
* special notifier thread. Its job is to wait for file descriptors to
* become readable or writable or to have an exception condition and then
* to notify other threads who are interested in this information by
* signalling a condition variable. Other threads can signal this
* notifier thread of a change in their interests by writing a single
* byte to a special pipe that the notifier thread is monitoring.
*
* Result:
* None. Once started, this routine normally never exits and usually dies
* with the overall process, but it can be shut down if the Tcl library
* is finalized.
*
* Side effects:
* The trigger pipe used to signal the notifier thread is created when
* the notifier thread first starts.
*
*----------------------------------------------------------------------
*/
#if TCL_THREADS
static TCL_NORETURN void
NotifierThreadProc(
TCL_UNUSED(ClientData))
{
ThreadSpecificData *tsdPtr;
fd_set readableMask;
fd_set writableMask;
fd_set exceptionMask;
int i, fds[2], receivePipe, ret;
long found;
struct timeval poll = {0, 0}, *timePtr;
char buf[2];
int numFdBits = 0;
if (pipe(fds) != 0) {
Tcl_Panic("NotifierThreadProc: %s", "could not create trigger pipe");
}
/*
* Ticket [c6897e6e6a].
*/
if (fds[0] >= FD_SETSIZE || fds[1] >= FD_SETSIZE) {
Tcl_Panic("NotifierThreadProc: %s", "too many open files");
}
receivePipe = fds[0];
if (TclUnixSetBlockingMode(receivePipe, TCL_MODE_NONBLOCKING) < 0) {
Tcl_Panic("NotifierThreadProc: %s",
"could not make receive pipe non blocking");
}
|
| ︙ | ︙ | |||
967 968 969 970 971 972 973 974 975 976 977 978 979 980 |
/*
* Install the write end of the pipe into the global variable.
*/
pthread_mutex_lock(¬ifierMutex);
triggerPipe = fds[1];
/*
* Signal any threads that are waiting.
*/
pthread_cond_broadcast(¬ifierCV);
pthread_mutex_unlock(¬ifierMutex);
| > | 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 |
/*
* Install the write end of the pipe into the global variable.
*/
pthread_mutex_lock(¬ifierMutex);
triggerPipe = fds[1];
otherPipe = fds[0];
/*
* Signal any threads that are waiting.
*/
pthread_cond_broadcast(¬ifierCV);
pthread_mutex_unlock(¬ifierMutex);
|
| ︙ | ︙ | |||
1027 1028 1029 1030 1031 1032 1033 |
*/
if (receivePipe >= numFdBits) {
numFdBits = receivePipe + 1;
}
FD_SET(receivePipe, &readableMask);
| > > > > > > > > > > > > > > > > > > > > | | > > > > < > > > > > | > > > > | | 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 |
*/
if (receivePipe >= numFdBits) {
numFdBits = receivePipe + 1;
}
FD_SET(receivePipe, &readableMask);
/*
* Signals are unblocked only during select().
*/
#ifdef HAVE_PSELECT
{
struct timespec tspec, *tspecPtr;
if (timePtr == NULL) {
tspecPtr = NULL;
} else {
tspecPtr = &tspec;
tspecPtr->tv_sec = timePtr->tv_sec;
tspecPtr->tv_nsec = timePtr->tv_usec * 1000;
}
ret = pselect(numFdBits, &readableMask, &writableMask,
&exceptionMask, tspecPtr, ¬ifierSigMask);
}
#else
pthread_sigmask(SIG_SETMASK, ¬ifierSigMask, NULL);
ret = select(numFdBits, &readableMask, &writableMask, &exceptionMask,
timePtr);
pthread_sigmask(SIG_BLOCK, &allSigMask, NULL);
#endif
if (ret == -1) {
/*
* In case a signal was caught during select(),
* perform work on async handlers now.
*/
if (errno == EINTR && asyncPending) {
asyncPending = 0;
TclAsyncMarkFromNotifier();
}
/*
* Try again immediately on select() error.
*/
continue;
}
/*
* Alert any threads that are waiting on a ready file descriptor.
*/
pthread_mutex_lock(¬ifierMutex);
for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
found = 0;
for (i = tsdPtr->numFdBits - 1; i >= 0; --i) {
if (FD_ISSET(i, &tsdPtr->checkMasks.readable)
&& FD_ISSET(i, &readableMask)) {
FD_SET(i, &tsdPtr->readyMasks.readable);
found = 1;
}
if (FD_ISSET(i, &tsdPtr->checkMasks.writable)
&& FD_ISSET(i, &writableMask)) {
|
| ︙ | ︙ | |||
1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 |
* message [Bug: 4139] and then closed the write end of the
* pipe so we need to shut down the notifier thread.
*/
break;
}
} while (1);
if ((i == 0) || (buf[0] == 'q')) {
break;
}
}
/*
* Clean up the read end of the pipe and signal any threads waiting on
* termination of the notifier thread.
*/
close(receivePipe);
pthread_mutex_lock(¬ifierMutex);
triggerPipe = -1;
pthread_cond_broadcast(¬ifierCV);
pthread_mutex_unlock(¬ifierMutex);
TclpThreadExit(0);
}
#endif /* TCL_THREADS */
#endif /* (!NOTIFIER_EPOLL && !NOTIFIER_KQUEUE) || !TCL_THREADS */
#endif /* !HAVE_COREFOUNDATION */
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
| > > > > > > > > > | 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 |
* message [Bug: 4139] and then closed the write end of the
* pipe so we need to shut down the notifier thread.
*/
break;
}
} while (1);
if (asyncPending) {
asyncPending = 0;
TclAsyncMarkFromNotifier();
}
if ((i == 0) || (buf[0] == 'q')) {
break;
}
}
/*
* Clean up the read end of the pipe and signal any threads waiting on
* termination of the notifier thread.
*/
close(receivePipe);
pthread_mutex_lock(¬ifierMutex);
triggerPipe = -1;
otherPipe = -1;
pthread_cond_broadcast(¬ifierCV);
pthread_mutex_unlock(¬ifierMutex);
TclpThreadExit(0);
}
#endif /* TCL_THREADS */
#endif /* (!NOTIFIER_EPOLL && !NOTIFIER_KQUEUE) || !TCL_THREADS */
#else
TCL_MAC_EMPTY_FILE(unix_tclSelectNotfy_c)
#endif /* !HAVE_COREFOUNDATION */
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Changes to unix/tclUnixEvent.c.
| ︙ | ︙ | |||
60 61 62 63 64 65 66 |
if (vdelay.usec < 0) {
vdelay.usec += 1000000;
vdelay.sec -= 1;
}
if ((vdelay.sec != 0) || (vdelay.usec != 0)) {
| | > > | 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 |
if (vdelay.usec < 0) {
vdelay.usec += 1000000;
vdelay.sec -= 1;
}
if ((vdelay.sec != 0) || (vdelay.usec != 0)) {
TclScaleTime(&vdelay);
}
delay.tv_sec = vdelay.sec;
delay.tv_usec = vdelay.usec;
/*
* Special note: must convert delay.tv_sec to int before comparing to
* zero, since delay.tv_usec is unsigned on some platforms.
*/
if ((((int) delay.tv_sec) < 0)
|| ((delay.tv_usec == 0) && (delay.tv_sec == 0))) {
break;
}
(void) select(0, (SELECT_MASK *) 0, (SELECT_MASK *) 0,
(SELECT_MASK *) 0, &delay);
Tcl_GetTime(&before);
}
}
#else
TCL_MAC_EMPTY_FILE(unix_tclUnixEvent_c)
#endif /* HAVE_COREFOUNDATION */
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Changes to unix/tclUnixFCmd.c.
| ︙ | ︙ | |||
2235 2236 2237 2238 2239 2240 2241 |
* Helper that does *part* of what tempnam() does.
*/
static const char *
DefaultTempDir(void)
{
const char *dir;
| | | | | 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 |
* Helper that does *part* of what tempnam() does.
*/
static const char *
DefaultTempDir(void)
{
const char *dir;
Tcl_StatBuf buf;
dir = getenv("TMPDIR");
if (dir && dir[0] && TclOSstat(dir, &buf) == 0 && S_ISDIR(buf.st_mode)
&& access(dir, W_OK) == 0) {
return dir;
}
#ifdef P_tmpdir
dir = P_tmpdir;
if (TclOSstat(dir, &buf)==0 && S_ISDIR(buf.st_mode) && access(dir, W_OK)==0) {
return dir;
}
#endif
/*
* Assume that the default location ("/tmp" if not overridden) is always
* an existing writable directory; we've no recovery mechanism if it
|
| ︙ | ︙ | |||
2346 2347 2348 2349 2350 2351 2352 |
static void
StatError(
Tcl_Interp *interp, /* The interp that has the error */
Tcl_Obj *fileName) /* The name of the file which caused the
* error. */
{
| | | 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 |
static void
StatError(
Tcl_Interp *interp, /* The interp that has the error */
Tcl_Obj *fileName) /* The name of the file which caused the
* error. */
{
Tcl_WinConvertError(GetLastError());
Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s",
TclGetString(fileName), Tcl_PosixError(interp)));
}
static WCHAR *
winPathFromObj(
Tcl_Obj *fileName)
|
| ︙ | ︙ |
Changes to unix/tclUnixFile.c.
| ︙ | ︙ | |||
37 38 39 40 41 42 43 |
#ifdef __CYGWIN__
void
TclpFindExecutable(
TCL_UNUSED(const char *) /*argv0*/)
{
Tcl_Encoding encoding;
int length;
| | | | 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 |
#ifdef __CYGWIN__
void
TclpFindExecutable(
TCL_UNUSED(const char *) /*argv0*/)
{
Tcl_Encoding encoding;
int length;
wchar_t buf[PATH_MAX] = L"";
char name[PATH_MAX * 3 + 1];
GetModuleFileNameW(NULL, buf, PATH_MAX);
cygwin_conv_path(3, buf, name, sizeof(name));
length = strlen(name);
if ((length > 4) && !strcasecmp(name + length - 4, ".exe")) {
/* Strip '.exe' part. */
length -= 4;
}
encoding = Tcl_GetEncoding(NULL, NULL);
|
| ︙ | ︙ | |||
1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 |
Tcl_Obj *pathPtr, /* File to modify */
struct utimbuf *tval) /* New modification date structure */
{
return utime((const char *)Tcl_FSGetNativePath(pathPtr), tval);
}
#ifdef __CYGWIN__
int
TclOSstat(
const char *name,
void *cygstat)
{
struct stat buf;
| > > > > > > > > > > > > > > > > > > > > > > > | 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 |
Tcl_Obj *pathPtr, /* File to modify */
struct utimbuf *tval) /* New modification date structure */
{
return utime((const char *)Tcl_FSGetNativePath(pathPtr), tval);
}
#ifdef __CYGWIN__
int
TclOSfstat(
int fd,
void *cygstat)
{
struct stat buf;
Tcl_StatBuf *statBuf = (Tcl_StatBuf *)cygstat;
int result = fstat(fd, &buf);
statBuf->st_mode = buf.st_mode;
statBuf->st_ino = buf.st_ino;
statBuf->st_dev = buf.st_dev;
statBuf->st_rdev = buf.st_rdev;
statBuf->st_nlink = buf.st_nlink;
statBuf->st_uid = buf.st_uid;
statBuf->st_gid = buf.st_gid;
statBuf->st_size = buf.st_size;
statBuf->st_atime = buf.st_atime;
statBuf->st_mtime = buf.st_mtime;
statBuf->st_ctime = buf.st_ctime;
return result;
}
int
TclOSstat(
const char *name,
void *cygstat)
{
struct stat buf;
|
| ︙ | ︙ |
Changes to unix/tclUnixNotfy.c.
1 2 3 4 | /* * tclUnixNotfy.c -- * * This file contains subroutines shared by all notifier backend | | > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | /* * tclUnixNotfy.c -- * * This file contains subroutines shared by all notifier backend * implementations on *nix platforms. It is *included* by the epoll, * kqueue and select notifier implementation files. * * Copyright © 1995-1997 Sun Microsystems, Inc. * Copyright © 2016 Lucio Andrés Illanes Albornoz <l.illanes@gmx.de> * Copyright © 2021 Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include <poll.h> #include "tclInt.h" |
| ︙ | ︙ | |||
41 42 43 44 45 46 47 48 | * None. * * Side effects: * Running Thread. * *---------------------------------------------------------------------- */ static void | > | > > | | 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 |
* None.
*
* Side effects:
* Running Thread.
*
*----------------------------------------------------------------------
*/
static void
StartNotifierThread(
const char *proc)
{
if (!notifierThreadRunning) {
pthread_mutex_lock(¬ifierInitMutex);
if (!notifierThreadRunning) {
if (TclpThreadCreate(¬ifierThread, NotifierThreadProc, NULL,
TCL_THREAD_STACK_DEFAULT, TCL_THREAD_JOINABLE) != TCL_OK) {
Tcl_Panic("%s: unable to start notifier thread", proc);
}
pthread_mutex_lock(¬ifierMutex);
/*
* Wait for the notifier pipe to be created.
*/
while (triggerPipe < 0) {
pthread_cond_wait(¬ifierCV, ¬ifierMutex);
}
pthread_mutex_unlock(¬ifierMutex);
notifierThreadRunning = 1;
}
pthread_mutex_unlock(¬ifierInitMutex);
}
}
#endif /* NOTIFIER_SELECT */
/*
*----------------------------------------------------------------------
*
* TclpAlertNotifier --
*
* Wake up the specified notifier from any thread. This routine is called
* by the platform independent notifier code whenever the Tcl_ThreadAlert
* routine is called. This routine is guaranteed not to be called on a
* given notifier after Tcl_FinalizeNotifier is called for that notifier.
*
* Results:
|
| ︙ | ︙ | |||
95 96 97 98 99 100 101 | * kqueue(2) notifier: * write(2)s to the trigger pipe(2) of the specified thread. * *---------------------------------------------------------------------- */ void | | | < < < < | | | | | | > > | | > | | | | | | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | < < < < | | | | | < | < < < | | 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 |
* kqueue(2) notifier:
* write(2)s to the trigger pipe(2) of the specified thread.
*
*----------------------------------------------------------------------
*/
void
TclpAlertNotifier(
void *clientData)
{
#ifdef NOTIFIER_SELECT
#if TCL_THREADS
ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
pthread_mutex_lock(¬ifierMutex);
tsdPtr->eventReady = 1;
# ifdef __CYGWIN__
PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
# else
pthread_cond_broadcast(&tsdPtr->waitCV);
# endif /* __CYGWIN__ */
pthread_mutex_unlock(¬ifierMutex);
#else
(void)clientData;
#endif /* TCL_THREADS */
#else /* !NOTIFIER_SELECT */
ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
#if defined(NOTIFIER_EPOLL) && defined(HAVE_EVENTFD)
uint64_t eventFdVal = 1;
if (write(tsdPtr->triggerEventFd, &eventFdVal,
sizeof(eventFdVal)) != sizeof(eventFdVal)) {
Tcl_Panic("Tcl_AlertNotifier: unable to write to %p->triggerEventFd",
(void *) tsdPtr);
}
#else
if (write(tsdPtr->triggerPipe[1], "", 1) != 1) {
Tcl_Panic("Tcl_AlertNotifier: unable to write to %p->triggerPipe",
(void *) tsdPtr);
}
#endif /* NOTIFIER_EPOLL && HAVE_EVENTFD */
#endif /* NOTIFIER_SELECT */
}
/*
*----------------------------------------------------------------------
*
* LookUpFileHandler --
*
* Look up the file handler structure (and optionally the previous one in
* the chain) associated with a file descriptor.
*
* Returns:
* A pointer to the file handler, or NULL if it can't be found.
*
* Side effects:
* If prevPtrPtr is non-NULL, it will be written to if the file handler
* is found.
*
*----------------------------------------------------------------------
*/
static inline FileHandler *
LookUpFileHandler(
ThreadSpecificData *tsdPtr, /* Where to look things up. */
int fd, /* What we are looking for. */
FileHandler **prevPtrPtr) /* If non-NULL, where to report the previous
* pointer. */
{
FileHandler *filePtr, *prevPtr;
/*
* Find the entry for the given file (and return if there isn't one).
*/
for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ;
prevPtr = filePtr, filePtr = filePtr->nextPtr) {
if (filePtr == NULL) {
return NULL;
}
if (filePtr->fd == fd) {
break;
}
}
/*
* Report what we've found to our caller.
*/
if (prevPtrPtr) {
*prevPtrPtr = prevPtr;
}
return filePtr;
}
/*
*----------------------------------------------------------------------
*
* TclpSetTimer --
*
* This function sets the current notifier timer value. This interface is
* not implemented in this notifier because we are always running inside
* of Tcl_DoOneEvent.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
void
TclpSetTimer(
TCL_UNUSED(const Tcl_Time *)) /* Timeout value, may be NULL. */
{
/*
* The interval timer doesn't do anything in this implementation, because
* the only event loop is via Tcl_DoOneEvent, which passes timeout values
* to Tcl_WaitForEvent.
*/
}
/*
*----------------------------------------------------------------------
*
* Tcl_ServiceModeHook --
*
* This function is invoked whenever the service mode changes.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
void
TclpServiceModeHook(
int mode) /* Either TCL_SERVICE_ALL, or
* TCL_SERVICE_NONE. */
{
if (mode == TCL_SERVICE_ALL) {
#ifdef NOTIFIER_SELECT
#if TCL_THREADS
StartNotifierThread("Tcl_ServiceModeHook");
#endif
#endif /* NOTIFIER_SELECT */
}
}
|
| ︙ | ︙ | |||
302 303 304 305 306 307 308 |
static void
AlertSingleThread(
ThreadSpecificData *tsdPtr)
{
tsdPtr->eventReady = 1;
if (tsdPtr->onList) {
| | | | | | | | | | | | | | | | 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 |
static void
AlertSingleThread(
ThreadSpecificData *tsdPtr)
{
tsdPtr->eventReady = 1;
if (tsdPtr->onList) {
/*
* Remove the ThreadSpecificData structure of this thread from the
* waiting list. This prevents us from continuously spinning on
* epoll_wait until the other threads runs and services the file
* event.
*/
if (tsdPtr->prevPtr) {
tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
} else {
waitingListPtr = tsdPtr->nextPtr;
}
if (tsdPtr->nextPtr) {
tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
}
tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
tsdPtr->onList = 0;
tsdPtr->pollState = 0;
}
#ifdef __CYGWIN__
PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
#else /* !__CYGWIN__ */
pthread_cond_broadcast(&tsdPtr->waitCV);
#endif /* __CYGWIN__ */
}
|
| ︙ | ︙ | |||
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 |
if (notifierThreadRunning == 1) {
pthread_cond_destroy(¬ifierCV);
}
pthread_mutex_init(¬ifierInitMutex, NULL);
pthread_mutex_init(¬ifierMutex, NULL);
pthread_cond_init(¬ifierCV, NULL);
/*
* notifierThreadRunning == 1: thread is running, (there might be data in
* notifier lists)
* atForkInit == 0: InitNotifier was never called
* notifierCount != 0: unbalanced InitNotifier() / FinalizeNotifier calls
* waitingListPtr != 0: there are threads currently waiting for events.
*/
if (atForkInit == 1) {
notifierCount = 0;
if (notifierThreadRunning == 1) {
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
notifierThreadRunning = 0;
close(triggerPipe);
triggerPipe = -1;
/*
* The waitingListPtr might contain event info from multiple
* threads, which are invalid here, so setting it to NULL is not
* unreasonable.
*/
waitingListPtr = NULL;
| > > > > > > > > | 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 |
if (notifierThreadRunning == 1) {
pthread_cond_destroy(¬ifierCV);
}
pthread_mutex_init(¬ifierInitMutex, NULL);
pthread_mutex_init(¬ifierMutex, NULL);
pthread_cond_init(¬ifierCV, NULL);
#ifdef NOTIFIER_SELECT
asyncPending = 0;
#endif
/*
* notifierThreadRunning == 1: thread is running, (there might be data in
* notifier lists)
* atForkInit == 0: InitNotifier was never called
* notifierCount != 0: unbalanced InitNotifier() / FinalizeNotifier calls
* waitingListPtr != 0: there are threads currently waiting for events.
*/
if (atForkInit == 1) {
notifierCount = 0;
if (notifierThreadRunning == 1) {
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
notifierThreadRunning = 0;
close(triggerPipe);
triggerPipe = -1;
#ifdef NOTIFIER_SELECT
close(otherPipe);
otherPipe = -1;
#endif
/*
* The waitingListPtr might contain event info from multiple
* threads, which are invalid here, so setting it to NULL is not
* unreasonable.
*/
waitingListPtr = NULL;
|
| ︙ | ︙ | |||
408 409 410 411 412 413 414 |
* The list of registered event handlers at fork time is in
* tsdPtr->firstFileHandlerPtr;
*/
}
}
Tcl_InitNotifier();
| | > > > > > > | | > > | > > > > > > > > > > > > > > > > > | > > > > > | > > > > > | | 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 |
* The list of registered event handlers at fork time is in
* tsdPtr->firstFileHandlerPtr;
*/
}
}
Tcl_InitNotifier();
#ifdef NOTIFIER_SELECT
/*
* Restart the notifier thread for signal handling.
*/
StartNotifierThread("AtForkChild");
#endif
}
#endif /* HAVE_PTHREAD_ATFORK */
#endif /* TCL_THREADS */
#endif /* NOTIFIER_SELECT */
/*
*----------------------------------------------------------------------
*
* TclpNotifierData --
*
* This function returns a ClientData pointer to be associated
* with a Tcl_AsyncHandler.
*
* Results:
* For the epoll and kqueue notifiers, this function returns the
* thread specific data. Otherwise NULL.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
ClientData
TclpNotifierData(void)
{
#if defined(NOTIFIER_EPOLL) || defined(NOTIFIER_KQUEUE)
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
return (ClientData) tsdPtr;
#else
return NULL;
#endif
}
/*
*----------------------------------------------------------------------
*
* TclUnixWaitForFile --
*
* This function waits synchronously for a file to become readable or
* writable, with an optional timeout.
|
| ︙ | ︙ | |||
438 439 440 441 442 443 444 445 446 447 448 449 450 451 |
* serviced during the execution of this function.
*
* Side effects:
* Time passes.
*
*----------------------------------------------------------------------
*/
int
TclUnixWaitForFile(
int fd, /* Handle for file on which to wait. */
int mask, /* What to wait for: OR'ed combination of
* TCL_READABLE, TCL_WRITABLE, and
* TCL_EXCEPTION. */
| > > > | 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 |
* serviced during the execution of this function.
*
* Side effects:
* Time passes.
*
*----------------------------------------------------------------------
*/
#ifndef HAVE_COREFOUNDATION /* Darwin/Mac OS X CoreFoundation notifier is
* in tclMacOSXNotify.c */
int
TclUnixWaitForFile(
int fd, /* Handle for file on which to wait. */
int mask, /* What to wait for: OR'ed combination of
* TCL_READABLE, TCL_WRITABLE, and
* TCL_EXCEPTION. */
|
| ︙ | ︙ | |||
559 560 561 562 563 564 565 |
*/
Tcl_GetTime(&now);
} while ((abortTime.sec > now.sec)
|| (abortTime.sec == now.sec && abortTime.usec > now.usec));
return result;
}
| < | | 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 |
*/
Tcl_GetTime(&now);
} while ((abortTime.sec > now.sec)
|| (abortTime.sec == now.sec && abortTime.usec > now.usec));
return result;
}
#endif /* !HAVE_COREFOUNDATION */
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Changes to unix/tclUnixPort.h.
| ︙ | ︙ | |||
116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 |
__declspec(dllimport) extern __stdcall int GetFileAttributesW(const WCHAR *);
__declspec(dllimport) extern __stdcall int SetFileAttributesW(const WCHAR *, int);
__declspec(dllimport) extern int cygwin_conv_path(int, const void *, void *, int);
#ifdef __clang__
#pragma clang diagnostic pop
#endif
# define timezone _timezone
extern int TclOSstat(const char *name, void *statBuf);
extern int TclOSlstat(const char *name, void *statBuf);
#ifdef __cplusplus
}
#endif
#elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__)
# define TclOSstat(name, buf) stat64(name, (struct stat64 *)buf)
# define TclOSlstat(name,buf) lstat64(name, (struct stat64 *)buf)
#else
# define TclOSstat(name, buf) stat(name, (struct stat *)buf)
# define TclOSlstat(name, buf) lstat(name, (struct stat *)buf)
#endif
/*
*---------------------------------------------------------------------------
* Miscellaneous includes that might be missing.
| > > > | 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 |
__declspec(dllimport) extern __stdcall int GetFileAttributesW(const WCHAR *);
__declspec(dllimport) extern __stdcall int SetFileAttributesW(const WCHAR *, int);
__declspec(dllimport) extern int cygwin_conv_path(int, const void *, void *, int);
#ifdef __clang__
#pragma clang diagnostic pop
#endif
# define timezone _timezone
extern int TclOSfstat(int fd, void *statBuf);
extern int TclOSstat(const char *name, void *statBuf);
extern int TclOSlstat(const char *name, void *statBuf);
#ifdef __cplusplus
}
#endif
#elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__)
# define TclOSfstat(fd, buf) fstat64(fd, (struct stat64 *)buf)
# define TclOSstat(name, buf) stat64(name, (struct stat64 *)buf)
# define TclOSlstat(name,buf) lstat64(name, (struct stat64 *)buf)
#else
# define TclOSfstat(fd, buf) fstat(fd, (struct stat *)buf)
# define TclOSstat(name, buf) stat(name, (struct stat *)buf)
# define TclOSlstat(name, buf) lstat(name, (struct stat *)buf)
#endif
/*
*---------------------------------------------------------------------------
* Miscellaneous includes that might be missing.
|
| ︙ | ︙ |
Changes to unix/tclUnixThrd.c.
| ︙ | ︙ | |||
273 274 275 276 277 278 279 280 281 282 283 284 285 286 |
} else {
*idPtr = (Tcl_ThreadId)theThread;
result = TCL_OK;
}
pthread_attr_destroy(&attr);
return result;
#else
return TCL_ERROR;
#endif /* TCL_THREADS */
}
/*
*----------------------------------------------------------------------
*
| > > > > > | 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 |
} else {
*idPtr = (Tcl_ThreadId)theThread;
result = TCL_OK;
}
pthread_attr_destroy(&attr);
return result;
#else
(void)idPtr;
(void)proc;
(void)clientData;
(void)stackSize;
(void)flags;
return TCL_ERROR;
#endif /* TCL_THREADS */
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
310 311 312 313 314 315 316 317 318 319 320 321 322 323 |
result = pthread_join((pthread_t) threadId, (void**) retcodePtr);
if (state) {
*state = (int) retcode;
}
return (result == 0) ? TCL_OK : TCL_ERROR;
#else
return TCL_ERROR;
#endif
}
/*
*----------------------------------------------------------------------
*
| > > > | 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 |
result = pthread_join((pthread_t) threadId, (void**) retcodePtr);
if (state) {
*state = (int) retcode;
}
return (result == 0) ? TCL_OK : TCL_ERROR;
#else
(void)threadId;
(void)state;
return TCL_ERROR;
#endif
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ |
Changes to unix/tclUnixTime.c.
| ︙ | ︙ | |||
55 56 57 58 59 60 61 62 63 64 65 66 67 68 | /* * TIP #233 (Virtualized Time): Data for the time hooks, if any. */ Tcl_GetTimeProc *tclGetTimeProcPtr = NativeGetTime; Tcl_ScaleTimeProc *tclScaleTimeProcPtr = NativeScaleTime; void *tclTimeClientData = NULL; /* *---------------------------------------------------------------------- * * TclpGetSeconds -- * * This procedure returns the number of seconds from the epoch. On most | > > > > > > > > > > > > > > > > > | 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 |
/*
* TIP #233 (Virtualized Time): Data for the time hooks, if any.
*/
Tcl_GetTimeProc *tclGetTimeProcPtr = NativeGetTime;
Tcl_ScaleTimeProc *tclScaleTimeProcPtr = NativeScaleTime;
void *tclTimeClientData = NULL;
/*
* Inlined version of Tcl_GetTime.
*/
static inline void
GetTime(
Tcl_Time *timePtr)
{
tclGetTimeProcPtr(timePtr, tclTimeClientData);
}
static inline int
IsTimeNative(void)
{
return tclGetTimeProcPtr == NativeGetTime;
}
/*
*----------------------------------------------------------------------
*
* TclpGetSeconds --
*
* This procedure returns the number of seconds from the epoch. On most
|
| ︙ | ︙ | |||
101 102 103 104 105 106 107 |
*/
long long
TclpGetMicroseconds(void)
{
Tcl_Time time;
| | | | 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 |
*/
long long
TclpGetMicroseconds(void)
{
Tcl_Time time;
GetTime(&time);
return ((long long) time.sec)*1000000 + time.usec;
}
/*
*----------------------------------------------------------------------
*
* TclpGetClicks --
*
|
| ︙ | ︙ | |||
130 131 132 133 134 135 136 |
unsigned long
TclpGetClicks(void)
{
unsigned long now;
#ifdef NO_GETTOD
| | | | | | | | | 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 |
unsigned long
TclpGetClicks(void)
{
unsigned long now;
#ifdef NO_GETTOD
if (!IsTimeNative()) {
Tcl_Time time;
GetTime(&time);
now = ((unsigned long)(time.sec)*1000000UL) + (unsigned long)(time.usec);
} else {
/*
* A semi-NativeGetTime, specialized to clicks.
*/
struct tms dummy;
now = (unsigned long) times(&dummy);
}
#else /* !NO_GETTOD */
Tcl_Time time;
GetTime(&time);
now = ((unsigned long)(time.sec)*1000000UL) + (unsigned long)(time.usec);
#endif /* NO_GETTOD */
return now;
}
#ifdef TCL_WIDE_CLICKS
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
178 179 180 181 182 183 184 |
*/
long long
TclpGetWideClicks(void)
{
long long now;
| | | | | | 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 |
*/
long long
TclpGetWideClicks(void)
{
long long now;
if (!IsTimeNative()) {
Tcl_Time time;
GetTime(&time);
now = ((long long) time.sec)*1000000 + time.usec;
} else {
#ifdef MAC_OSX_TCL
now = (long long) (mach_absolute_time() & INT64_MAX);
#else
#error Wide high-resolution clicks not implemented on this platform
#endif /* MAC_OSX_TCL */
}
return now;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
217 218 219 220 221 222 223 |
double
TclpWideClicksToNanoseconds(
long long clicks)
{
double nsec;
| | | | 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 |
double
TclpWideClicksToNanoseconds(
long long clicks)
{
double nsec;
if (!IsTimeNative()) {
nsec = clicks * 1000;
} else {
#ifdef MAC_OSX_TCL
static mach_timebase_info_data_t tb;
static uint64_t maxClicksForUInt64;
if (!tb.denom) {
mach_timebase_info(&tb);
maxClicksForUInt64 = UINT64_MAX / tb.numer;
}
if ((uint64_t) clicks < maxClicksForUInt64) {
nsec = ((uint64_t) clicks) * tb.numer / tb.denom;
} else {
nsec = ((long double) (uint64_t) clicks) * tb.numer / tb.denom;
}
#else
#error Wide high-resolution clicks not implemented on this platform
#endif /* MAC_OSX_TCL */
}
return nsec;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
262 263 264 265 266 267 268 |
*
*----------------------------------------------------------------------
*/
double
TclpWideClickInMicrosec(void)
{
| | | | 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 |
*
*----------------------------------------------------------------------
*/
double
TclpWideClickInMicrosec(void)
{
if (!IsTimeNative()) {
return 1.0;
} else {
#ifdef MAC_OSX_TCL
static int initialized = 0;
static double scale = 0.0;
if (initialized) {
return scale;
} else {
mach_timebase_info_data_t tb;
mach_timebase_info(&tb);
/* value of tb.numer / tb.denom = 1 click in nanoseconds */
scale = ((double)tb.numer) / tb.denom / 1000;
initialized = 1;
return scale;
}
#else
#error Wide high-resolution clicks not implemented on this platform
#endif /* MAC_OSX_TCL */
}
}
#endif /* TCL_WIDE_CLICKS */
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
311 312 313 314 315 316 317 |
*----------------------------------------------------------------------
*/
void
Tcl_GetTime(
Tcl_Time *timePtr) /* Location to store time information. */
{
| | | 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 |
*----------------------------------------------------------------------
*/
void
Tcl_GetTime(
Tcl_Time *timePtr) /* Location to store time information. */
{
GetTime(timePtr);
}
/*
*----------------------------------------------------------------------
*
* TclpGetDate --
*
|
| ︙ | ︙ | |||
574 575 576 577 578 579 580 |
if (lastTZ == NULL || strcmp(lastTZ, newTZ)) {
tzset();
if (lastTZ == NULL) {
Tcl_CreateExitHandler(CleanupMemory, NULL);
} else {
ckfree(lastTZ);
}
| | | 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 |
if (lastTZ == NULL || strcmp(lastTZ, newTZ)) {
tzset();
if (lastTZ == NULL) {
Tcl_CreateExitHandler(CleanupMemory, NULL);
} else {
ckfree(lastTZ);
}
lastTZ = (char *) ckalloc(strlen(newTZ) + 1);
strcpy(lastTZ, newTZ);
}
Tcl_MutexUnlock(&tmMutex);
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ |
Changes to unix/tclXtNotify.c.
| ︙ | ︙ | |||
128 129 130 131 132 133 134 |
if (notifier.appContext != NULL) {
if (appContext != NULL) {
/*
* We already have a context. We do not allow switching contexts
* after initialization, so we panic.
*/
| | | 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 |
if (notifier.appContext != NULL) {
if (appContext != NULL) {
/*
* We already have a context. We do not allow switching contexts
* after initialization, so we panic.
*/
Tcl_Panic("TclSetAppContext: multiple application contexts");
}
} else {
/*
* If we get here we have not yet gotten a context, so either create
* one or use the one supplied by our caller.
*/
|
| ︙ | ︙ | |||
177 178 179 180 181 182 183 |
*
*----------------------------------------------------------------------
*/
void
InitNotifier(void)
{
| | > > > > > > < < < < < < < < < | 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 |
*
*----------------------------------------------------------------------
*/
void
InitNotifier(void)
{
static const Tcl_NotifierProcs np =
SetTimer,
WaitForEvent,
CreateFileHandler,
DeleteFileHandler,
NULL, NULL, NULL, NULL
};
/*
* Only reinitialize if we are not in exit handling. The notifier can get
* reinitialized after its own exit handler has run, because of exit
* handlers for the I/O and timer sub-systems (order dependency).
*/
if (TclInExit()) {
return;
}
Tcl_SetNotifier(&np);
/*
* DO NOT create the application context yet; doing so would prevent
* external applications from setting it for us to their own ones.
*/
initialized = 1;
Tcl_CreateExitHandler(NotifierExitHandler, NULL);
}
/*
*----------------------------------------------------------------------
*
* NotifierExitHandler --
|
| ︙ | ︙ | |||
355 356 357 358 359 360 361 |
for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
filePtr = filePtr->nextPtr) {
if (filePtr->fd == fd) {
break;
}
}
if (filePtr == NULL) {
| | | 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 |
for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
filePtr = filePtr->nextPtr) {
if (filePtr->fd == fd) {
break;
}
}
if (filePtr == NULL) {
filePtr = (FileHandler *) ckalloc(sizeof(FileHandler));
filePtr->fd = fd;
filePtr->read = 0;
filePtr->write = 0;
filePtr->except = 0;
filePtr->readyMask = 0;
filePtr->mask = 0;
filePtr->nextPtr = notifier.firstFileHandlerPtr;
|
| ︙ | ︙ | |||
492 493 494 495 496 497 498 |
static void
FileProc(
XtPointer clientData,
int *fd,
XtInputId *id)
{
| | | 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 |
static void
FileProc(
XtPointer clientData,
int *fd,
XtInputId *id)
{
FileHandler *filePtr = (FileHandler *) clientData;
FileHandlerEvent *fileEvPtr;
int mask = 0;
/*
* Determine which event happened.
*/
|
| ︙ | ︙ | |||
521 522 523 524 525 526 527 |
}
/*
* This is an interesting event, so put it onto the event queue.
*/
filePtr->readyMask |= mask;
| | | 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 |
}
/*
* This is an interesting event, so put it onto the event queue.
*/
filePtr->readyMask |= mask;
fileEvPtr = (FileHandlerEvent *) ckalloc(sizeof(FileHandlerEvent));
fileEvPtr->header.proc = FileHandlerEventProc;
fileEvPtr->fd = filePtr->fd;
Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
/*
* Process events on the Tcl event queue before returning to Xt.
*/
|
| ︙ | ︙ |
Changes to unix/tclXtTest.c.
| ︙ | ︙ | |||
12 13 14 15 16 17 18 | #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include <X11/Intrinsic.h> #include "tcl.h" static Tcl_ObjCmdProc TesteventloopCmd; | < | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include <X11/Intrinsic.h> #include "tcl.h" static Tcl_ObjCmdProc TesteventloopCmd; /* * Functions defined in tclXtNotify.c for use by users of the Xt Notifier: */ extern void InitNotifier(void); extern XtAppContext TclSetAppContext(XtAppContext ctx); |
| ︙ | ︙ | |||
40 41 42 43 44 45 46 | * * Side effects: * Depends on the startup script. * *---------------------------------------------------------------------- */ | | | 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 |
*
* Side effects:
* Depends on the startup script.
*
*----------------------------------------------------------------------
*/
DLLEXPORT int
Tclxttest_Init(
Tcl_Interp *interp) /* Interpreter for application. */
{
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
XtToolkitInitialize();
|
| ︙ | ︙ |
Changes to win/Makefile.in.
| ︙ | ︙ | |||
255 256 257 258 259 260 261 |
-I"${ZLIB_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \
${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} -DMP_PREC=4 \
${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS}
CC_OBJNAME = @CC_OBJNAME@
CC_EXENAME = @CC_EXENAME@
| < | | > | | 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 |
-I"${ZLIB_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \
${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} -DMP_PREC=4 \
${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS}
CC_OBJNAME = @CC_OBJNAME@
CC_EXENAME = @CC_EXENAME@
STUB_CC_SWITCHES = -I"${GENERIC_DIR_NATIVE}" -I"${TOMMATH_DIR_NATIVE}" \
-I"${ZLIB_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \
${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} -DMP_PREC=4 \
${AC_FLAGS} ${COMPILE_DEBUG_FLAGS}
TCLTEST_OBJS = \
tclTest.$(OBJEXT) \
tclTestObj.$(OBJEXT) \
tclTestProcBodyObj.$(OBJEXT) \
tclThreadTest.$(OBJEXT) \
tclWinTest.$(OBJEXT)
|
| ︙ | ︙ | |||
537 538 539 540 541 542 543 |
cd ..)
$(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) ${TCL_ZIP_FILE}
$(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \
tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
$(COPY) tclsh.exe.manifest $(TCLSH).manifest
@VC_MANIFEST_EMBED_EXE@
| | | 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 |
cd ..)
$(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) ${TCL_ZIP_FILE}
$(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \
tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
$(COPY) tclsh.exe.manifest $(TCLSH).manifest
@VC_MANIFEST_EMBED_EXE@
if test "${ZIPFS_BUILD}" = "2" ; then \
cat ${TCL_ZIP_FILE} >> ${TCLSH}; \
${NATIVE_ZIP} -A ${TCLSH} \
|| echo 'ignore zip-error by adjust sfx process (not executable?)'; \
fi
cat32.$(OBJEXT): cat.c
$(CC) -c $(CC_SWITCHES) -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME)
|
| ︙ | ︙ | |||
573 574 575 576 577 578 579 |
fi
${TCL_LIB_FILE}: ${TCL_OBJS}
@$(RM) ${TCL_LIB_FILE}
@MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS}
@POST_MAKE_LIB@
| | > > > > | | | | 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 |
fi
${TCL_LIB_FILE}: ${TCL_OBJS}
@$(RM) ${TCL_LIB_FILE}
@MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS}
@POST_MAKE_LIB@
${DDE_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${DDE_OBJS}
@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}
$(CC) $(CFLAGS) $(TCLTEST_OBJS) tclTestMain.$(OBJEXT) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \
tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
$(COPY) tclsh.exe.manifest ${TEST_EXE_FILE}.manifest
# use pre-built zlib1.dll
${ZLIB_DLL_FILE}: ${TCL_STUB_LIB_FILE}
@if test "@ZLIB_LIBS@set" = "${ZLIB_DIR_NATIVE}/win64-arm/zdll.libset" ; then \
$(COPY) $(ZLIB_DIR)/win64-arm/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \
elif test "@ZLIB_LIBS@set" = "${ZLIB_DIR_NATIVE}/win64-arm/libz.dll.aset" ; then \
$(COPY) $(ZLIB_DIR)/win64-arm/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \
elif test "@ZLIB_LIBS@set" = "${ZLIB_DIR_NATIVE}/win32/zdll.libset" ; then \
$(COPY) $(ZLIB_DIR)/win32/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \
else \
$(COPY) $(ZLIB_DIR)/win64/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \
fi;
# use pre-built libtommath.dll
${TOMMATH_DLL_FILE}: ${TCL_STUB_LIB_FILE}
@if test "@TOMMATH_LIBS@set" != "${TOMMATH_DIR_NATIVE}/win32/tommath.libset" ; then \
$(COPY) $(TOMMATH_DIR)/win64/${TOMMATH_DLL_FILE} ${TOMMATH_DLL_FILE}; \
else \
|
| ︙ | ︙ | |||
668 669 670 671 672 673 674 675 676 677 678 679 680 681 |
-DCFG_RUNTIME_BINDIR="\"$(bindir_native)\"" \
-DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY_NATIVE)\"" \
-DCFG_RUNTIME_INCDIR="\"$(includedir_native)\"" \
-DCFG_RUNTIME_DOCDIR="\"$(mandir_native)\"" \
-DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \
-DBUILD_tcl \
@DEPARG@ $(CC_OBJNAME)
# The following objects are part of the stub library and should not be built
# as DLL objects but none of the symbols should be exported
tclStubLib.${OBJEXT}: tclStubLib.c
$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @CFLAGS_NOLTO@ @DEPARG@ $(CC_OBJNAME)
| > > > > > > > > > > > > > > | 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 |
-DCFG_RUNTIME_BINDIR="\"$(bindir_native)\"" \
-DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY_NATIVE)\"" \
-DCFG_RUNTIME_INCDIR="\"$(includedir_native)\"" \
-DCFG_RUNTIME_DOCDIR="\"$(mandir_native)\"" \
-DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \
-DBUILD_tcl \
@DEPARG@ $(CC_OBJNAME)
tclEvent.${OBJEXT}: tclEvent.c tclUuid.h
$(TOP_DIR)/manifest.uuid:
printf "git-" >$(TOP_DIR)/manifest.uuid
(cd $(TOP_DIR); git rev-parse HEAD >>$(TOP_DIR)/manifest.uuid || \
(printf "svn-r" >$(TOP_DIR)/manifest.uuid ; \
svn info --show-item last-changed-revision >>$(TOP_DIR)/manifest.uuid) || \
printf "unknown" >$(TOP_DIR)/manifest.uuid)
tclUuid.h: $(TOP_DIR)/manifest.uuid
echo "#define TCL_VERSION_UUID \\" >$@
cat $(TOP_DIR)/manifest.uuid >>$@
echo "" >>$@
# The following objects are part of the stub library and should not be built
# as DLL objects but none of the symbols should be exported
tclStubLib.${OBJEXT}: tclStubLib.c
$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @CFLAGS_NOLTO@ @DEPARG@ $(CC_OBJNAME)
|
| ︙ | ︙ | |||
847 848 849 850 851 852 853 | if [ ! -d "$(MODULE_INSTALL_DIR)/$$i" ] ; then \ echo "Making directory $(MODULE_INSTALL_DIR)/$$i"; \ $(MKDIR) "$(MODULE_INSTALL_DIR)/$$i"; \ else true; \ fi; \ done; @echo "Installing library files to $(SCRIPT_INSTALL_DIR)"; | | < | | | | | < | | | | 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 | if [ ! -d "$(MODULE_INSTALL_DIR)/$$i" ] ; then \ echo "Making directory $(MODULE_INSTALL_DIR)/$$i"; \ $(MKDIR) "$(MODULE_INSTALL_DIR)/$$i"; \ else true; \ fi; \ done; @echo "Installing library files to $(SCRIPT_INSTALL_DIR)"; @for i in $(ROOT_DIR)/library/*.tcl $(ROOT_DIR)/library/tclIndex; do \ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \ done; @echo "Installing package cookiejar 0.2" @for j in $(ROOT_DIR)/library/cookiejar/*.tcl \ $(ROOT_DIR)/library/cookiejar/*.gz; do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \ done; @echo "Installing package http 2.10a1 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.10a1.tm"; @echo "Installing package opt 0.4.7"; @for j in $(ROOT_DIR)/library/opt/*.tcl; do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done; @echo "Installing package msgcat 1.7.1 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/8.7/msgcat-1.7.1.tm"; @echo "Installing package tcltest 2.5.4 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.4.tm"; @echo "Installing package platform 1.0.18 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/8.4/platform-1.0.18.tm"; @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl "$(MODULE_INSTALL_DIR)/8.4/platform/shell-1.1.4.tm"; @echo "Installing encodings"; @for i in $(ROOT_DIR)/library/encoding/*.enc ; do \ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \ done; install-tzdata: @echo "Installing time zone data" @$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \ "$(ROOT_DIR)/library/tzdata" "$(SCRIPT_INSTALL_DIR_NATIVE)/tzdata" |
| ︙ | ︙ |
Changes to win/README.
1 2 3 4 5 6 7 8 9 10 11 | Tcl 8.7 for Windows 1. Introduction --------------- This is the directory where you configure and compile the Windows version of Tcl. This directory also contains source files for Tcl that are specific to Microsoft Windows. The information in this file is maintained on the web at: | | > | > > > > > > > > > | | < < < < < | | < < < < < | 1 2 3 4 5 6 7 8 9 10 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 | Tcl 8.7 for Windows 1. Introduction --------------- This is the directory where you configure and compile the Windows version of Tcl. This directory also contains source files for Tcl that are specific to Microsoft Windows. The information in this file is maintained on the web at: https://www.tcl-lang.org/doc/howto/compile.html#win 2. Compiling Tcl ---------------- In order to compile Tcl for Windows, you need the following: Tcl 8.7 Source Distribution (plus any patches) and Visual Studio 2015 or newer or Linux + MinGW-w64 [https://www.mingw-w64.org/] (win32 or win64) or Cygwin + MinGW-w64 [https://cygwin.com/install.html] (win32 or win64) or Darwin + MinGW-w64 [https://www.mingw-w64.org/] (win32 or win64) or Msys + MinGW-w64 [https://www.mingw-w64.org/] (win32 or win64) or LLVM MinGW [https://github.com/mstorsjo/llvm-mingw/] (win32 or win64, IX86, AMD64 or ARM64) In practice, this release is built with Visual C++ 6.0 and the TEA Makefile. If you are building with Visual C++, in the "win" subdirectory of the source release, you will find "makefile.vc". This is the makefile for the |
| ︙ | ︙ | |||
63 64 65 66 67 68 69 | If you are building with Linux, Cygwin or Msys, you can use the configure script that lives in the win subdirectory. The Linux/Cygwin/Msys based configure/build process works just like the UNIX one, so you will want to refer to ../unix/README for available configure options. If you want 64-bit executables (x86_64), you need to configure using | > | | | | | | > > | 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 |
If you are building with Linux, Cygwin or Msys, you can use the configure
script that lives in the win subdirectory. The Linux/Cygwin/Msys based
configure/build process works just like the UNIX one, so you will want
to refer to ../unix/README for available configure options.
If you want 64-bit executables (x86_64), you need to configure using
the --enable-64bit (or --enable-64bit=arm64) option. Make sure that
the x86_64-w64-mingw32 (or aarch64-w64-mingw32) compiler is present.
For Cygwin the x86_64 compiler can be found in the
"mingw64-x86_64-gcc-core" package, which can be installed through
the normal Cygwin install process. If you only want 32-bit executables,
the "mingw64-i686-gcc-core" package is what you need. For Linux, Darwin
and Msys, you can download a suitable win32 or win64 compiler from
[https://sourceforge.net/projects/mingw-w64/files/]
Use the Makefile "install" target to install Tcl. It will install it
according to the prefix options you provided in the correct directory
structure.
Note that in order to run tclsh87.exe, you must ensure that tcl87.dll,
libtommath.dll and zlib1.dll are on your path, in the system
directory, or in the directory containing tclsh87.exe.
Note: Tcl no longer provides support for systems earlier than Windows 7.
You will also need the Windows Universal C runtime (UCRT):
[https://support.microsoft.com/en-us/topic/update-for-universal-c-runtime-in-windows-c0514201-7fe6-95a3-b0a5-287930f3560c]
3. Test suite
-------------
This distribution contains an extensive test suite for Tcl. Some of the
tests are timing dependent and will fail from time to time. If a test is
failing consistently, please send us a bug report with as much detail as
you can manage to our tracker:
https://core.tcl-lang.org/tcl/reportlist
In order to run the test suite, you build the "test" target using the
appropriate makefile for your compiler.
|
Changes to win/configure.
1 2 | #! /bin/sh # Guess values for system-dependent variables and create Makefiles. | | | > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | #! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.71 for tcl 8.7. # # # Copyright (C) 1992-1996, 1998-2017, 2020-2021 Free Software Foundation, # Inc. # # # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## -------------------- ## ## M4sh Initialization. ## ## -------------------- ## |
| ︙ | ︙ | |||
1528 1529 1530 1531 1532 1533 1534 | done fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF tcl configure 8.7 | | | | 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 | done fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF tcl configure 8.7 generated by GNU Autoconf 2.71 Copyright (C) 2021 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit fi ## ------------------------ ## |
| ︙ | ︙ | |||
1732 1733 1734 1735 1736 1737 1738 | esac cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by tcl $as_me 8.7, which was | | | 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 |
esac
cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
It was created by tcl $as_me 8.7, which was
generated by GNU Autoconf 2.71. Invocation command line was
$ $0$ac_configure_args_raw
_ACEOF
exec 5>>config.log
{
cat <<_ASUNAME
|
| ︙ | ︙ | |||
2399 2400 2401 2402 2403 2404 2405 | # versions of autoconf incorrectly set SHELL to /bin/bash instead of # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh TCL_VERSION=8.7 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=7 | | | 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 | # versions of autoconf incorrectly set SHELL to /bin/bash instead of # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh TCL_VERSION=8.7 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=7 TCL_PATCH_LEVEL="a6" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 TCL_DDE_MAJOR_VERSION=1 TCL_DDE_MINOR_VERSION=4 DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION |
| ︙ | ︙ | |||
3291 3292 3293 3294 3295 3296 3297 |
else
if test "$GCC" = yes; then
CFLAGS="-O2"
else
CFLAGS=
fi
fi
| > > > | | 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 |
else
if test "$GCC" = yes; then
CFLAGS="-O2"
else
CFLAGS=
fi
fi
ac_prog_cc_stdc=no
if test x$ac_prog_cc_stdc = xno
then :
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C11 features" >&5
printf %s "checking for $CC option to enable C11 features... " >&6; }
if test ${ac_cv_prog_cc_c11+y}
then :
printf %s "(cached) " >&6
else $as_nop
ac_cv_prog_cc_c11=no
ac_save_CC=$CC
|
| ︙ | ︙ | |||
3315 3316 3317 3318 3319 3320 3321 | ac_cv_prog_cc_c11=$ac_arg fi rm -f core conftest.err conftest.$ac_objext conftest.beam test "x$ac_cv_prog_cc_c11" != "xno" && break done rm -f conftest.$ac_ext CC=$ac_save_CC | < | < | | | | | > > | | | < < | | | > | < > > | | | | < | < | | | | | > > | | | < < | | | > | < > > | | | < < | < | | | | | > > | | | < < | | < | < < > | < | < < < < | 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 |
ac_cv_prog_cc_c11=$ac_arg
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam
test "x$ac_cv_prog_cc_c11" != "xno" && break
done
rm -f conftest.$ac_ext
CC=$ac_save_CC
fi
if test "x$ac_cv_prog_cc_c11" = xno
then :
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5
printf "%s\n" "unsupported" >&6; }
else $as_nop
if test "x$ac_cv_prog_cc_c11" = x
then :
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5
printf "%s\n" "none needed" >&6; }
else $as_nop
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5
printf "%s\n" "$ac_cv_prog_cc_c11" >&6; }
CC="$CC $ac_cv_prog_cc_c11"
fi
ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11
ac_prog_cc_stdc=c11
fi
fi
if test x$ac_prog_cc_stdc = xno
then :
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C99 features" >&5
printf %s "checking for $CC option to enable C99 features... " >&6; }
if test ${ac_cv_prog_cc_c99+y}
then :
printf %s "(cached) " >&6
else $as_nop
ac_cv_prog_cc_c99=no
ac_save_CC=$CC
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
$ac_c_conftest_c99_program
_ACEOF
for ac_arg in '' -std=gnu99 -std=c99 -c99 -qlanglvl=extc1x -qlanglvl=extc99 -AC99 -D_STDC_C99=
do
CC="$ac_save_CC $ac_arg"
if ac_fn_c_try_compile "$LINENO"
then :
ac_cv_prog_cc_c99=$ac_arg
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam
test "x$ac_cv_prog_cc_c99" != "xno" && break
done
rm -f conftest.$ac_ext
CC=$ac_save_CC
fi
if test "x$ac_cv_prog_cc_c99" = xno
then :
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5
printf "%s\n" "unsupported" >&6; }
else $as_nop
if test "x$ac_cv_prog_cc_c99" = x
then :
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5
printf "%s\n" "none needed" >&6; }
else $as_nop
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5
printf "%s\n" "$ac_cv_prog_cc_c99" >&6; }
CC="$CC $ac_cv_prog_cc_c99"
fi
ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99
ac_prog_cc_stdc=c99
fi
fi
if test x$ac_prog_cc_stdc = xno
then :
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C89 features" >&5
printf %s "checking for $CC option to enable C89 features... " >&6; }
if test ${ac_cv_prog_cc_c89+y}
then :
printf %s "(cached) " >&6
else $as_nop
ac_cv_prog_cc_c89=no
ac_save_CC=$CC
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
$ac_c_conftest_c89_program
_ACEOF
for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
do
CC="$ac_save_CC $ac_arg"
if ac_fn_c_try_compile "$LINENO"
then :
ac_cv_prog_cc_c89=$ac_arg
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam
test "x$ac_cv_prog_cc_c89" != "xno" && break
done
rm -f conftest.$ac_ext
CC=$ac_save_CC
fi
if test "x$ac_cv_prog_cc_c89" = xno
then :
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5
printf "%s\n" "unsupported" >&6; }
else $as_nop
if test "x$ac_cv_prog_cc_c89" = x
then :
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5
printf "%s\n" "none needed" >&6; }
else $as_nop
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5
printf "%s\n" "$ac_cv_prog_cc_c89" >&6; }
CC="$CC $ac_cv_prog_cc_c89"
fi
ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89
ac_prog_cc_stdc=c89
fi
fi
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
|
| ︙ | ︙ | |||
4061 4062 4063 4064 4065 4066 4067 |
fi
SHLIB_SUFFIX=".dll"
# MACHINE is IX86 for LINK, but this is used by the manifest,
| | | 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 |
fi
SHLIB_SUFFIX=".dll"
# MACHINE is IX86 for LINK, but this is used by the manifest,
# which requires x86|amd64|arm64|ia64.
MACHINE="X86"
if test "$GCC" = "yes"; then
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for cross-compile version of gcc" >&5
printf %s "checking for cross-compile version of gcc... " >&6; }
if test ${ac_cv_cross+y}
|
| ︙ | ︙ | |||
4108 4109 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 |
amd64|x64|yes)
CC="x86_64-w64-mingw32-${CC}"
LD="x86_64-w64-mingw32-ld"
AR="x86_64-w64-mingw32-ar"
RANLIB="x86_64-w64-mingw32-ranlib"
RC="x86_64-w64-mingw32-windres"
;;
*)
CC="i686-w64-mingw32-${CC}"
LD="i686-w64-mingw32-ld"
AR="i686-w64-mingw32-ar"
RANLIB="i686-w64-mingw32-ranlib"
RC="i686-w64-mingw32-windres"
;;
| > > > > > > > | 4102 4103 4104 4105 4106 4107 4108 4109 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 |
amd64|x64|yes)
CC="x86_64-w64-mingw32-${CC}"
LD="x86_64-w64-mingw32-ld"
AR="x86_64-w64-mingw32-ar"
RANLIB="x86_64-w64-mingw32-ranlib"
RC="x86_64-w64-mingw32-windres"
;;
arm64|aarch64)
CC="aarch64-w64-mingw32-clang"
LD="aarch64-w64-mingw32-ld"
AR="aarch64-w64-mingw32-ar"
RANLIB="aarch64-w64-mingw32-ranlib"
RC="aarch64-w64-mingw32-windres"
;;
*)
CC="i686-w64-mingw32-${CC}"
LD="i686-w64-mingw32-ld"
AR="i686-w64-mingw32-ar"
RANLIB="i686-w64-mingw32-ranlib"
RC="i686-w64-mingw32-windres"
;;
|
| ︙ | ︙ | |||
4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 |
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_win32" >&5
printf "%s\n" "$ac_cv_win32" >&6; }
if test "$ac_cv_win32" != "yes"; then
as_fn_error $? "${CC} cannot produce win32 executables." "$LINENO" 5
fi
hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain"
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for working -municode linker flag" >&5
printf %s "checking for working -municode linker flag... " >&6; }
if test ${ac_cv_municode+y}
then :
printf %s "(cached) " >&6
| > > > | 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 |
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_win32" >&5
printf "%s\n" "$ac_cv_win32" >&6; }
if test "$ac_cv_win32" != "yes"; then
as_fn_error $? "${CC} cannot produce win32 executables." "$LINENO" 5
fi
if test "$do64bit" != "arm64"; then
extra_cflags="$extra_cflags -DHAVE_CPUID=1"
fi
hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain"
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for working -municode linker flag" >&5
printf %s "checking for working -municode linker flag... " >&6; }
if test ${ac_cv_municode+y}
then :
printf %s "(cached) " >&6
|
| ︙ | ︙ | |||
4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 |
printf "%s\n" "$ac_cv_municode" >&6; }
CFLAGS=$hold_cflags
if test "$ac_cv_municode" = "yes" ; then
extra_ldflags="$extra_ldflags -municode"
else
extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS"
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for working -fno-lto" >&5
printf %s "checking for working -fno-lto... " >&6; }
if test ${ac_cv_nolto+y}
then :
printf %s "(cached) " >&6
else $as_nop
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
| > | 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 |
printf "%s\n" "$ac_cv_municode" >&6; }
CFLAGS=$hold_cflags
if test "$ac_cv_municode" = "yes" ; then
extra_ldflags="$extra_ldflags -municode"
else
extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS"
fi
hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -fno-lto"
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for working -fno-lto" >&5
printf %s "checking for working -fno-lto... " >&6; }
if test ${ac_cv_nolto+y}
then :
printf %s "(cached) " >&6
else $as_nop
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
|
| ︙ | ︙ | |||
4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 |
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_input_charset" >&5
printf "%s\n" "$tcl_cv_cc_input_charset" >&6; }
if test $tcl_cv_cc_input_charset = yes; then
extra_cflags="$extra_cflags -finput-charset=UTF-8"
fi
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking compiler flags" >&5
printf %s "checking compiler flags... " >&6; }
if test "${GCC}" = "yes" ; then
SHLIB_LD=""
SHLIB_LD_LIBS='${LIBS}'
LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -luserenv -lws2_32"
# mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 4394 4395 4396 4397 4398 4399 4400 4401 4402 4403 4404 4405 4406 4407 4408 4409 4410 4411 4412 4413 4414 |
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_input_charset" >&5
printf "%s\n" "$tcl_cv_cc_input_charset" >&6; }
if test $tcl_cv_cc_input_charset = yes; then
extra_cflags="$extra_cflags -finput-charset=UTF-8"
fi
fi
hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Wl,--enable-auto-image-base"
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for working --enable-auto-image-base" >&5
printf %s "checking for working --enable-auto-image-base... " >&6; }
if test ${ac_cv_enable_auto_image_base+y}
then :
printf %s "(cached) " >&6
else $as_nop
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
main (void)
{
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
ac_cv_enable_auto_image_base=yes
else $as_nop
ac_cv_enable_auto_image_base=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_enable_auto_image_base" >&5
printf "%s\n" "$ac_cv_enable_auto_image_base" >&6; }
CFLAGS=$hold_cflags
if test "$ac_cv_enable_auto_image_base" == "yes" ; then
extra_ldflags="$extra_ldflags -Wl,--enable-auto-image-base"
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking compiler flags" >&5
printf %s "checking compiler flags... " >&6; }
if test "${GCC}" = "yes" ; then
SHLIB_LD=""
SHLIB_LD_LIBS='${LIBS}'
LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -luserenv -lws2_32"
# mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't
LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32 -lwinspool"
STLIB_LD='${AR} cr'
RC_OUT=-o
RC_TYPE=
RC_INCLUDE=--include
RC_DEFINE=--define
RES=res.o
MAKE_LIB="\${STLIB_LD} \$@"
|
| ︙ | ︙ | |||
4455 4456 4457 4458 4459 4460 4461 4462 4463 |
case "$do64bit" in
amd64|x64|yes)
MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: Using 64-bit $MACHINE mode" >&5
printf "%s\n" " Using 64-bit $MACHINE mode" >&6; }
;;
ia64)
MACHINE="IA64"
| > > > > > | | | 4494 4495 4496 4497 4498 4499 4500 4501 4502 4503 4504 4505 4506 4507 4508 4509 4510 4511 4512 4513 4514 4515 4516 |
case "$do64bit" in
amd64|x64|yes)
MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: Using 64-bit $MACHINE mode" >&5
printf "%s\n" " Using 64-bit $MACHINE mode" >&6; }
;;
arm64|aarch64)
MACHINE="ARM64"
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: Using ARM64 $MACHINE mode" >&5
printf "%s\n" " Using ARM64 $MACHINE mode" >&6; }
;;
ia64)
MACHINE="IA64"
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: Using IA64 $MACHINE mode" >&5
printf "%s\n" " Using IA64 $MACHINE mode" >&6; }
;;
*)
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifndef _WIN64
#error 32-bit
|
| ︙ | ︙ | |||
4528 4529 4530 4531 4532 4533 4534 4535 4536 4537 4538 4539 4540 4541 |
LIBFLAGSUFFIX=""
if test "$do64bit" != "no" ; then
case "$do64bit" in
amd64|x64|yes)
MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
;;
ia64)
MACHINE="IA64"
;;
esac
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: Using 64-bit $MACHINE mode" >&5
printf "%s\n" " Using 64-bit $MACHINE mode" >&6; }
fi
| > > > | 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 4584 4585 4586 4587 4588 |
LIBFLAGSUFFIX=""
if test "$do64bit" != "no" ; then
case "$do64bit" in
amd64|x64|yes)
MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
;;
arm64|aarch64)
MACHINE="ARM64"
;;
ia64)
MACHINE="IA64"
;;
esac
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: Using 64-bit $MACHINE mode" >&5
printf "%s\n" " Using 64-bit $MACHINE mode" >&6; }
fi
|
| ︙ | ︙ | |||
4549 4550 4551 4552 4553 4554 4555 |
*)
;;
esac
if test "$do64bit" != "no" ; then
RC="rc"
CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d"
| < | | | 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 |
*)
;;
esac
if test "$do64bit" != "no" ; then
RC="rc"
CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d"
CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}"
lflags="${lflags} -nologo -MACHINE:${MACHINE}"
LINKBIN="link"
# Avoid 'unresolved external symbol __security_cookie' errors.
# c.f. http://support.microsoft.com/?id=894573
LIBS="$LIBS bufferoverflowU.lib"
else
RC="rc"
# -Od - no optimization
# -WX - warnings as errors
CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d"
# -O2 - create fast code (/Og /Oi /Ot /Oy /Ob2 /Gs /GF /Gy)
CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}"
lflags="${lflags} -nologo"
LINKBIN="link"
fi
LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib winspool.lib"
SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}"
SHLIB_LD_LIBS='${LIBS}'
# link -lib only works when -lib is the first arg
STLIB_LD="${LINKBIN} -lib ${lflags}"
RC_OUT=-fo
RC_TYPE=-r
|
| ︙ | ︙ | |||
4900 4901 4902 4903 4904 4905 4906 | if test "$do64bit" != "no" then : printf "%s\n" "#define MP_64BIT 1" >>confdefs.h | > > > | > > > > > > > > > > > > > > > > > > > | | | | > > | 4946 4947 4948 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 4997 |
if test "$do64bit" != "no"
then :
printf "%s\n" "#define MP_64BIT 1" >>confdefs.h
if test "$do64bit" = "arm64"
then :
if test "$GCC" == "yes"
then :
ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64-arm/libz.dll.a
TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64-arm/libtommath.dll.a
else $as_nop
ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64-arm/zdll.lib
TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64-arm/tommath.lib
fi
else $as_nop
if test "$GCC" == "yes"
then :
ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64/libz.dll.a
TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64/libtommath.dll.a
else $as_nop
ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64/zdll.lib
TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64/tommath.lib
fi
fi
else $as_nop
ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win32/zdll.lib
|
| ︙ | ︙ | |||
5812 5813 5814 5815 5816 5817 5818 |
case "$TCL_PATCH_LEVEL" in
*a*) TCL_RELEASE_LEVEL=0 ;;
*b*) TCL_RELEASE_LEVEL=1 ;;
*) TCL_RELEASE_LEVEL=2 ;;
esac
TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d ab.`"
| | | 5882 5883 5884 5885 5886 5887 5888 5889 5890 5891 5892 5893 5894 5895 5896 |
case "$TCL_PATCH_LEVEL" in
*a*) TCL_RELEASE_LEVEL=0 ;;
*b*) TCL_RELEASE_LEVEL=1 ;;
*) TCL_RELEASE_LEVEL=2 ;;
esac
TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d ab.`"
# X86|AMD64|ARM64|IA64 for manifest
|
| ︙ | ︙ | |||
6447 6448 6449 6450 6451 6452 6453 | cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Save the log message, to keep $0 and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" This file was extended by tcl $as_me 8.7, which was | | | 6517 6518 6519 6520 6521 6522 6523 6524 6525 6526 6527 6528 6529 6530 6531 | cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Save the log message, to keep $0 and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" This file was extended by tcl $as_me 8.7, which was generated by GNU Autoconf 2.71. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ |
| ︙ | ︙ | |||
6502 6503 6504 6505 6506 6507 6508 | _ACEOF ac_cs_config=`printf "%s\n" "$ac_configure_args" | sed "$ac_safe_unquote"` ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\''/g"` cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ tcl config.status 8.7 | | | | 6572 6573 6574 6575 6576 6577 6578 6579 6580 6581 6582 6583 6584 6585 6586 6587 6588 6589 | _ACEOF ac_cs_config=`printf "%s\n" "$ac_configure_args" | sed "$ac_safe_unquote"` ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\''/g"` cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ tcl config.status 8.7 configured by $0, generated by GNU Autoconf 2.71, with options \\"\$ac_cs_config\\" Copyright (C) 2021 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." ac_pwd='$ac_pwd' srcdir='$srcdir' test -n "\$AWK" || AWK=awk _ACEOF |
| ︙ | ︙ |
Changes to win/configure.ac.
| ︙ | ︙ | |||
11 12 13 14 15 16 17 | # versions of autoconf incorrectly set SHELL to /bin/bash instead of # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh TCL_VERSION=8.7 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=7 | | | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | # versions of autoconf incorrectly set SHELL to /bin/bash instead of # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh TCL_VERSION=8.7 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=7 TCL_PATCH_LEVEL="a6" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 TCL_DDE_MAJOR_VERSION=1 TCL_DDE_MINOR_VERSION=4 DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION |
| ︙ | ︙ | |||
137 138 139 140 141 142 143 |
])
AS_IF([test "$tcl_ok" = "yes"], [
AC_SUBST(ZLIB_DLL_FILE,[\${ZLIB_DLL_FILE}])
AC_SUBST(TOMMATH_DLL_FILE,[\${TOMMATH_DLL_FILE}])
AC_DEFINE(TCL_WITH_EXTERNAL_TOMMATH, 1, [Tcl with external libtommath])
AS_IF([test "$do64bit" != "no"], [
AC_DEFINE(MP_64BIT, 1, [Using libtommath.dll in 64-bit mode])
| > | > > > > > > > > | | | | | > | 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 |
])
AS_IF([test "$tcl_ok" = "yes"], [
AC_SUBST(ZLIB_DLL_FILE,[\${ZLIB_DLL_FILE}])
AC_SUBST(TOMMATH_DLL_FILE,[\${TOMMATH_DLL_FILE}])
AC_DEFINE(TCL_WITH_EXTERNAL_TOMMATH, 1, [Tcl with external libtommath])
AS_IF([test "$do64bit" != "no"], [
AC_DEFINE(MP_64BIT, 1, [Using libtommath.dll in 64-bit mode])
AS_IF([test "$do64bit" = "arm64"], [
AS_IF([test "$GCC" == "yes"],[
AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64-arm/libz.dll.a])
AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win64-arm/libtommath.dll.a])
], [
AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64-arm/zdll.lib])
AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win64-arm/tommath.lib])
])
], [
AS_IF([test "$GCC" == "yes"],[
AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64/libz.dll.a])
AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win64/libtommath.dll.a])
], [
AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64/zdll.lib])
AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win64/tommath.lib])
])
])
], [
AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win32/zdll.lib])
AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win32/tommath.lib])
])
], [
AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}])
|
| ︙ | ︙ | |||
373 374 375 376 377 378 379 |
case "$TCL_PATCH_LEVEL" in
*a*) TCL_RELEASE_LEVEL=0 ;;
*b*) TCL_RELEASE_LEVEL=1 ;;
*) TCL_RELEASE_LEVEL=2 ;;
esac
TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d ab.`"
AC_SUBST(TCL_WIN_VERSION)
| | | 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 |
case "$TCL_PATCH_LEVEL" in
*a*) TCL_RELEASE_LEVEL=0 ;;
*b*) TCL_RELEASE_LEVEL=1 ;;
*) TCL_RELEASE_LEVEL=2 ;;
esac
TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d ab.`"
AC_SUBST(TCL_WIN_VERSION)
# X86|AMD64|ARM64|IA64 for manifest
AC_SUBST(MACHINE)
AC_SUBST(TCL_VERSION)
AC_SUBST(TCL_MAJOR_VERSION)
AC_SUBST(TCL_MINOR_VERSION)
AC_SUBST(TCL_PATCH_LEVEL)
AC_SUBST(PKG_CFG_ARGS)
|
| ︙ | ︙ |
Added win/gitmanifest.in.
> | 1 | git- |
Changes to win/makefile.vc.
| ︙ | ︙ | |||
53 54 55 56 57 58 59 | # # Basic macros and options usable on the commandline (see rules.vc for more info): # OPTS=msvcrt,noembed,nothreads,pdbs,profile,static,symbols,thrdalloc,time64bit,unchecked,utfmax,none # Sets special options for the core. The default is for none. # Any combination of the above may be used (comma separated). # 'none' will over-ride everything to nothing. # | | | | | | 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 | # # Basic macros and options usable on the commandline (see rules.vc for more info): # OPTS=msvcrt,noembed,nothreads,pdbs,profile,static,symbols,thrdalloc,time64bit,unchecked,utfmax,none # Sets special options for the core. The default is for none. # Any combination of the above may be used (comma separated). # 'none' will over-ride everything to nothing. # # noembed = Without this option, the Tcl core library scripts # are embedded into the executable if "static" is # specified in OPTS, or into the DLL otherwise. If # "noembed" is specified, the scripts are not embedded # but copied to the installation target (as in 8.6). # nomsvcrt = Affects the static option only to switch it from # using msvcrt(d) as the C runtime [by default] to # libcmt(d). This is useful for static embedding # support. # none = Overrides all other options to nothing. # nothreads = Turns off full multithreading support (default on). # pdbs = Produce separate debug symbol files. |
| ︙ | ︙ | |||
96 97 98 99 100 101 102 | # # 64bit = Enable 64bit portability warnings (if available) # fullwarn = Builds with full compiler and link warnings enabled. # Very verbose. # nodep = Turns off compatibility macros to ensure the core # isn't being built with deprecated functions. # | | | 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 | # # 64bit = Enable 64bit portability warnings (if available) # fullwarn = Builds with full compiler and link warnings enabled. # Very verbose. # nodep = Turns off compatibility macros to ensure the core # isn't being built with deprecated functions. # # MACHINE=(ALPHA|AMD64|ARM64|IA64|IX86) # Set the machine type used for the compiler, linker, and # resource compiler. This hook is needed to tell the tools # when alternate platforms are requested. IX86 is the default # when not specified. If the CPU environment variable has been # set (ie: recent Platform SDK) then MACHINE is set from CPU. # # TMP_DIR=<path> |
| ︙ | ︙ | |||
552 553 554 555 556 557 558 | $(LIBCMD) $** !else $(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(TCLSTUBLIB) $(DLLCMD) $** $(_VC_MANIFEST_EMBED_DLL) !endif | | | | | | | | | | | > > > > > > > > > | | 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 |
$(LIBCMD) $**
!else
$(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(TCLSTUBLIB)
$(DLLCMD) $**
$(_VC_MANIFEST_EMBED_DLL)
!endif
!if "$(MACHINE)" == "ARM64"
$(OUT_DIR)\zlib1.dll: $(COMPATDIR)\zlib\win64-arm\zlib1.dll
$(COPY) $(COMPATDIR)\zlib\win64-arm\zlib1.dll $(OUT_DIR)\zlib1.dll
$(OUT_DIR)\zdll.lib: $(COMPATDIR)\zlib\win64-arm\zdll.lib
$(COPY) $(COMPATDIR)\zlib\win64-arm\zdll.lib $(OUT_DIR)\zdll.lib
$(OUT_DIR)\libtommath.dll: $(TOMMATHDIR)\win64-arm\libtommath.dll
$(COPY) $(TOMMATHDIR)\win64-arm\libtommath.dll $(OUT_DIR)\libtommath.dll
$(OUT_DIR)\tommath.lib: $(TOMMATHDIR)\win64-arm\tommath.lib
$(COPY) $(TOMMATHDIR)\win64-arm\tommath.lib $(OUT_DIR)\tommath.lib
!elseif "$(MACHINE)" == "IX86"
$(OUT_DIR)\zlib1.dll: $(COMPATDIR)\zlib\win32\zlib1.dll
$(COPY) $(COMPATDIR)\zlib\win32\zlib1.dll $(OUT_DIR)\zlib1.dll
$(OUT_DIR)\zdll.lib: $(COMPATDIR)\zlib\win32\zdll.lib
$(COPY) $(COMPATDIR)\zlib\win32\zdll.lib $(OUT_DIR)\zdll.lib
$(OUT_DIR)\libtommath.dll: $(TOMMATHDIR)\win32\libtommath.dll
$(COPY) $(TOMMATHDIR)\win32\libtommath.dll $(OUT_DIR)\libtommath.dll
$(OUT_DIR)\tommath.lib: $(TOMMATHDIR)\win32\tommath.lib
$(COPY) $(TOMMATHDIR)\win32\tommath.lib $(OUT_DIR)\tommath.lib
!else
$(OUT_DIR)\zlib1.dll: $(COMPATDIR)\zlib\win64\zlib1.dll
$(COPY) $(COMPATDIR)\zlib\win64\zlib1.dll $(OUT_DIR)\zlib1.dll
$(OUT_DIR)\zdll.lib: $(COMPATDIR)\zlib\win64\zdll.lib
$(COPY) $(COMPATDIR)\zlib\win64\zdll.lib $(OUT_DIR)\zdll.lib
$(OUT_DIR)\libtommath.dll: $(TOMMATHDIR)\win64\libtommath.dll
$(COPY) $(TOMMATHDIR)\win64\libtommath.dll $(OUT_DIR)\libtommath.dll
$(OUT_DIR)\tommath.lib: $(TOMMATHDIR)\win64\tommath.lib
$(COPY) $(TOMMATHDIR)\win64\tommath.lib $(OUT_DIR)\tommath.lib
!endif
$(TCLSCRIPTZIP): $(TCLDDELIB) $(TCLREGLIB)
@echo Building Tcl library zip file
@if exist "$(LIBTCLVFS)" $(RMDIR) "$(LIBTCLVFS)"
@$(MKDIR) "$(LIBTCLVFS)"
@$(CPYDIR) $(LIBDIR) "$(LIBTCLVFS)\tcl_library"
@move /y "$(LIBTCLVFS)\tcl_library\manifest.txt" "$(LIBTCLVFS)\tcl_library\pkgIndex.tcl" > NUL
!if $(STATIC_BUILD)
# Remove the registry and dde directories as the DLLS are still external
@del "$(LIBTCLVFS)\tcl_library\registry\pkgIndex.tcl"
@rmdir "$(LIBTCLVFS)\tcl_library\registry"
@del "$(LIBTCLVFS)\tcl_library\dde\pkgIndex.tcl"
@rmdir "$(LIBTCLVFS)\tcl_library\dde"
!else
@$(COPY) $(TCLDDELIB) "$(LIBTCLVFS)\tcl_library\dde
@$(COPY) $(TCLREGLIB) "$(LIBTCLVFS)\tcl_library\registry
!endif
@echo file delete -force {$@} > "$(OUT_DIR)\zipper.tcl"
@echo zipfs mkzip {$@} {$(LIBTCLVFS)} {$(LIBTCLVFS)} >> "$(OUT_DIR)\zipper.tcl"
@cd "$(OUT_DIR)" && $(TCLSH_NATIVE) zipper.tcl
pkgs:
@for /d %d in ($(PKGSDIR)\*) do \
@if exist "%~fd\win\makefile.vc" ( \
pushd "%~fd\win" & \
$(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) &\
|
| ︙ | ︙ | |||
794 795 796 797 798 799 800 | $(cc32) $(appcflags) /DTCL_TEST /DUNICODE /D_UNICODE \ -Fo$@ $? $(TMP_DIR)\tclMainW.obj: $(GENERICDIR)\tclMain.c $(cc32) $(pkgcflags) /DUNICODE /D_UNICODE \ -Fo$@ $? | > > > > > > > > > > > | | | 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 | $(cc32) $(appcflags) /DTCL_TEST /DUNICODE /D_UNICODE \ -Fo$@ $? $(TMP_DIR)\tclMainW.obj: $(GENERICDIR)\tclMain.c $(cc32) $(pkgcflags) /DUNICODE /D_UNICODE \ -Fo$@ $? $(ROOT)\manifest.uuid: copy $(WIN_DIR)\gitmanifest.in $(ROOT)\manifest.uuid git rev-parse HEAD >>$(ROOT)\manifest.uuid $(TMP_DIR)\tclUuid.h: $(ROOT)\manifest.uuid copy $(WIN_DIR)\tclUuid.h.in+$(ROOT)\manifest.uuid $(TMP_DIR)\tclUuid.h $(TMP_DIR)\tclEvent.obj: $(GENERICDIR)\tclEvent.c $(TMP_DIR)\tclUuid.h $(cc32) $(pkgcflags) -I$(TMP_DIR) \ -Fo$@ $(GENERICDIR)\tclEvent.c $(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c $(TMP_DIR)\tclUuid.h $(cc32) $(appcflags) -I$(TMP_DIR) -Fo$@ $? $(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c $(cc32) $(appcflags) -Fo$@ $? $(TMP_DIR)\tclWinTest.obj: $(WIN_DIR)\tclWinTest.c $(CCAPPCMD) $? |
| ︙ | ︙ | |||
950 951 952 953 954 955 956 | @echo Installing $(TCLSHNAME) @$(CPY) "$(TCLSH)" "$(BIN_INSTALL_DIR)\" !endif @echo Installing $(TCLSTUBLIBNAME) @$(CPY) "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)\" install-libraries: tclConfig tcl-nmake install-msgs install-tzdata | < < < < < < < < < < < < < < < < < < > > > > > > > > > > > > > > > > > > > | 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 | @echo Installing $(TCLSHNAME) @$(CPY) "$(TCLSH)" "$(BIN_INSTALL_DIR)\" !endif @echo Installing $(TCLSTUBLIBNAME) @$(CPY) "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)\" install-libraries: tclConfig tcl-nmake install-msgs install-tzdata @if not exist "$(LIB_INSTALL_DIR)\nmake" \ $(MKDIR) "$(LIB_INSTALL_DIR)\nmake" @echo Installing header files @$(CPY) "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclOO.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclOODecls.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclTomMath.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclTomMathDecls.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(TOMMATHDIR)\tommath.h" "$(INCLUDE_INSTALL_DIR)\" !if !$(TCL_EMBED_SCRIPTS) @echo Installing library files to $(SCRIPT_INSTALL_DIR) @if not exist "$(SCRIPT_INSTALL_DIR)" \ $(MKDIR) "$(SCRIPT_INSTALL_DIR)" @$(CPY) "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\clock.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\tm.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)\" !endif @$(CPY) "$(OUT_DIR)\tclConfig.sh" "$(LIB_INSTALL_DIR)\" @$(CPY) "$(WIN_DIR)\tclooConfig.sh" "$(LIB_INSTALL_DIR)\" @$(CPY) "$(TCLSCRIPTZIP)" "$(LIB_INSTALL_DIR)\" @$(CPY) "$(WIN_DIR)\rules.vc" "$(LIB_INSTALL_DIR)\nmake\" @$(CPY) "$(WIN_DIR)\targets.vc" "$(LIB_INSTALL_DIR)\nmake\" @$(CPY) "$(WIN_DIR)\nmakehlp.c" "$(LIB_INSTALL_DIR)\nmake\" @$(CPY) "$(WIN_DIR)\x86_64-w64-mingw32-nmakehlp.exe" "$(LIB_INSTALL_DIR)\nmake\" @$(CPY) "$(OUT_DIR)\tcl.nmake" "$(LIB_INSTALL_DIR)\nmake\" !if !$(TCL_EMBED_SCRIPTS) @echo Installing package cookiejar $(PKG_COOKIEJAR_VER) @if not exist "$(SCRIPT_INSTALL_DIR)\cookiejar0.2" \ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\cookiejar0.2" @$(CPY) "$(ROOT)\library\cookiejar\*.tcl" \ "$(SCRIPT_INSTALL_DIR)\cookiejar0.2\" @$(CPY) "$(ROOT)\library\cookiejar\*.gz" \ "$(SCRIPT_INSTALL_DIR)\cookiejar0.2\" @echo Installing package opt $(PKG_OPT_VER) @if not exist "$(SCRIPT_INSTALL_DIR)\opt0.4" \ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4" @$(CPY) "$(ROOT)\library\opt\*.tcl" \ "$(SCRIPT_INSTALL_DIR)\opt0.4\" @if not exist "$(MODULE_INSTALL_DIR)" \ $(MKDIR) "$(MODULE_INSTALL_DIR)" @echo Installing package http $(PKG_HTTP_VER) as a Tcl Module @if not exist "$(MODULE_INSTALL_DIR)\8.6" \ $(MKDIR) "$(MODULE_INSTALL_DIR)\8.6" @$(COPY) "$(ROOT)\library\http\http.tcl" \ "$(MODULE_INSTALL_DIR)\8.6\http-$(PKG_HTTP_VER).tm" @echo Installing package msgcat $(PKG_MSGCAT_VER) as a Tcl Module @if not exist "$(MODULE_INSTALL_DIR)\8.7" \ $(MKDIR) "$(MODULE_INSTALL_DIR)\8.7" @$(COPY) "$(ROOT)\library\msgcat\msgcat.tcl" \ "$(MODULE_INSTALL_DIR)\8.7\msgcat-$(PKG_MSGCAT_VER).tm" @echo Installing package tcltest $(PKG_TCLTEST_VER) as a Tcl Module @if not exist "$(MODULE_INSTALL_DIR)\8.5" \ $(MKDIR) "$(MODULE_INSTALL_DIR)\8.5" @$(COPY) "$(ROOT)\library\tcltest\tcltest.tcl" \ "$(MODULE_INSTALL_DIR)\8.5\tcltest-$(PKG_TCLTEST_VER).tm" @echo Installing package platform $(PKG_PLATFORM_VER) as a Tcl Module @if not exist "$(MODULE_INSTALL_DIR)\8.4" \ $(MKDIR) "$(MODULE_INSTALL_DIR)\8.4" @if not exist "$(MODULE_INSTALL_DIR)\8.4\platform" \ $(MKDIR) "$(MODULE_INSTALL_DIR)\8.4\platform" @$(COPY) "$(ROOT)\library\platform\platform.tcl" \ "$(MODULE_INSTALL_DIR)\8.4\platform-$(PKG_PLATFORM_VER).tm" @echo Installing package platform::shell $(PKG_SHELL_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\platform\shell.tcl" \ "$(MODULE_INSTALL_DIR)\8.4\platform\shell-$(PKG_SHELL_VER).tm" !endif @echo Installing $(TCLDDELIBNAME) |
| ︙ | ︙ |
Changes to win/nmakehlp.c.
| ︙ | ︙ | |||
10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * ---------------------------------------------------------------------------- */ #define _CRT_SECURE_NO_DEPRECATE #include <windows.h> #pragma comment (lib, "user32.lib") #pragma comment (lib, "kernel32.lib") #include <stdio.h> #include <math.h> /* ISO hack for dumb VC++ */ #ifdef _MSC_VER #define snprintf _snprintf #endif /* protos */ static int CheckForCompilerFeature(const char *option); | > > | | | | 10 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 |
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
* ----------------------------------------------------------------------------
*/
#define _CRT_SECURE_NO_DEPRECATE
#include <windows.h>
#ifdef _MSC_VER
#pragma comment (lib, "user32.lib")
#pragma comment (lib, "kernel32.lib")
#endif
#include <stdio.h>
#include <math.h>
/* ISO hack for dumb VC++ */
#ifdef _MSC_VER
#define snprintf _snprintf
#endif
/* protos */
static int CheckForCompilerFeature(const char *option);
static int CheckForLinkerFeature(char **options, int count);
static int IsIn(const char *string, const char *substring);
static int SubstituteFile(const char *substs, const char *filename);
static int QualifyPath(const char *path);
static int LocateDependency(const char *keyfile);
static const char *GetVersionFromFile(const char *filename, const char *match, int numdots);
static DWORD WINAPI ReadFromPipe(LPVOID args);
/* globals */
#define CHUNK 25
#define STATICBUFFERSIZE 1000
typedef struct {
HANDLE pipe;
char buffer[STATICBUFFERSIZE];
} pipeinfo;
pipeinfo Out = {INVALID_HANDLE_VALUE, ""};
pipeinfo Err = {INVALID_HANDLE_VALUE, ""};
/*
* exitcodes: 0 == no, 1 == yes, 2 == error
*/
int
main(
|
| ︙ | ︙ | |||
260 261 262 263 264 265 266 |
if (!ok) {
DWORD err = GetLastError();
int chars = snprintf(msg, sizeof(msg) - 1,
"Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
| | | 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 |
if (!ok) {
DWORD err = GetLastError();
int chars = snprintf(msg, sizeof(msg) - 1,
"Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPSTR)&msg[chars],
(300-chars), 0);
WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL);
return 2;
}
/*
* Close our references to the write handles that have now been inherited.
|
| ︙ | ︙ | |||
313 314 315 316 317 318 319 |
|| strstr(Err.buffer, "D9002") != NULL
|| strstr(Out.buffer, "D2021") != NULL
|| strstr(Err.buffer, "D2021") != NULL);
}
static int
CheckForLinkerFeature(
| | | 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 |
|| strstr(Err.buffer, "D9002") != NULL
|| strstr(Out.buffer, "D2021") != NULL
|| strstr(Err.buffer, "D2021") != NULL);
}
static int
CheckForLinkerFeature(
char **options,
int count)
{
STARTUPINFO si;
PROCESS_INFORMATION pi;
SECURITY_ATTRIBUTES sa;
DWORD threadID;
char msg[300];
|
| ︙ | ︙ | |||
394 395 396 397 398 399 400 |
if (!ok) {
DWORD err = GetLastError();
int chars = snprintf(msg, sizeof(msg) - 1,
"Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
| | | 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 |
if (!ok) {
DWORD err = GetLastError();
int chars = snprintf(msg, sizeof(msg) - 1,
"Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPSTR)&msg[chars],
(300-chars), 0);
WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL);
return 2;
}
/*
* Close our references to the write handles that have now been inherited.
|
| ︙ | ︙ | |||
490 491 492 493 494 495 496 |
static const char *
GetVersionFromFile(
const char *filename,
const char *match,
int numdots)
{
| < | | | | < | | | 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 |
static const char *
GetVersionFromFile(
const char *filename,
const char *match,
int numdots)
{
static char szBuffer[100];
char *szResult = NULL;
FILE *fp = fopen(filename, "rt");
if (fp != NULL) {
/*
* Read data until we see our match string.
*/
while (fgets(szBuffer, sizeof(szBuffer), fp) != NULL) {
LPSTR p, q;
p = strstr(szBuffer, match);
if (p != NULL) {
/*
* Skip to first digit after the match.
*/
p += strlen(match);
while (*p && !isdigit((unsigned char)*p)) {
++p;
}
/*
* Find ending whitespace.
*/
q = p;
while (*q && (strchr("0123456789.ab", *q)) && (((!strchr(".ab", *q)
&& !strchr("ab", q[-1])) || --numdots))) {
++q;
}
*q = 0;
szResult = p;
break;
}
}
fclose(fp);
}
return szResult;
}
|
| ︙ | ︙ | |||
549 550 551 552 553 554 555 |
char * value;
} list_item_t;
/* insert a list item into the list (list may be null) */
static list_item_t *
list_insert(list_item_t **listPtrPtr, const char *key, const char *value)
{
| | | 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 |
char * value;
} list_item_t;
/* insert a list item into the list (list may be null) */
static list_item_t *
list_insert(list_item_t **listPtrPtr, const char *key, const char *value)
{
list_item_t *itemPtr = (list_item_t *)malloc(sizeof(list_item_t));
if (itemPtr) {
itemPtr->key = strdup(key);
itemPtr->value = strdup(value);
itemPtr->nextPtr = NULL;
while(*listPtrPtr) {
listPtrPtr = &(*listPtrPtr)->nextPtr;
|
| ︙ | ︙ | |||
598 599 600 601 602 603 604 |
*/
static int
SubstituteFile(
const char *substitutions,
const char *filename)
{
| < < | | 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 |
*/
static int
SubstituteFile(
const char *substitutions,
const char *filename)
{
static char szBuffer[1024], szCopy[1024];
list_item_t *substPtr = NULL;
FILE *fp, *sp;
fp = fopen(filename, "rt");
if (fp != NULL) {
/*
* Build a list of substutitions from the first filename
*/
sp = fopen(substitutions, "rt");
if (sp != NULL) {
while (fgets(szBuffer, sizeof(szBuffer), sp) != NULL) {
unsigned char *ks, *ke, *vs, *ve;
ks = (unsigned char*)szBuffer;
while (ks && *ks && isspace(*ks)) ++ks;
ke = ks;
while (ke && *ke && !isspace(*ke)) ++ke;
vs = ke;
while (vs && *vs && isspace(*vs)) ++vs;
|
| ︙ | ︙ | |||
644 645 646 647 648 649 650 | } #endif /* * Run the substitutions over each line of the input */ | | | | 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 |
}
#endif
/*
* Run the substitutions over each line of the input
*/
while (fgets(szBuffer, sizeof(szBuffer), fp) != NULL) {
list_item_t *p = NULL;
for (p = substPtr; p != NULL; p = p->nextPtr) {
char *m = strstr(szBuffer, p->key);
if (m) {
char *cp, *op, *sp;
cp = szCopy;
op = szBuffer;
while (op != m) *cp++ = *op++;
sp = p->value;
while (sp && *sp) *cp++ = *sp++;
op += strlen(p->key);
while (*op) *cp++ = *op++;
*cp = 0;
memcpy(szBuffer, szCopy, sizeof(szCopy));
}
}
printf("%s", szBuffer);
}
list_free(&substPtr);
}
fclose(fp);
return 0;
}
|
| ︙ | ︙ | |||
712 713 714 715 716 717 718 |
* Returns 2 on any kind of error
* Basically, these are used as exit codes for the process.
*/
static int LocateDependencyHelper(const char *dir, const char *keypath)
{
HANDLE hSearch;
char path[MAX_PATH+1];
| > | | 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 |
* Returns 2 on any kind of error
* Basically, these are used as exit codes for the process.
*/
static int LocateDependencyHelper(const char *dir, const char *keypath)
{
HANDLE hSearch;
char path[MAX_PATH+1];
size_t dirlen;
int keylen, ret;
WIN32_FIND_DATA finfo;
if (dir == NULL || keypath == NULL)
return 2; /* Have no real error reporting mechanism into nmake */
dirlen = strlen(dir);
if ((dirlen + 3) > sizeof(path))
return 2;
|
| ︙ | ︙ | |||
779 780 781 782 783 784 785 |
* the parent and grandparent of the current working directory.
* If found, the command prints
* name_DIRPATH=<full path of located directory>
* and returns 0. If not found, does not print anything and returns 1.
*/
static int LocateDependency(const char *keypath)
{
| > | | 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 |
* the parent and grandparent of the current working directory.
* If found, the command prints
* name_DIRPATH=<full path of located directory>
* and returns 0. If not found, does not print anything and returns 1.
*/
static int LocateDependency(const char *keypath)
{
size_t i;
int ret;
static const char *paths[] = {"..", "..\\..", "..\\..\\.."};
for (i = 0; i < (sizeof(paths)/sizeof(paths[0])); ++i) {
ret = LocateDependencyHelper(paths[i], keypath);
if (ret == 0)
return ret;
}
|
| ︙ | ︙ |
Changes to win/rules-ext.vc.
| ︙ | ︙ | |||
27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 | !if "$(PROJECT)" == "tcl" !error The rules-ext.vc file is not intended for Tcl itself. !endif # We extract version numbers using the nmakehlp program. For now use # the local copy of nmakehlp. Once we locate Tcl, we will use that # one if it is newer. !if [$(CC) -nologo -DNDEBUG "nmakehlp.c" -link -subsystem:console > nul] !endif # First locate the Tcl directory that we are working with. !if "$(TCLDIR)" != "" _RULESDIR = $(TCLDIR:/=\) !else | > > > > > | 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 | !if "$(PROJECT)" == "tcl" !error The rules-ext.vc file is not intended for Tcl itself. !endif # We extract version numbers using the nmakehlp program. For now use # the local copy of nmakehlp. Once we locate Tcl, we will use that # one if it is newer. !if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "$(NATIVE_ARCH)" !if [$(CC) -nologo -DNDEBUG "nmakehlp.c" -link -subsystem:console > nul] !endif !else !if [copy x86_64-w64-mingw32-nmakehlp.exe nmakehlp.exe >NUL] !endif !endif # First locate the Tcl directory that we are working with. !if "$(TCLDIR)" != "" _RULESDIR = $(TCLDIR:/=\) !else |
| ︙ | ︙ |
Changes to win/rules.vc.
| ︙ | ︙ | |||
20 21 22 23 24 25 26 | !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. RULES_VERSION_MAJOR = 1 | | | 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | !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. RULES_VERSION_MAJOR = 1 RULES_VERSION_MINOR = 10 # The PROJECT macro must be defined by parent makefile. !if "$(PROJECT)" == "" !error *** Error: Macro PROJECT not defined! Please define it before including rules.vc !endif !if "$(PRJ_PACKAGE_TCLNAME)" == "" |
| ︙ | ︙ | |||
407 408 409 410 411 412 413 | # following macros: # VCVERSION - the internal compiler version as 1200, 1400, 1910 etc. # This is also printed by the compiler in dotted form 19.10 etc. # VCVER - the "marketing version", for example Visual C++ 6 for internal # compiler version 1200. This is kept only for legacy reasons as it # does not make sense for recent Microsoft compilers. Only used for # output directory names. | | | | 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 |
# following macros:
# VCVERSION - the internal compiler version as 1200, 1400, 1910 etc.
# This is also printed by the compiler in dotted form 19.10 etc.
# VCVER - the "marketing version", for example Visual C++ 6 for internal
# compiler version 1200. This is kept only for legacy reasons as it
# does not make sense for recent Microsoft compilers. Only used for
# output directory names.
# ARCH - set to IX86, ARM64 or AMD64 depending on 32- or 64-bit target
# NATIVE_ARCH - set to IX86, ARM64 or AMD64 for the host machine
# MACHINE - same as $(ARCH) - legacy
# _VC_MANIFEST_EMBED_{DLL,EXE} - commands for embedding a manifest if needed
cc32 = $(CC) # built-in default.
link32 = link
lib32 = lib
rc32 = $(RC) # built-in default.
|
| ︙ | ︙ | |||
431 432 433 434 435 436 437 438 439 440 441 442 443 444 |
_VC_MANIFEST_EMBED_DLL=
VCVER=0
!if ![echo VCVERSION=_MSC_VER > vercl.x] \
&& ![echo $(_HASH)if defined(_M_IX86) >> vercl.x] \
&& ![echo ARCH=IX86 >> vercl.x] \
&& ![echo $(_HASH)elif defined(_M_AMD64) >> vercl.x] \
&& ![echo ARCH=AMD64 >> vercl.x] \
&& ![echo $(_HASH)endif >> vercl.x] \
&& ![$(cc32) -nologo -TC -P vercl.x 2>NUL]
!include vercl.i
!if $(VCVERSION) < 1900
!if ![echo VCVER= ^\> vercl.vc] \
&& ![set /a $(VCVERSION) / 100 - 6 >> vercl.vc]
!include vercl.vc
| > > | 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 |
_VC_MANIFEST_EMBED_DLL=
VCVER=0
!if ![echo VCVERSION=_MSC_VER > vercl.x] \
&& ![echo $(_HASH)if defined(_M_IX86) >> vercl.x] \
&& ![echo ARCH=IX86 >> vercl.x] \
&& ![echo $(_HASH)elif defined(_M_AMD64) >> vercl.x] \
&& ![echo ARCH=AMD64 >> vercl.x] \
&& ![echo $(_HASH)elif defined(_M_ARM64) >> vercl.x] \
&& ![echo ARCH=ARM64 >> vercl.x] \
&& ![echo $(_HASH)endif >> vercl.x] \
&& ![$(cc32) -nologo -TC -P vercl.x 2>NUL]
!include vercl.i
!if $(VCVERSION) < 1900
!if ![echo VCVER= ^\> vercl.vc] \
&& ![set /a $(VCVERSION) / 100 - 6 >> vercl.vc]
!include vercl.vc
|
| ︙ | ︙ | |||
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 | #---------------------------------------------------------------- # The MACHINE macro is used by legacy makefiles so set it as well !ifdef MACHINE !if "$(MACHINE)" == "x86" !undef MACHINE MACHINE = IX86 !elseif "$(MACHINE)" == "x64" !undef MACHINE MACHINE = AMD64 !endif !if "$(MACHINE)" != "$(ARCH)" !error Specified MACHINE macro $(MACHINE) does not match detected target architecture $(ARCH). !endif !else MACHINE=$(ARCH) !endif #--------------------------------------------------------------- # The PLATFORM_IDENTIFY macro matches the values returned by # the Tcl platform::identify command !if "$(MACHINE)" == "AMD64" PLATFORM_IDENTIFY = win32-x86_64 !else PLATFORM_IDENTIFY = win32-ix86 !endif # The MULTIPLATFORM macro controls whether binary extensions are installed # in platform-specific directories. Intended to be set/used by extensions. !ifndef MULTIPLATFORM_INSTALL MULTIPLATFORM_INSTALL = 0 !endif #------------------------------------------------------------ # Figure out the *host* architecture by reading the registry !if ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i x86] NATIVE_ARCH=IX86 !else NATIVE_ARCH=AMD64 !endif # Since MSVC8 we must deal with manifest resources. !if $(VCVERSION) >= 1400 _VC_MANIFEST_EMBED_EXE=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1 | > > > > > > > | 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 | #---------------------------------------------------------------- # The MACHINE macro is used by legacy makefiles so set it as well !ifdef MACHINE !if "$(MACHINE)" == "x86" !undef MACHINE MACHINE = IX86 !elseif "$(MACHINE)" == "arm64" !undef MACHINE MACHINE = ARM64 !elseif "$(MACHINE)" == "x64" !undef MACHINE MACHINE = AMD64 !endif !if "$(MACHINE)" != "$(ARCH)" !error Specified MACHINE macro $(MACHINE) does not match detected target architecture $(ARCH). !endif !else MACHINE=$(ARCH) !endif #--------------------------------------------------------------- # The PLATFORM_IDENTIFY macro matches the values returned by # the Tcl platform::identify command !if "$(MACHINE)" == "AMD64" PLATFORM_IDENTIFY = win32-x86_64 !elseif "$(MACHINE)" == "ARM64" PLATFORM_IDENTIFY = win32-arm !else PLATFORM_IDENTIFY = win32-ix86 !endif # The MULTIPLATFORM macro controls whether binary extensions are installed # in platform-specific directories. Intended to be set/used by extensions. !ifndef MULTIPLATFORM_INSTALL MULTIPLATFORM_INSTALL = 0 !endif #------------------------------------------------------------ # Figure out the *host* architecture by reading the registry !if ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i x86] NATIVE_ARCH=IX86 !elseif ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i ARM | findstr /i 64-bit] NATIVE_ARCH=ARM64 !else NATIVE_ARCH=AMD64 !endif # Since MSVC8 we must deal with manifest resources. !if $(VCVERSION) >= 1400 _VC_MANIFEST_EMBED_EXE=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1 |
| ︙ | ︙ | |||
537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 | !endif # $(TCLINSTALL) !endif # !$(DOING_TCL) !endif # NMAKEHLPC # We always build nmakehlp even if it exists since we do not know # what source it was built from. !if [$(cc32) -nologo "$(NMAKEHLPC)" -link -subsystem:console > nul] !endif ################################################################ # 5. Test for compiler features # Visual C++ compiler options have changed over the years. Check # which options are supported by the compiler in use. # # The following macros are set: | > > > > > | 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 | !endif # $(TCLINSTALL) !endif # !$(DOING_TCL) !endif # NMAKEHLPC # We always build nmakehlp even if it exists since we do not know # what source it was built from. !if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "$(NATIVE_ARCH)" !if [$(cc32) -nologo "$(NMAKEHLPC)" -link -subsystem:console > nul] !endif !else !if [copy $(NMAKEHLPC:nmakehlp.c=x86_64-w64-mingw32-nmakehlp.exe) nmakehlp.exe >NUL] !endif !endif ################################################################ # 5. Test for compiler features # Visual C++ compiler options have changed over the years. Check # which options are supported by the compiler in use. # # The following macros are set: |
| ︙ | ︙ | |||
1119 1120 1121 1122 1123 1124 1125 | # # Set up paths to various Tcl executables and libraries needed by extensions # # TIP 430. Unused for 8.6 but no harm defining it to allow a common rules.vc TCLSCRIPTZIPNAME = libtcl$(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)$(TCL_PATCH_LETTER)$(TCL_RELEASE_SERIAL).zip | | | 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 | # # Set up paths to various Tcl executables and libraries needed by extensions # # TIP 430. Unused for 8.6 but no harm defining it to allow a common rules.vc TCLSCRIPTZIPNAME = libtcl$(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)$(TCL_PATCH_LETTER)$(TCL_RELEASE_SERIAL).zip TKSCRIPTZIPNAME = libtk$(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)$(TK_PATCH_LETTER)$(TK_RELEASE_SERIAL).zip !if $(DOING_TCL) 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) |
| ︙ | ︙ | |||
1199 1200 1201 1202 1203 1204 1205 | !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 | | > > | > > > > > | 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 | !endif !endif # Do the same for Tk and Tk extensions that require the Tk libraries !if $(DOING_TK) || $(NEED_TK) WISHNAMEPREFIX = wish WISHNAME = $(WISHNAMEPREFIX)$(TK_VERSION)$(SUFX).exe TKLIBNAME8 = tk$(TK_VERSION)$(SUFX).$(EXT) TKLIBNAME9 = tcl9tk$(TK_VERSION)$(SUFX).$(EXT) !if $(TCL_MAJOR_VERSION) == 8 TKLIBNAME = tk$(TK_VERSION)$(SUFX).$(EXT) TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX).lib !else TKLIBNAME = tcl9tk$(TK_VERSION)$(SUFX).$(EXT) TKIMPLIBNAME = tcl9tk$(TK_VERSION)$(SUFX).lib !endif TKSTUBLIBNAME = tkstub$(TK_VERSION).lib !if $(DOING_TK) WISH = $(OUT_DIR)\$(WISHNAME) TKSTUBLIB = $(OUT_DIR)\$(TKSTUBLIBNAME) TKIMPLIB = $(OUT_DIR)\$(TKIMPLIBNAME) TKLIB = $(OUT_DIR)\$(TKLIBNAME) TK_INCLUDES = -I"$(WIN_DIR)" -I"$(GENERICDIR)" |
| ︙ | ︙ | |||
1249 1250 1251 1252 1253 1254 1255 | tklibs = "$(TKSTUBLIB)" "$(TKIMPLIB)" !endif # $(DOING_TK) !endif # $(DOING_TK) || $(NEED_TK) # Various output paths PRJIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib | | > > > > > > | 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 | tklibs = "$(TKSTUBLIB)" "$(TKIMPLIB)" !endif # $(DOING_TK) !endif # $(DOING_TK) || $(NEED_TK) # Various output paths PRJIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib PRJLIBNAME8 = $(PROJECT)$(VERSION)$(SUFX).$(EXT) PRJLIBNAME9 = tcl9$(PROJECT)$(VERSION)$(SUFX).$(EXT) !if $(TCL_MAJOR_VERSION) == 8 PRJLIBNAME = $(PRJLIBNAME8) !else PRJLIBNAME = $(PRJLIBNAME9) !endif PRJLIB = $(OUT_DIR)\$(PRJLIBNAME) PRJSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib PRJSTUBLIB = $(OUT_DIR)\$(PRJSTUBLIBNAME) # If extension parent makefile has not defined a resource definition file, # we will generate one from standard template. |
| ︙ | ︙ | |||
1327 1328 1329 1330 1331 1332 1333 | # lflags - complete linker switches (subsumes ldebug) except subsystem type # dlllflags - complete linker switches to build DLLs (subsumes lflags) # conlflags - complete linker switches for console program (subsumes lflags) # guilflags - complete linker switches for GUI program (subsumes lflags) # baselibs - minimum Windows libraries required. Parent makefile can # define PRJ_LIBS before including rules.rc if additional libs are needed | | | 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 | # lflags - complete linker switches (subsumes ldebug) except subsystem type # dlllflags - complete linker switches to build DLLs (subsumes lflags) # conlflags - complete linker switches for console program (subsumes lflags) # guilflags - complete linker switches for GUI program (subsumes lflags) # baselibs - minimum Windows libraries required. Parent makefile can # define PRJ_LIBS before including rules.rc if additional libs are needed OPTDEFINES = /DSTDC_HEADERS /DUSE_NMAKE=1 !if $(VCVERSION) > 1600 OPTDEFINES = $(OPTDEFINES) /DHAVE_STDINT_H=1 !else OPTDEFINES = $(OPTDEFINES) /DMP_NO_STDINT=1 !endif !if $(VCVERSION) >= 1800 OPTDEFINES = $(OPTDEFINES) /DHAVE_INTTYPES_H=1 /DHAVE_STDBOOL_H=1 |
| ︙ | ︙ | |||
1353 1354 1355 1356 1357 1358 1359 | OPTDEFINES = $(OPTDEFINES) /DUSE_THREAD_ALLOC=1 !endif !endif !if $(STATIC_BUILD) OPTDEFINES = $(OPTDEFINES) /DSTATIC_BUILD !elseif $(TCL_VERSION) > 86 OPTDEFINES = $(OPTDEFINES) /DTCL_WITH_EXTERNAL_TOMMATH | | | 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 | OPTDEFINES = $(OPTDEFINES) /DUSE_THREAD_ALLOC=1 !endif !endif !if $(STATIC_BUILD) OPTDEFINES = $(OPTDEFINES) /DSTATIC_BUILD !elseif $(TCL_VERSION) > 86 OPTDEFINES = $(OPTDEFINES) /DTCL_WITH_EXTERNAL_TOMMATH !if "$(MACHINE)" == "AMD64" || "$(MACHINE)" == "ARM64" OPTDEFINES = $(OPTDEFINES) /DMP_64BIT !endif !endif !if $(TCL_NO_DEPRECATED) OPTDEFINES = $(OPTDEFINES) /DTCL_NO_DEPRECATED !endif |
| ︙ | ︙ | |||
1381 1382 1383 1384 1385 1386 1387 | !if $(OPTIMIZING) OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_OPTIMIZED !endif !endif !if $(PROFILE) OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_PROFILED !endif | | | 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 | !if $(OPTIMIZING) OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_OPTIMIZED !endif !endif !if $(PROFILE) OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_PROFILED !endif !if "$(MACHINE)" == "AMD64" || "$(MACHINE)" == "ARM64" OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_DO64BIT !endif !if $(VCVERSION) < 1300 OPTDEFINES = $(OPTDEFINES) /DNO_STRTOI64=1 !endif !if "$(TCL_MAJOR_VERSION)" == "8" |
| ︙ | ︙ | |||
1443 1444 1445 1446 1447 1448 1449 | !endif !endif # $(DEBUG) # cwarn includes default warning levels. cwarn = $(WARNINGS) | | > > > > > | 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 | !endif !endif # $(DEBUG) # cwarn includes default warning levels. cwarn = $(WARNINGS) !if "$(MACHINE)" == "AMD64" || "$(MACHINE)" == "ARM64" # Disable pointer<->int warnings related to cast between different sizes # There are a gadzillion of these due to use of ClientData and # clutter up compiler # output increasing chance of a real warning getting lost. So disable them. # Eventually some day, Tcl will be 64-bit clean. cwarn = $(cwarn) -wd4311 -wd4312 !endif ### Common compiler options that are architecture specific !if "$(MACHINE)" == "ARM" carch = /D_ARM_WINAPI_PARTITION_DESKTOP_SDK_AVAILABLE !else carch = !endif # cpuid is only available on intel machines !if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "AMD64" carch = $(carch) /DHAVE_CPUID=1 !endif !if $(DEBUG) # Turn warnings into errors cwarn = $(cwarn) -WX !endif INCLUDES = $(TCL_INCLUDES) $(TK_INCLUDES) $(PRJ_INCLUDES) |
| ︙ | ︙ | |||
1579 1580 1581 1582 1583 1584 1585 1586 | DEFAULT_BUILD_TARGET = $(PROJECT) !endif default-target: $(DEFAULT_BUILD_TARGET) !if $(MULTIPLATFORM_INSTALL) default-pkgindex: @echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \ | > | > > > > > | > > > > > > | 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 |
DEFAULT_BUILD_TARGET = $(PROJECT)
!endif
default-target: $(DEFAULT_BUILD_TARGET)
!if $(MULTIPLATFORM_INSTALL)
default-pkgindex:
@echo if {[package vsatisfies [package provide Tcl] 9.0-]} { > $(OUT_DIR)\pkgIndex.tcl
@echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
[list load [file join $$dir $(PLATFORM_IDENTIFY) $(PRJLIBNAME9)]] >> $(OUT_DIR)\pkgIndex.tcl
@echo } else { >> $(OUT_DIR)\pkgIndex.tcl
@echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
[list load [file join $$dir $(PLATFORM_IDENTIFY) $(PRJLIBNAME8)]] >> $(OUT_DIR)\pkgIndex.tcl
@echo } >> $(OUT_DIR)\pkgIndex.tcl
!else
default-pkgindex:
@echo if {[package vsatisfies [package provide Tcl] 9.0-]} { > $(OUT_DIR)\pkgIndex.tcl
@echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
[list load [file join $$dir $(PRJLIBNAME9)]] >> $(OUT_DIR)\pkgIndex.tcl
@echo } else { >> $(OUT_DIR)\pkgIndex.tcl
@echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
[list load [file join $$dir $(PRJLIBNAME8)]] >> $(OUT_DIR)\pkgIndex.tcl
@echo } >> $(OUT_DIR)\pkgIndex.tcl
!endif
default-pkgindex-tea:
@if exist $(ROOT)\pkgIndex.tcl.in nmakehlp -s << $(ROOT)\pkgIndex.tcl.in > $(OUT_DIR)\pkgIndex.tcl
@PACKAGE_VERSION@ $(DOTVERSION)
@PACKAGE_NAME@ $(PRJ_PACKAGE_TCLNAME)
@PACKAGE_TCLNAME@ $(PRJ_PACKAGE_TCLNAME)
@PKG_LIB_FILE@ $(PRJLIBNAME)
@PKG_LIB_FILE8@ $(PRJLIBNAME8)
@PKG_LIB_FILE9@ $(PRJLIBNAME9)
<<
default-install: default-install-binaries default-install-libraries
!if $(SYMBOLS)
default-install: default-install-pdbs
!endif
|
| ︙ | ︙ |
Added win/svnmanifest.in.
> | 1 | svn-r |
Changes to win/tcl.dsp.
| ︙ | ︙ | |||
820 821 822 823 824 825 826 | # End Source File # Begin Source File SOURCE=..\doc\SplitPath.3 # End Source File # Begin Source File | | | 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 | # End Source File # Begin Source File SOURCE=..\doc\SplitPath.3 # End Source File # Begin Source File SOURCE=..\doc\StaticLibrary.3 # End Source File # Begin Source File SOURCE=..\doc\StdChannels.3 # End Source File # Begin Source File |
| ︙ | ︙ |
Changes to win/tcl.m4.
| ︙ | ︙ | |||
497 498 499 500 501 502 503 |
AC_CHECK_PROG(CYGPATH, cygpath, cygpath -m, echo)
AC_CHECK_PROG(WINE, wine, wine,)
SHLIB_SUFFIX=".dll"
# MACHINE is IX86 for LINK, but this is used by the manifest,
| | | 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 |
AC_CHECK_PROG(CYGPATH, cygpath, cygpath -m, echo)
AC_CHECK_PROG(WINE, wine, wine,)
SHLIB_SUFFIX=".dll"
# MACHINE is IX86 for LINK, but this is used by the manifest,
# which requires x86|amd64|arm64|ia64.
MACHINE="X86"
if test "$GCC" = "yes"; then
AC_CACHE_CHECK(for cross-compile version of gcc,
ac_cv_cross,
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
|
| ︙ | ︙ | |||
522 523 524 525 526 527 528 529 530 531 532 533 534 535 |
amd64|x64|yes)
CC="x86_64-w64-mingw32-${CC}"
LD="x86_64-w64-mingw32-ld"
AR="x86_64-w64-mingw32-ar"
RANLIB="x86_64-w64-mingw32-ranlib"
RC="x86_64-w64-mingw32-windres"
;;
*)
CC="i686-w64-mingw32-${CC}"
LD="i686-w64-mingw32-ld"
AR="i686-w64-mingw32-ar"
RANLIB="i686-w64-mingw32-ranlib"
RC="i686-w64-mingw32-windres"
;;
| > > > > > > > | 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 |
amd64|x64|yes)
CC="x86_64-w64-mingw32-${CC}"
LD="x86_64-w64-mingw32-ld"
AR="x86_64-w64-mingw32-ar"
RANLIB="x86_64-w64-mingw32-ranlib"
RC="x86_64-w64-mingw32-windres"
;;
arm64|aarch64)
CC="aarch64-w64-mingw32-clang"
LD="aarch64-w64-mingw32-ld"
AR="aarch64-w64-mingw32-ar"
RANLIB="aarch64-w64-mingw32-ranlib"
RC="aarch64-w64-mingw32-windres"
;;
*)
CC="i686-w64-mingw32-${CC}"
LD="i686-w64-mingw32-ld"
AR="i686-w64-mingw32-ar"
RANLIB="i686-w64-mingw32-ranlib"
RC="i686-w64-mingw32-windres"
;;
|
| ︙ | ︙ | |||
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 |
]], [[]])],
[ac_cv_win32=no],
[ac_cv_win32=yes])
)
if test "$ac_cv_win32" != "yes"; then
AC_MSG_ERROR([${CC} cannot produce win32 executables.])
fi
hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain"
AC_CACHE_CHECK(for working -municode linker flag,
ac_cv_municode,
AC_LINK_IFELSE([AC_LANG_PROGRAM([[
#include <windows.h>
int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;}
]], [[]])],
[ac_cv_municode=yes],
[ac_cv_municode=no])
)
CFLAGS=$hold_cflags
if test "$ac_cv_municode" = "yes" ; then
extra_ldflags="$extra_ldflags -municode"
else
extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS"
fi
AC_CACHE_CHECK(for working -fno-lto,
ac_cv_nolto,
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([])],
[ac_cv_nolto=yes],
[ac_cv_nolto=no])
)
CFLAGS=$hold_cflags
| > > > > | 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 |
]], [[]])],
[ac_cv_win32=no],
[ac_cv_win32=yes])
)
if test "$ac_cv_win32" != "yes"; then
AC_MSG_ERROR([${CC} cannot produce win32 executables.])
fi
if test "$do64bit" != "arm64"; then
extra_cflags="$extra_cflags -DHAVE_CPUID=1"
fi
hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain"
AC_CACHE_CHECK(for working -municode linker flag,
ac_cv_municode,
AC_LINK_IFELSE([AC_LANG_PROGRAM([[
#include <windows.h>
int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;}
]], [[]])],
[ac_cv_municode=yes],
[ac_cv_municode=no])
)
CFLAGS=$hold_cflags
if test "$ac_cv_municode" = "yes" ; then
extra_ldflags="$extra_ldflags -municode"
else
extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS"
fi
hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -fno-lto"
AC_CACHE_CHECK(for working -fno-lto,
ac_cv_nolto,
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([])],
[ac_cv_nolto=yes],
[ac_cv_nolto=no])
)
CFLAGS=$hold_cflags
|
| ︙ | ︙ | |||
620 621 622 623 624 625 626 627 628 629 630 631 632 633 |
hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -finput-charset=UTF-8"
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[]])],[tcl_cv_cc_input_charset=yes],[tcl_cv_cc_input_charset=no])
CFLAGS=$hold_cflags])
if test $tcl_cv_cc_input_charset = yes; then
extra_cflags="$extra_cflags -finput-charset=UTF-8"
fi
fi
AC_MSG_CHECKING([compiler flags])
if test "${GCC}" = "yes" ; then
SHLIB_LD=""
SHLIB_LD_LIBS='${LIBS}'
LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -luserenv -lws2_32"
# mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't
| > > > > > > > > > > > > | | 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 |
hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -finput-charset=UTF-8"
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[]])],[tcl_cv_cc_input_charset=yes],[tcl_cv_cc_input_charset=no])
CFLAGS=$hold_cflags])
if test $tcl_cv_cc_input_charset = yes; then
extra_cflags="$extra_cflags -finput-charset=UTF-8"
fi
fi
hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Wl,--enable-auto-image-base"
AC_CACHE_CHECK(for working --enable-auto-image-base,
ac_cv_enable_auto_image_base,
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([])],
[ac_cv_enable_auto_image_base=yes],
[ac_cv_enable_auto_image_base=no])
)
CFLAGS=$hold_cflags
if test "$ac_cv_enable_auto_image_base" == "yes" ; then
extra_ldflags="$extra_ldflags -Wl,--enable-auto-image-base"
fi
AC_MSG_CHECKING([compiler flags])
if test "${GCC}" = "yes" ; then
SHLIB_LD=""
SHLIB_LD_LIBS='${LIBS}'
LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -luserenv -lws2_32"
# mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't
LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32 -lwinspool"
STLIB_LD='${AR} cr'
RC_OUT=-o
RC_TYPE=
RC_INCLUDE=--include
RC_DEFINE=--define
RES=res.o
MAKE_LIB="\${STLIB_LD} \[$]@"
|
| ︙ | ︙ | |||
718 719 720 721 722 723 724 725 726 |
LDFLAGS_WINDOW="-mwindows ${extra_ldflags}"
case "$do64bit" in
amd64|x64|yes)
MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
AC_MSG_RESULT([ Using 64-bit $MACHINE mode])
;;
ia64)
MACHINE="IA64"
| > > > > | | 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 |
LDFLAGS_WINDOW="-mwindows ${extra_ldflags}"
case "$do64bit" in
amd64|x64|yes)
MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
AC_MSG_RESULT([ Using 64-bit $MACHINE mode])
;;
arm64|aarch64)
MACHINE="ARM64"
AC_MSG_RESULT([ Using ARM64 $MACHINE mode])
;;
ia64)
MACHINE="IA64"
AC_MSG_RESULT([ Using IA64 $MACHINE mode])
;;
*)
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
#ifndef _WIN64
#error 32-bit
#endif
]], [[]])],
|
| ︙ | ︙ | |||
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 |
LIBFLAGSUFFIX=""
if test "$do64bit" != "no" ; then
case "$do64bit" in
amd64|x64|yes)
MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
;;
ia64)
MACHINE="IA64"
;;
esac
AC_MSG_RESULT([ Using 64-bit $MACHINE mode])
fi
LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib"
case "x`echo \${VisualStudioVersion}`" in
x1[[4-9]]*)
LIBS="$LIBS ucrt.lib"
;;
*)
;;
esac
if test "$do64bit" != "no" ; then
RC="rc"
CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d"
| > > > < | | | 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 |
LIBFLAGSUFFIX=""
if test "$do64bit" != "no" ; then
case "$do64bit" in
amd64|x64|yes)
MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
;;
arm64|aarch64)
MACHINE="ARM64"
;;
ia64)
MACHINE="IA64"
;;
esac
AC_MSG_RESULT([ Using 64-bit $MACHINE mode])
fi
LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib"
case "x`echo \${VisualStudioVersion}`" in
x1[[4-9]]*)
LIBS="$LIBS ucrt.lib"
;;
*)
;;
esac
if test "$do64bit" != "no" ; then
RC="rc"
CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d"
CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}"
lflags="${lflags} -nologo -MACHINE:${MACHINE}"
LINKBIN="link"
# Avoid 'unresolved external symbol __security_cookie' errors.
# c.f. http://support.microsoft.com/?id=894573
LIBS="$LIBS bufferoverflowU.lib"
else
RC="rc"
# -Od - no optimization
# -WX - warnings as errors
CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d"
# -O2 - create fast code (/Og /Oi /Ot /Oy /Ob2 /Gs /GF /Gy)
CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}"
lflags="${lflags} -nologo"
LINKBIN="link"
fi
LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib winspool.lib"
SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}"
SHLIB_LD_LIBS='${LIBS}'
# link -lib only works when -lib is the first arg
STLIB_LD="${LINKBIN} -lib ${lflags}"
RC_OUT=-fo
RC_TYPE=-r
|
| ︙ | ︙ | |||
1063 1064 1065 1066 1067 1068 1069 |
# Results
# Subst's the following values:
# BUILD_TCLSH
#------------------------------------------------------------------------
AC_DEFUN([SC_BUILD_TCLSH], [
AC_MSG_CHECKING([for tclsh in Tcl build directory])
| | | 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 |
# Results
# Subst's the following values:
# BUILD_TCLSH
#------------------------------------------------------------------------
AC_DEFUN([SC_BUILD_TCLSH], [
AC_MSG_CHECKING([for tclsh in Tcl build directory])
BUILD_TCLSH=${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}\${EXESUFFIX}
AC_MSG_RESULT($BUILD_TCLSH)
AC_SUBST(BUILD_TCLSH)
])
#--------------------------------------------------------------------
# SC_TCL_CFG_ENCODING TIP #59
#
|
| ︙ | ︙ |
Changes to win/tclAppInit.c.
| ︙ | ︙ | |||
19 20 21 22 23 24 25 26 27 | #define STRICT /* See MSDN Article Q83456 */ #include <windows.h> #undef STRICT #undef WIN32_LEAN_AND_MEAN #include <locale.h> #include <stdlib.h> #include <tchar.h> #ifdef TCL_TEST | > > > > | | | | | | 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 | #define STRICT /* See MSDN Article Q83456 */ #include <windows.h> #undef STRICT #undef WIN32_LEAN_AND_MEAN #include <locale.h> #include <stdlib.h> #include <tchar.h> #if TCL_MAJOR_VERSION < 9 && TCL_MINOR_VERSION < 7 # define Tcl_LibraryInitProc Tcl_PackageInitProc # define Tcl_StaticLibrary Tcl_StaticPackage #endif #ifdef TCL_TEST extern Tcl_LibraryInitProc Tcltest_Init; extern Tcl_LibraryInitProc Tcltest_SafeInit; #endif /* TCL_TEST */ #if defined(STATIC_BUILD) extern Tcl_LibraryInitProc Registry_Init; extern Tcl_LibraryInitProc Dde_Init; extern Tcl_LibraryInitProc Dde_SafeInit; #endif #if defined(__GNUC__) || defined(TCL_BROKEN_MAINARGS) int _CRT_glob = 0; #endif /* __GNUC__ || TCL_BROKEN_MAINARGS */ #ifdef TCL_BROKEN_MAINARGS static void setargv(int *argcPtr, TCHAR ***argvPtr); |
| ︙ | ︙ | |||
83 84 85 86 87 88 89 |
*----------------------------------------------------------------------
*/
#ifdef TCL_BROKEN_MAINARGS
int
main(
int argc, /* Number of command-line arguments. */
| | < < > | 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 |
*----------------------------------------------------------------------
*/
#ifdef TCL_BROKEN_MAINARGS
int
main(
int argc, /* Number of command-line arguments. */
char **argv1) /* Not used. */
{
TCHAR **argv;
#else
int
_tmain(
int argc, /* Number of command-line arguments. */
TCHAR *argv[]) /* Values of command-line arguments. */
{
#endif
TCHAR *p;
/*
* Set up the default locale to be standard "C" locale so parsing is
* performed correctly.
*/
setlocale(LC_ALL, "C");
|
| ︙ | ︙ | |||
124 125 126 127 128 129 130 |
if (*p == '\\') {
*p = '/';
}
}
#ifdef TCL_LOCAL_MAIN_HOOK
TCL_LOCAL_MAIN_HOOK(&argc, &argv);
| | | | 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 |
if (*p == '\\') {
*p = '/';
}
}
#ifdef TCL_LOCAL_MAIN_HOOK
TCL_LOCAL_MAIN_HOOK(&argc, &argv);
#elif (TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6) && (!defined(_WIN32) || defined(UNICODE))
/* 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. */
}
|
| ︙ | ︙ | |||
164 165 166 167 168 169 170 |
return TCL_ERROR;
}
#if defined(STATIC_BUILD)
if (Registry_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
| | | | | 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 |
return TCL_ERROR;
}
#if defined(STATIC_BUILD)
if (Registry_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticLibrary(interp, "Registry", Registry_Init, NULL);
if (Dde_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticLibrary(interp, "Dde", Dde_Init, Dde_SafeInit);
#endif
#ifdef TCL_TEST
if (Tcltest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticLibrary(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit);
#endif /* TCL_TEST */
/*
* Call the init procedures for included packages. Each call should look
* like this:
*
* if (Mod_Init(interp) == TCL_ERROR) {
|
| ︙ | ︙ |
Added win/tclUuid.h.in.
> | 1 | #define TCL_VERSION_UUID \ |
Changes to win/tclWin32Dll.c.
| ︙ | ︙ | |||
503 504 505 506 507 508 509 |
int
TclWinCPUID(
int index, /* Which CPUID value to retrieve. */
int *regsPtr) /* Registers after the CPUID. */
{
int status = TCL_ERROR;
| | | | 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 |
int
TclWinCPUID(
int index, /* Which CPUID value to retrieve. */
int *regsPtr) /* Registers after the CPUID. */
{
int status = TCL_ERROR;
#if defined(HAVE_INTRIN_H) && defined(_WIN64) && defined(HAVE_CPUID)
__cpuid((int *)regsPtr, index);
status = TCL_OK;
#elif defined(__GNUC__) && defined(HAVE_CPUID)
# if defined(_WIN64)
/*
* Execute the CPUID instruction with the given index, and store results
* off 'regPtr'.
*/
__asm__ __volatile__(
|
| ︙ | ︙ | |||
624 625 626 627 628 629 630 |
[ok] "i" (TCL_OK),
[error] "i" (TCL_ERROR)
:
"%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory");
status = registration.status;
# endif /* !_WIN64 */
| | | 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 |
[ok] "i" (TCL_OK),
[error] "i" (TCL_ERROR)
:
"%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory");
status = registration.status;
# endif /* !_WIN64 */
#elif defined(_MSC_VER) && defined(HAVE_CPUID)
# if defined(_WIN64)
__cpuid(regsPtr, index);
status = TCL_OK;
# elif defined (_M_IX86)
/*
|
| ︙ | ︙ | |||
679 680 681 682 683 684 685 686 687 688 689 690 691 692 |
status = TCL_OK;
} __except(EXCEPTION_EXECUTE_HANDLER) {
/* do nothing */
}
# endif
#else
/*
* Don't know how to do assembly code for this compiler and/or
* architecture.
*/
#endif
return status;
}
| > > | 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 |
status = TCL_OK;
} __except(EXCEPTION_EXECUTE_HANDLER) {
/* do nothing */
}
# endif
#else
(void)index;
(void)regsPtr;
/*
* Don't know how to do assembly code for this compiler and/or
* architecture.
*/
#endif
return status;
}
|
| ︙ | ︙ |
Changes to win/tclWinChan.c.
| ︙ | ︙ | |||
417 418 419 420 421 422 423 |
*/
if (!TclInThreadExit()
|| ((GetStdHandle(STD_INPUT_HANDLE) != fileInfoPtr->handle)
&& (GetStdHandle(STD_OUTPUT_HANDLE) != fileInfoPtr->handle)
&& (GetStdHandle(STD_ERROR_HANDLE) != fileInfoPtr->handle))) {
if (CloseHandle(fileInfoPtr->handle) == FALSE) {
| | | 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 |
*/
if (!TclInThreadExit()
|| ((GetStdHandle(STD_INPUT_HANDLE) != fileInfoPtr->handle)
&& (GetStdHandle(STD_OUTPUT_HANDLE) != fileInfoPtr->handle)
&& (GetStdHandle(STD_ERROR_HANDLE) != fileInfoPtr->handle))) {
if (CloseHandle(fileInfoPtr->handle) == FALSE) {
Tcl_WinConvertError(GetLastError());
errorCode = errno;
}
}
/*
* See if this FileInfo* is still on the thread local list.
*/
|
| ︙ | ︙ | |||
493 494 495 496 497 498 499 |
oldPosHigh = 0;
oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT);
if (oldPos == (LONG) INVALID_SET_FILE_POINTER) {
DWORD winError = GetLastError();
if (winError != NO_ERROR) {
| | | | 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 |
oldPosHigh = 0;
oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT);
if (oldPos == (LONG) INVALID_SET_FILE_POINTER) {
DWORD winError = GetLastError();
if (winError != NO_ERROR) {
Tcl_WinConvertError(winError);
*errorCodePtr = errno;
return -1;
}
}
newPosHigh = (offset < 0 ? -1 : 0);
newPos = SetFilePointer(infoPtr->handle, offset, &newPosHigh, moveMethod);
if (newPos == (LONG) INVALID_SET_FILE_POINTER) {
DWORD winError = GetLastError();
if (winError != NO_ERROR) {
Tcl_WinConvertError(winError);
*errorCodePtr = errno;
return -1;
}
}
/*
* Check for expressability in our return type, and roll-back otherwise.
|
| ︙ | ︙ | |||
569 570 571 572 573 574 575 |
newPosHigh = (LONG)(offset >> 32);
newPos = SetFilePointer(infoPtr->handle, (LONG)offset,
&newPosHigh, moveMethod);
if (newPos == (LONG) INVALID_SET_FILE_POINTER) {
DWORD winError = GetLastError();
if (winError != NO_ERROR) {
| | | 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 |
newPosHigh = (LONG)(offset >> 32);
newPos = SetFilePointer(infoPtr->handle, (LONG)offset,
&newPosHigh, moveMethod);
if (newPos == (LONG) INVALID_SET_FILE_POINTER) {
DWORD winError = GetLastError();
if (winError != NO_ERROR) {
Tcl_WinConvertError(winError);
*errorCodePtr = errno;
return -1;
}
}
return (((long long)((unsigned)newPos))
| ((long long)newPosHigh << 32));
}
|
| ︙ | ︙ | |||
612 613 614 615 616 617 618 |
oldPosHigh = 0;
oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT);
if (oldPos == (LONG) INVALID_SET_FILE_POINTER) {
DWORD winError = GetLastError();
if (winError != NO_ERROR) {
| | | | | 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 |
oldPosHigh = 0;
oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT);
if (oldPos == (LONG) INVALID_SET_FILE_POINTER) {
DWORD winError = GetLastError();
if (winError != NO_ERROR) {
Tcl_WinConvertError(winError);
return errno;
}
}
/*
* Move to where we want to truncate
*/
newPosHigh = (LONG)(length >> 32);
newPos = SetFilePointer(infoPtr->handle, (LONG)length,
&newPosHigh, FILE_BEGIN);
if (newPos == (LONG) INVALID_SET_FILE_POINTER) {
DWORD winError = GetLastError();
if (winError != NO_ERROR) {
Tcl_WinConvertError(winError);
return errno;
}
}
/*
* Perform the truncation (unlike POSIX ftruncate(), we needed to move to
* the location to truncate at first).
*/
if (!SetEndOfFile(infoPtr->handle)) {
Tcl_WinConvertError(GetLastError());
return errno;
}
/*
* Move back. If this last step fails, we don't care; it's just a "best
* effort" attempt to restore our file pointer to where it was.
*/
|
| ︙ | ︙ | |||
699 700 701 702 703 704 705 |
*/
if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
(LPOVERLAPPED) NULL) != FALSE) {
return bytesRead;
}
| | | 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 |
*/
if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
(LPOVERLAPPED) NULL) != FALSE) {
return bytesRead;
}
Tcl_WinConvertError(GetLastError());
*errorCode = errno;
if (errno == EPIPE) {
return 0;
}
return -1;
}
|
| ︙ | ︙ | |||
748 749 750 751 752 753 754 |
if (TEST_FLAG(infoPtr->flags, FILE_APPEND)) {
SetFilePointer(infoPtr->handle, 0, NULL, FILE_END);
}
if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite,
&bytesWritten, (LPOVERLAPPED) NULL) == FALSE) {
| | | 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 |
if (TEST_FLAG(infoPtr->flags, FILE_APPEND)) {
SetFilePointer(infoPtr->handle, 0, NULL, FILE_END);
}
if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite,
&bytesWritten, (LPOVERLAPPED) NULL) == FALSE) {
Tcl_WinConvertError(GetLastError());
*errorCode = errno;
return -1;
}
infoPtr->dirty = 1;
return bytesWritten;
}
|
| ︙ | ︙ | |||
923 924 925 926 927 928 929 |
* handling for Windows serial ports by a "name-hint" to directly open it
* with the OVERLAPPED flag set.
*/
if (NativeIsComPort(nativeName)) {
handle = TclWinSerialOpen(INVALID_HANDLE_VALUE, nativeName, accessMode);
if (handle == INVALID_HANDLE_VALUE) {
| | | 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 |
* handling for Windows serial ports by a "name-hint" to directly open it
* with the OVERLAPPED flag set.
*/
if (NativeIsComPort(nativeName)) {
handle = TclWinSerialOpen(INVALID_HANDLE_VALUE, nativeName, accessMode);
if (handle == INVALID_HANDLE_VALUE) {
Tcl_WinConvertError(GetLastError());
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't open serial \"%s\": %s",
TclGetString(pathPtr), Tcl_PosixError(interp)));
}
return NULL;
}
|
| ︙ | ︙ | |||
980 981 982 983 984 985 986 |
if (handle == INVALID_HANDLE_VALUE) {
DWORD err = GetLastError();
if ((err & 0xFFFFL) == ERROR_OPEN_FAILED) {
err = TEST_FLAG(mode, O_CREAT) ? ERROR_FILE_EXISTS
: ERROR_FILE_NOT_FOUND;
}
| | | 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 |
if (handle == INVALID_HANDLE_VALUE) {
DWORD err = GetLastError();
if ((err & 0xFFFFL) == ERROR_OPEN_FAILED) {
err = TEST_FLAG(mode, O_CREAT) ? ERROR_FILE_EXISTS
: ERROR_FILE_NOT_FOUND;
}
Tcl_WinConvertError(err);
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't open \"%s\": %s",
TclGetString(pathPtr), Tcl_PosixError(interp)));
}
return NULL;
}
|
| ︙ | ︙ | |||
1004 1005 1006 1007 1008 1009 1010 |
*
* Reopen channel for OVERLAPPED operation. Normally this shouldn't
* fail, because the channel exists.
*/
handle = TclWinSerialOpen(handle, nativeName, accessMode);
if (handle == INVALID_HANDLE_VALUE) {
| | | 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 |
*
* Reopen channel for OVERLAPPED operation. Normally this shouldn't
* fail, because the channel exists.
*/
handle = TclWinSerialOpen(handle, nativeName, accessMode);
if (handle == INVALID_HANDLE_VALUE) {
Tcl_WinConvertError(GetLastError());
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't reopen serial \"%s\": %s",
TclGetString(pathPtr), Tcl_PosixError(interp)));
}
return NULL;
}
|
| ︙ | ︙ |
Changes to win/tclWinConsole.c.
| ︙ | ︙ | |||
598 599 600 601 602 603 604 |
*/
if (!TclInThreadExit()
|| ((GetStdHandle(STD_INPUT_HANDLE) != consolePtr->handle)
&& (GetStdHandle(STD_OUTPUT_HANDLE) != consolePtr->handle)
&& (GetStdHandle(STD_ERROR_HANDLE) != consolePtr->handle))) {
if (CloseHandle(consolePtr->handle) == FALSE) {
| | | 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 |
*/
if (!TclInThreadExit()
|| ((GetStdHandle(STD_INPUT_HANDLE) != consolePtr->handle)
&& (GetStdHandle(STD_OUTPUT_HANDLE) != consolePtr->handle)
&& (GetStdHandle(STD_ERROR_HANDLE) != consolePtr->handle))) {
if (CloseHandle(consolePtr->handle) == FALSE) {
Tcl_WinConvertError(GetLastError());
errorCode = errno;
}
}
consolePtr->watchMask &= consolePtr->validMask;
/*
|
| ︙ | ︙ | |||
768 769 770 771 772 773 774 |
}
/*
* Check for a background error on the last write.
*/
if (infoPtr->writeError) {
| | | 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 |
}
/*
* Check for a background error on the last write.
*/
if (infoPtr->writeError) {
Tcl_WinConvertError(infoPtr->writeError);
infoPtr->writeError = 0;
goto error;
}
if (infoPtr->flags & CONSOLE_ASYNC) {
/*
* The console is non-blocking, so copy the data into the output
|
| ︙ | ︙ | |||
803 804 805 806 807 808 809 |
/*
* In the blocking case, just try to write the buffer directly. This
* avoids an unnecessary copy.
*/
if (WriteConsoleBytes(infoPtr->handle, buf, (DWORD) toWrite,
&bytesWritten) == FALSE) {
| | | 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 |
/*
* In the blocking case, just try to write the buffer directly. This
* avoids an unnecessary copy.
*/
if (WriteConsoleBytes(infoPtr->handle, buf, (DWORD) toWrite,
&bytesWritten) == FALSE) {
Tcl_WinConvertError(GetLastError());
goto error;
}
}
return bytesWritten;
error:
*errorCode = errno;
|
| ︙ | ︙ | |||
1061 1062 1063 1064 1065 1066 1067 |
}
if (PeekConsoleInputW(handle, &input, 1, &count) == FALSE) {
/*
* Check to see if the peek failed because of EOF.
*/
| | | 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 |
}
if (PeekConsoleInputW(handle, &input, 1, &count) == FALSE) {
/*
* Check to see if the peek failed because of EOF.
*/
Tcl_WinConvertError(GetLastError());
if (errno == EOF) {
infoPtr->readFlags |= CONSOLE_EOF;
return 1;
}
/*
|
| ︙ | ︙ | |||
1473 1474 1475 1476 1477 1478 1479 |
*/
if ((infoPtr->flags & CONSOLE_READ_OPS) && (len > 1) &&
(strncmp(optionName, "-inputmode", len) == 0)) {
DWORD mode;
if (GetConsoleMode(infoPtr->handle, &mode) == 0) {
| | | 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 |
*/
if ((infoPtr->flags & CONSOLE_READ_OPS) && (len > 1) &&
(strncmp(optionName, "-inputmode", len) == 0)) {
DWORD mode;
if (GetConsoleMode(infoPtr->handle, &mode) == 0) {
Tcl_WinConvertError(GetLastError());
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't read console mode: %s",
Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
1505 1506 1507 1508 1509 1510 1511 |
" normal, password, raw, or reset", value));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
"VALUE", NULL);
}
return TCL_ERROR;
}
if (SetConsoleMode(infoPtr->handle, mode) == 0) {
| | | 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 |
" normal, password, raw, or reset", value));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
"VALUE", NULL);
}
return TCL_ERROR;
}
if (SetConsoleMode(infoPtr->handle, mode) == 0) {
Tcl_WinConvertError(GetLastError());
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't set console mode: %s",
Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
1585 1586 1587 1588 1589 1590 1591 |
Tcl_DStringAppendElement(dsPtr, "-inputmode");
}
if (len==0 || (len>1 && strncmp(optionName, "-inputmode", len)==0)) {
DWORD mode;
valid = 1;
if (GetConsoleMode(infoPtr->handle, &mode) == 0) {
| | | 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 |
Tcl_DStringAppendElement(dsPtr, "-inputmode");
}
if (len==0 || (len>1 && strncmp(optionName, "-inputmode", len)==0)) {
DWORD mode;
valid = 1;
if (GetConsoleMode(infoPtr->handle, &mode) == 0) {
Tcl_WinConvertError(GetLastError());
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't read console mode: %s",
Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
1616 1617 1618 1619 1620 1621 1622 |
*/
if ((len > 1) && (strncmp(optionName, "-winsize", len) == 0)) {
CONSOLE_SCREEN_BUFFER_INFO consoleInfo;
valid = 1;
if (!GetConsoleScreenBufferInfo(infoPtr->handle, &consoleInfo)) {
| | | 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 |
*/
if ((len > 1) && (strncmp(optionName, "-winsize", len) == 0)) {
CONSOLE_SCREEN_BUFFER_INFO consoleInfo;
valid = 1;
if (!GetConsoleScreenBufferInfo(infoPtr->handle, &consoleInfo)) {
Tcl_WinConvertError(GetLastError());
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't read console size: %s",
Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
|
| ︙ | ︙ |
Changes to win/tclWinError.c.
| ︙ | ︙ | |||
330 331 332 333 334 335 336 |
ESTALE, /* WSAESTALE */
EREMOTE /* WSAEREMOTE */
};
/*
*----------------------------------------------------------------------
*
| | | | | 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 |
ESTALE, /* WSAESTALE */
EREMOTE /* WSAEREMOTE */
};
/*
*----------------------------------------------------------------------
*
* Tcl_WinConvertError --
*
* This routine converts a Win32 error into an errno value.
*
* Results:
* None.
*
* Side effects:
* Sets the errno global variable.
*
*----------------------------------------------------------------------
*/
void
Tcl_WinConvertError(
unsigned errCode) /* Win32 error code. */
{
if (errCode >= sizeof(errorTable)/sizeof(errorTable[0])) {
errCode -= WSAEWOULDBLOCK;
if (errCode >= sizeof(wsaErrorTable)/sizeof(wsaErrorTable[0])) {
Tcl_SetErrno(errorTable[1]);
} else {
Tcl_SetErrno(wsaErrorTable[errCode]);
|
| ︙ | ︙ |
Changes to win/tclWinFCmd.c.
| ︙ | ︙ | |||
275 276 277 278 279 280 281 |
#endif
#endif
if (retval != -1) {
return retval;
}
| | | 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 |
#endif
#endif
if (retval != -1) {
return retval;
}
Tcl_WinConvertError(GetLastError());
srcAttr = GetFileAttributesW(nativeSrc);
dstAttr = GetFileAttributesW(nativeDst);
if (srcAttr == 0xFFFFFFFF) {
if (GetFullPathNameW(nativeSrc, 0, NULL,
NULL) >= MAX_PATH) {
errno = ENAMETOOLONG;
|
| ︙ | ︙ | |||
416 417 418 419 420 421 422 | } /* * Some new error has occurred. Don't know what it could * be, but report this one. */ | | | 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 |
}
/*
* Some new error has occurred. Don't know what it could
* be, but report this one.
*/
Tcl_WinConvertError(GetLastError());
CreateDirectoryW(nativeDst, NULL);
SetFileAttributesW(nativeDst, dstAttr);
if (Tcl_GetErrno() == EACCES) {
/*
* Decode the EACCES to a more meaningful error.
*/
|
| ︙ | ︙ | |||
484 485 486 487 488 489 490 | } /* * Can't backup dst file or move src file. Return that * error. Could happen if an open file refers to dst. */ | | | 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 |
}
/*
* Can't backup dst file or move src file. Return that
* error. Could happen if an open file refers to dst.
*/
Tcl_WinConvertError(GetLastError());
if (Tcl_GetErrno() == EACCES) {
/*
* Decode the EACCES to a more meaningful error.
*/
goto decode;
}
|
| ︙ | ︙ | |||
665 666 667 668 669 670 671 |
#endif
#endif
if (retval != -1) {
return retval;
}
| | | 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 |
#endif
#endif
if (retval != -1) {
return retval;
}
Tcl_WinConvertError(GetLastError());
if (Tcl_GetErrno() == EBADF) {
Tcl_SetErrno(EACCES);
return TCL_ERROR;
}
if (Tcl_GetErrno() == EACCES) {
DWORD srcAttr, dstAttr;
|
| ︙ | ︙ | |||
702 703 704 705 706 707 708 | } /* * Still can't copy onto dst. Return that error, and restore * attributes of dst. */ | | | 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 |
}
/*
* Still can't copy onto dst. Return that error, and restore
* attributes of dst.
*/
Tcl_WinConvertError(GetLastError());
SetFileAttributesW(nativeDst, dstAttr);
}
}
}
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
762 763 764 765 766 767 768 |
Tcl_SetErrno(ENOENT);
return TCL_ERROR;
}
if (DeleteFileW(path) != FALSE) {
return TCL_OK;
}
| | | 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 |
Tcl_SetErrno(ENOENT);
return TCL_ERROR;
}
if (DeleteFileW(path) != FALSE) {
return TCL_OK;
}
Tcl_WinConvertError(GetLastError());
if (Tcl_GetErrno() == EACCES) {
attr = GetFileAttributesW(path);
if (attr != 0xFFFFFFFF) {
if (attr & FILE_ATTRIBUTE_DIRECTORY) {
if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
/*
|
| ︙ | ︙ | |||
793 794 795 796 797 798 799 |
int res = SetFileAttributesW(path,
attr & ~((DWORD) FILE_ATTRIBUTE_READONLY));
if ((res != 0) &&
(DeleteFileW(path) != FALSE)) {
return TCL_OK;
}
| | | 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 |
int res = SetFileAttributesW(path,
attr & ~((DWORD) FILE_ATTRIBUTE_READONLY));
if ((res != 0) &&
(DeleteFileW(path) != FALSE)) {
return TCL_OK;
}
Tcl_WinConvertError(GetLastError());
if (res != 0) {
SetFileAttributesW(path, attr);
}
}
}
} else if (Tcl_GetErrno() == ENOENT) {
attr = GetFileAttributesW(path);
|
| ︙ | ︙ | |||
862 863 864 865 866 867 868 |
static int
DoCreateDirectory(
const WCHAR *nativePath) /* Pathname of directory to create (native). */
{
if (CreateDirectoryW(nativePath, NULL) == 0) {
DWORD error = GetLastError();
| | | 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 |
static int
DoCreateDirectory(
const WCHAR *nativePath) /* Pathname of directory to create (native). */
{
if (CreateDirectoryW(nativePath, NULL) == 0) {
DWORD error = GetLastError();
Tcl_WinConvertError(error);
return TCL_ERROR;
}
return TCL_OK;
}
/*
*---------------------------------------------------------------------------
|
| ︙ | ︙ | |||
1050 1051 1052 1053 1054 1055 1056 |
*/
if (RemoveDirectoryW(nativePath) != FALSE) {
return TCL_OK;
}
}
| | | 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 |
*/
if (RemoveDirectoryW(nativePath) != FALSE) {
return TCL_OK;
}
}
Tcl_WinConvertError(GetLastError());
if (Tcl_GetErrno() == EACCES) {
attr = GetFileAttributesW(nativePath);
if (attr != 0xFFFFFFFF) {
if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
/*
* Windows 95 reports calling RemoveDirectory on a file as an
|
| ︙ | ︙ | |||
1084 1085 1086 1087 1088 1089 1090 |
if (SetFileAttributesW(nativePath,
attr) == FALSE) {
goto end;
}
if (RemoveDirectoryW(nativePath) != FALSE) {
return TCL_OK;
}
| | | 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 |
if (SetFileAttributesW(nativePath,
attr) == FALSE) {
goto end;
}
if (RemoveDirectoryW(nativePath) != FALSE) {
return TCL_OK;
}
Tcl_WinConvertError(GetLastError());
SetFileAttributesW(nativePath,
attr | FILE_ATTRIBUTE_READONLY);
}
}
}
if (Tcl_GetErrno() == ENOTEMPTY) {
|
| ︙ | ︙ | |||
1231 1232 1233 1234 1235 1236 1237 |
nativeSource = (WCHAR *) Tcl_DStringValue(sourcePtr);
handle = FindFirstFileW(nativeSource, &data);
if (handle == INVALID_HANDLE_VALUE) {
/*
* Can't read directory.
*/
| | | 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 |
nativeSource = (WCHAR *) Tcl_DStringValue(sourcePtr);
handle = FindFirstFileW(nativeSource, &data);
if (handle == INVALID_HANDLE_VALUE) {
/*
* Can't read directory.
*/
Tcl_WinConvertError(GetLastError());
nativeErrfile = nativeSource;
goto end;
}
Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1);
Tcl_DStringSetLength(sourcePtr, oldSourceLen);
result = traverseProc(nativeSource, nativeTarget, DOTREE_PRED,
|
| ︙ | ︙ | |||
1325 1326 1327 1328 1329 1330 1331 |
result = traverseProc((const WCHAR *)Tcl_DStringValue(sourcePtr),
(const WCHAR *)(targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)),
DOTREE_POSTD, errorPtr);
}
end:
if (nativeErrfile != NULL) {
| | | 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 |
result = traverseProc((const WCHAR *)Tcl_DStringValue(sourcePtr),
(const WCHAR *)(targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)),
DOTREE_POSTD, errorPtr);
}
end:
if (nativeErrfile != NULL) {
Tcl_WinConvertError(GetLastError());
if (errorPtr != NULL) {
Tcl_DStringInit(errorPtr);
Tcl_WCharToUtfDString(nativeErrfile, -1, errorPtr);
}
result = TCL_ERROR;
}
|
| ︙ | ︙ | |||
1380 1381 1382 1383 1384 1385 1386 |
if (DoCreateDirectory(nativeDst) == TCL_OK) {
DWORD attr = GetFileAttributesW(nativeSrc);
if (SetFileAttributesW(nativeDst,
attr) != FALSE) {
return TCL_OK;
}
| | | 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 |
if (DoCreateDirectory(nativeDst) == TCL_OK) {
DWORD attr = GetFileAttributesW(nativeSrc);
if (SetFileAttributesW(nativeDst,
attr) != FALSE) {
return TCL_OK;
}
Tcl_WinConvertError(GetLastError());
}
break;
case DOTREE_POSTD:
return TCL_OK;
}
/*
|
| ︙ | ︙ | |||
1478 1479 1480 1481 1482 1483 1484 |
static void
StatError(
Tcl_Interp *interp, /* The interp that has the error */
Tcl_Obj *fileName) /* The name of the file which caused the
* error. */
{
| | | 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 |
static void
StatError(
Tcl_Interp *interp, /* The interp that has the error */
Tcl_Obj *fileName) /* The name of the file which caused the
* error. */
{
Tcl_WinConvertError(GetLastError());
Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s",
TclGetString(fileName), Tcl_PosixError(interp)));
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
2063 2064 2065 2066 2067 2068 2069 |
/*
* Check for other errors. The big ones are ERROR_PATH_NOT_FOUND and
* ERROR_ACCESS_DENIED.
*/
if (error != ERROR_SUCCESS) {
| | | 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 |
/*
* Check for other errors. The big ones are ERROR_PATH_NOT_FOUND and
* ERROR_ACCESS_DENIED.
*/
if (error != ERROR_SUCCESS) {
Tcl_WinConvertError(error);
Tcl_DStringFree(&base);
return NULL;
}
/*
* We actually made the directory, so we're done! Report what we made back
* as a (clean) Tcl_Obj.
|
| ︙ | ︙ |
Changes to win/tclWinFile.c.
| ︙ | ︙ | |||
205 206 207 208 209 210 211 |
if (!GetFullPathNameW(linkTargetPath, MAX_PATH, tempFileName,
&tempFilePart)) {
/*
* Invalid file.
*/
| | | 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 |
if (!GetFullPathNameW(linkTargetPath, MAX_PATH, tempFileName,
&tempFilePart)) {
/*
* Invalid file.
*/
Tcl_WinConvertError(GetLastError());
return -1;
}
/*
* Make sure source file doesn't exist.
*/
|
| ︙ | ︙ | |||
229 230 231 232 233 234 235 |
if (!GetFullPathNameW(linkSourcePath, MAX_PATH, tempFileName,
&tempFilePart)) {
/*
* Invalid file.
*/
| | | | | | 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 |
if (!GetFullPathNameW(linkSourcePath, MAX_PATH, tempFileName,
&tempFilePart)) {
/*
* Invalid file.
*/
Tcl_WinConvertError(GetLastError());
return -1;
}
/*
* Check the target.
*/
attr = GetFileAttributesW(linkTargetPath);
if (attr == INVALID_FILE_ATTRIBUTES) {
/*
* The target doesn't exist.
*/
Tcl_WinConvertError(GetLastError());
} else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
/*
* It is a file.
*/
if (linkAction & TCL_CREATE_HARD_LINK) {
if (CreateHardLinkW(linkSourcePath, linkTargetPath, NULL)) {
/*
* Success!
*/
return 0;
}
Tcl_WinConvertError(GetLastError());
} else if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
if (CreateSymbolicLinkW(linkSourcePath, linkTargetPath,
0x2 /* SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE */)) {
/*
* Success!
*/
return 0;
} else {
Tcl_WinConvertError(GetLastError());
}
} else {
Tcl_SetErrno(ENODEV);
}
} else {
/*
* We've got a directory. Now check whether what we're trying to do is
|
| ︙ | ︙ | |||
323 324 325 326 327 328 329 |
if (!GetFullPathNameW(linkSourcePath, MAX_PATH, tempFileName,
&tempFilePart)) {
/*
* Invalid file.
*/
| | | | 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 |
if (!GetFullPathNameW(linkSourcePath, MAX_PATH, tempFileName,
&tempFilePart)) {
/*
* Invalid file.
*/
Tcl_WinConvertError(GetLastError());
return NULL;
}
/*
* Make sure source file does exist.
*/
attr = GetFileAttributesW(linkSourcePath);
if (attr == INVALID_FILE_ATTRIBUTES) {
/*
* The source doesn't exist.
*/
Tcl_WinConvertError(GetLastError());
return NULL;
} else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
/*
* It is a file - this is not yet supported.
*/
|
| ︙ | ︙ | |||
498 499 500 501 502 503 504 |
if (hFile != INVALID_HANDLE_VALUE) {
if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer,
REPARSE_MOUNTPOINT_HEADER_SIZE,NULL,0,&returnedLength,NULL)) {
/*
* Error setting junction.
*/
| | | 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 |
if (hFile != INVALID_HANDLE_VALUE) {
if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer,
REPARSE_MOUNTPOINT_HEADER_SIZE,NULL,0,&returnedLength,NULL)) {
/*
* Error setting junction.
*/
Tcl_WinConvertError(GetLastError());
CloseHandle(hFile);
} else {
CloseHandle(hFile);
if (!linkOnly) {
RemoveDirectoryW(linkOrigPath);
}
return 0;
|
| ︙ | ︙ | |||
691 692 693 694 695 696 697 |
FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL);
if (hFile == INVALID_HANDLE_VALUE) {
/*
* Error creating directory.
*/
| | | | 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 |
FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL);
if (hFile == INVALID_HANDLE_VALUE) {
/*
* Error creating directory.
*/
Tcl_WinConvertError(GetLastError());
return -1;
}
/*
* Get the link.
*/
if (!DeviceIoControl(hFile, FSCTL_GET_REPARSE_POINT, NULL, 0, buffer,
sizeof(DUMMY_REPARSE_BUFFER), &returnedLength, NULL)) {
/*
* Error setting junction.
*/
Tcl_WinConvertError(GetLastError());
CloseHandle(hFile);
return -1;
}
CloseHandle(hFile);
if (!IsReparseTagValid(buffer->ReparseTag)) {
Tcl_SetErrno(EINVAL);
|
| ︙ | ︙ | |||
747 748 749 750 751 752 753 |
*/
if (CreateDirectoryW(linkDirPath, NULL) == 0) {
/*
* Error creating directory.
*/
| | | | | 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 |
*/
if (CreateDirectoryW(linkDirPath, NULL) == 0) {
/*
* Error creating directory.
*/
Tcl_WinConvertError(GetLastError());
return -1;
}
hFile = CreateFileW(linkDirPath, GENERIC_WRITE, 0, NULL,
OPEN_EXISTING, FILE_FLAG_OPEN_REPARSE_POINT
| FILE_FLAG_BACKUP_SEMANTICS, NULL);
if (hFile == INVALID_HANDLE_VALUE) {
/*
* Error creating directory.
*/
Tcl_WinConvertError(GetLastError());
return -1;
}
/*
* Set the link.
*/
if (!DeviceIoControl(hFile, FSCTL_SET_REPARSE_POINT, buffer,
(DWORD) buffer->ReparseDataLength + REPARSE_MOUNTPOINT_HEADER_SIZE,
NULL, 0, &returnedLength, NULL)) {
/*
* Error setting junction.
*/
Tcl_WinConvertError(GetLastError());
CloseHandle(hFile);
RemoveDirectoryW(linkDirPath);
return -1;
}
CloseHandle(hFile);
/*
|
| ︙ | ︙ | |||
1053 1054 1055 1056 1057 1058 1059 | * means we just return TCL_OK, indicating no results found. */ Tcl_DStringFree(&dsOrig); return TCL_OK; } | | | 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 |
* means we just return TCL_OK, indicating no results found.
*/
Tcl_DStringFree(&dsOrig);
return TCL_OK;
}
Tcl_WinConvertError(err);
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't read directory \"%s\": %s",
Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp)));
}
Tcl_DStringFree(&dsOrig);
return TCL_ERROR;
|
| ︙ | ︙ | |||
1602 1603 1604 1605 1606 1607 1608 |
if (attr == INVALID_FILE_ATTRIBUTES) {
/*
* File might not exist.
*/
DWORD lasterror = GetLastError();
if (lasterror != ERROR_SHARING_VIOLATION) {
| | | 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 |
if (attr == INVALID_FILE_ATTRIBUTES) {
/*
* File might not exist.
*/
DWORD lasterror = GetLastError();
if (lasterror != ERROR_SHARING_VIOLATION) {
Tcl_WinConvertError(lasterror);
return -1;
}
}
if (mode == F_OK) {
/*
* File exists, nothing else to check.
|
| ︙ | ︙ | |||
1728 1729 1730 1731 1732 1733 1734 |
error = GetLastError();
if (error != ERROR_INSUFFICIENT_BUFFER) {
/*
* Most likely case is ERROR_ACCESS_DENIED, which we will convert
* to EACCES - just what we want!
*/
| | | 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 |
error = GetLastError();
if (error != ERROR_INSUFFICIENT_BUFFER) {
/*
* Most likely case is ERROR_ACCESS_DENIED, which we will convert
* to EACCES - just what we want!
*/
Tcl_WinConvertError((DWORD) error);
return -1;
}
/*
* Now size contains the size of buffer needed.
*/
|
| ︙ | ︙ | |||
1833 1834 1835 1836 1837 1838 1839 |
&genMap, &privSet, &privSetSize, &grantedAccess,
&accessYesNo)) {
/*
* Unable to perform access check.
*/
accessError:
| | | 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 |
&genMap, &privSet, &privSetSize, &grantedAccess,
&accessYesNo)) {
/*
* Unable to perform access check.
*/
accessError:
Tcl_WinConvertError(GetLastError());
if (sdPtr != NULL) {
HeapFree(GetProcessHeap(), 0, sdPtr);
}
if (hToken != NULL) {
CloseHandle(hToken);
}
return -1;
|
| ︙ | ︙ | |||
1890 1891 1892 1893 1894 1895 1896 |
return 0;
}
path += len-3;
if ((_wcsicmp(path, L"exe") == 0)
|| (_wcsicmp(path, L"com") == 0)
|| (_wcsicmp(path, L"cmd") == 0)
| < | 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 |
return 0;
}
path += len-3;
if ((_wcsicmp(path, L"exe") == 0)
|| (_wcsicmp(path, L"com") == 0)
|| (_wcsicmp(path, L"cmd") == 0)
|| (_wcsicmp(path, L"bat") == 0)) {
return 1;
}
return 0;
}
/*
|
| ︙ | ︙ | |||
1928 1929 1930 1931 1932 1933 1934 |
if (!nativePath) {
return -1;
}
result = SetCurrentDirectoryW(nativePath);
if (result == 0) {
| | | 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 |
if (!nativePath) {
return -1;
}
result = SetCurrentDirectoryW(nativePath);
if (result == 0) {
Tcl_WinConvertError(GetLastError());
return -1;
}
return 0;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
1967 1968 1969 1970 1971 1972 1973 |
* name of current directory. */
{
WCHAR buffer[MAX_PATH];
char *p;
WCHAR *native;
if (GetCurrentDirectoryW(MAX_PATH, buffer) == 0) {
| | | 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 |
* name of current directory. */
{
WCHAR buffer[MAX_PATH];
char *p;
WCHAR *native;
if (GetCurrentDirectoryW(MAX_PATH, buffer) == 0) {
Tcl_WinConvertError(GetLastError());
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"error getting working directory name: %s",
Tcl_PosixError(interp)));
}
return NULL;
}
|
| ︙ | ︙ | |||
2132 2133 2134 2135 2136 2137 2138 |
if (GetFileAttributesExW(nativePath,
GetFileExInfoStandard, &data) != TRUE) {
HANDLE hFind;
WIN32_FIND_DATAW ffd;
DWORD lasterror = GetLastError();
if (lasterror != ERROR_SHARING_VIOLATION) {
| | | | 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 |
if (GetFileAttributesExW(nativePath,
GetFileExInfoStandard, &data) != TRUE) {
HANDLE hFind;
WIN32_FIND_DATAW ffd;
DWORD lasterror = GetLastError();
if (lasterror != ERROR_SHARING_VIOLATION) {
Tcl_WinConvertError(lasterror);
return -1;
}
hFind = FindFirstFileW(nativePath, &ffd);
if (hFind == INVALID_HANDLE_VALUE) {
Tcl_WinConvertError(GetLastError());
return -1;
}
memcpy(&data, &ffd, sizeof(data));
FindClose(hFind);
}
attr = data.dwFileAttributes;
|
| ︙ | ︙ | |||
2366 2367 2368 2369 2370 2371 2372 |
ClientData
TclpGetNativeCwd(
ClientData clientData)
{
WCHAR buffer[MAX_PATH];
if (GetCurrentDirectoryW(MAX_PATH, buffer) == 0) {
| | | 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 |
ClientData
TclpGetNativeCwd(
ClientData clientData)
{
WCHAR buffer[MAX_PATH];
if (GetCurrentDirectoryW(MAX_PATH, buffer) == 0) {
Tcl_WinConvertError(GetLastError());
return NULL;
}
if (clientData != NULL) {
if (wcscmp((const WCHAR *) clientData, buffer) == 0) {
return clientData;
}
|
| ︙ | ︙ | |||
3137 3138 3139 3140 3141 3142 3143 |
wp += 4;
}
/*
* If there is no "\\?\" prefix but there is a drive or UNC path prefix
* and the path is larger than MAX_PATH chars, no Win32 API function can
* handle that unless it is prefixed with the extended path prefix. See:
| | | 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 |
wp += 4;
}
/*
* If there is no "\\?\" prefix but there is a drive or UNC path prefix
* and the path is larger than MAX_PATH chars, no Win32 API function can
* handle that unless it is prefixed with the extended path prefix. See:
* <https://docs.microsoft.com/en-us/windows/win32/fileio/naming-a-file#maxpath>
*/
if (((str[0] >= 'A' && str[0] <= 'Z') || (str[0] >= 'a' && str[0] <= 'z'))
&& str[1] == ':') {
if (wp == nativePathPtr && len > MAX_PATH
&& (str[2] == '\\' || str[2] == '/')) {
memmove(wp + 4, wp, len * sizeof(WCHAR));
|
| ︙ | ︙ | |||
3267 3268 3269 3270 3271 3272 3273 |
*/
fileHandle = CreateFileW(native, FILE_WRITE_ATTRIBUTES, 0, NULL,
OPEN_EXISTING, flags, NULL);
if (fileHandle == INVALID_HANDLE_VALUE ||
!SetFileTime(fileHandle, NULL, &lastAccessTime, &lastModTime)) {
| | | 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 |
*/
fileHandle = CreateFileW(native, FILE_WRITE_ATTRIBUTES, 0, NULL,
OPEN_EXISTING, flags, NULL);
if (fileHandle == INVALID_HANDLE_VALUE ||
!SetFileTime(fileHandle, NULL, &lastAccessTime, &lastModTime)) {
Tcl_WinConvertError(GetLastError());
res = -1;
}
if (fileHandle != INVALID_HANDLE_VALUE) {
CloseHandle(fileHandle);
}
return res;
}
|
| ︙ | ︙ |
Changes to win/tclWinInit.c.
| ︙ | ︙ | |||
30 31 32 33 34 35 36 |
* access the interesting slots in a uniform way.
*/
typedef struct {
WORD wProcessorArchitecture;
WORD wReserved;
} OemId;
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 30 31 32 33 34 35 36 37 38 39 40 41 42 43 |
* access the interesting slots in a uniform way.
*/
typedef struct {
WORD wProcessorArchitecture;
WORD wReserved;
} OemId;
/*
* The following arrays contain the human readable strings for the
* processor values.
*/
#define NUMPROCESSORS 15
|
| ︙ | ︙ | |||
531 532 533 534 535 536 537 |
Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
if (sys.oemId.wProcessorArchitecture < NUMPROCESSORS) {
Tcl_SetVar2(interp, "tcl_platform", "machine",
processors[sys.oemId.wProcessorArchitecture],
TCL_GLOBAL_ONLY);
}
| > | | 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 |
Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
if (sys.oemId.wProcessorArchitecture < NUMPROCESSORS) {
Tcl_SetVar2(interp, "tcl_platform", "machine",
processors[sys.oemId.wProcessorArchitecture],
TCL_GLOBAL_ONLY);
}
#if !defined(NDEBUG) && !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/*
* The existence of the "debug" element of the tcl_platform array
* indicates that this particular Tcl shell has been compiled with debug
* information. Using "info exists tcl_platform(debug)" a Tcl script can
* direct the interpreter to load debug versions of DLLs with the load
* command.
*/
|
| ︙ | ︙ |
Changes to win/tclWinLoad.c.
| ︙ | ︙ | |||
16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | /* * 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 * allocation. */ static WCHAR *dllDirectoryName = NULL; static Tcl_Mutex dllDirectoryNameMutex; /* * Static functions defined within this file. */ static void * FindSymbol(Tcl_Interp *interp, Tcl_LoadHandle loadHandle, const char *symbol); | > > | 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 | /* * 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 * allocation. */ static WCHAR *dllDirectoryName = NULL; #if TCL_THREADS static Tcl_Mutex dllDirectoryNameMutex; #endif /* * Static functions defined within this file. */ static void * FindSymbol(Tcl_Interp *interp, Tcl_LoadHandle loadHandle, const char *symbol); |
| ︙ | ︙ | |||
155 156 157 158 159 160 161 |
" routine failed", -1);
break;
case ERROR_BAD_EXE_FORMAT:
Tcl_SetErrorCode(interp, "WIN_LOAD", "BAD_EXE_FORMAT", NULL);
Tcl_AppendToObj(errMsg, "Bad exe format. Possibly a 32/64-bit mismatch.", -1);
break;
default:
| | | 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 |
" routine failed", -1);
break;
case ERROR_BAD_EXE_FORMAT:
Tcl_SetErrorCode(interp, "WIN_LOAD", "BAD_EXE_FORMAT", NULL);
Tcl_AppendToObj(errMsg, "Bad exe format. Possibly a 32/64-bit mismatch.", -1);
break;
default:
Tcl_WinConvertError(lastError);
Tcl_AppendToObj(errMsg, Tcl_PosixError(interp), -1);
}
Tcl_SetObjResult(interp, errMsg);
}
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
375 376 377 378 379 380 381 |
lastError = GetLastError();
if (lastError != ERROR_ALREADY_EXISTS) {
break;
}
id *= 16777619;
}
| | | 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 |
lastError = GetLastError();
if (lastError != ERROR_ALREADY_EXISTS) {
break;
}
id *= 16777619;
}
Tcl_WinConvertError(lastError);
return TCL_ERROR;
/*
* Store our computed value in the global.
*/
copyToGlobalBuffer:
|
| ︙ | ︙ |
Changes to win/tclWinNotify.c.
| ︙ | ︙ | |||
73 74 75 76 77 78 79 | * Side effects: * None. * *---------------------------------------------------------------------- */ ClientData | | < < < | | | | | | | | | | | | | | | | | | | | | | | | | > | | | | | | | | | | | | | < | | < < < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < | | < < < < | | | | | | | | | | | | | | | | | | | | | < | | < < < < | | | | | | | | | | | | | | | | | | | | | | > | | | < | | | | | | < | | < < < < | | | | | | | | < | | | | < | | | | | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
ClientData
TclpInitNotifier(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
TclpGlobalLock();
if (!initialized) {
initialized = 1;
InitializeCriticalSection(¬ifierMutex);
}
TclpGlobalUnlock();
/*
* Register Notifier window class if this is the first thread to use this
* module.
*/
EnterCriticalSection(¬ifierMutex);
if (notifierCount == 0) {
WNDCLASSW clazz;
clazz.style = 0;
clazz.cbClsExtra = 0;
clazz.cbWndExtra = 0;
clazz.hInstance = TclWinGetTclInstance();
clazz.hbrBackground = NULL;
clazz.lpszMenuName = NULL;
clazz.lpszClassName = className;
clazz.lpfnWndProc = NotifierProc;
clazz.hIcon = NULL;
clazz.hCursor = NULL;
if (!RegisterClassW(&clazz)) {
Tcl_Panic("Tcl_InitNotifier: %s",
"unable to register TclNotifier window class");
}
}
notifierCount++;
LeaveCriticalSection(¬ifierMutex);
tsdPtr->pending = 0;
tsdPtr->timerActive = 0;
InitializeCriticalSection(&tsdPtr->crit);
tsdPtr->hwnd = NULL;
tsdPtr->thread = GetCurrentThreadId();
tsdPtr->event = CreateEventW(NULL, TRUE /* manual */,
FALSE /* !signaled */, NULL);
return tsdPtr;
}
/*
*----------------------------------------------------------------------
*
* TclpFinalizeNotifier --
*
* This function is called to cleanup the notifier state before a thread
* is terminated.
*
* Results:
* None.
*
* Side effects:
* May dispose of the notifier window and class.
*
*----------------------------------------------------------------------
*/
void
TclpFinalizeNotifier(
ClientData clientData) /* Pointer to notifier data. */
{
ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
/*
* Only finalize the notifier if a notifier was installed in the current
* thread; there is a route in which this is not guaranteed to be true
* (when tclWin32Dll.c:DllMain() is called with the flag
* DLL_PROCESS_DETACH by the OS, which could be doing so from a thread
* that's never previously been involved with Tcl, e.g. the task manager)
* so this check is important.
*
* Fixes Bug #217982 reported by Hugh Vu and Gene Leache.
*/
if (tsdPtr == NULL) {
return;
}
DeleteCriticalSection(&tsdPtr->crit);
CloseHandle(tsdPtr->event);
/*
* Clean up the timer and messaging window for this thread.
*/
if (tsdPtr->hwnd) {
KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
DestroyWindow(tsdPtr->hwnd);
}
/*
* If this is the last thread to use the notifier, unregister the notifier
* window class.
*/
EnterCriticalSection(¬ifierMutex);
if (notifierCount) {
notifierCount--;
if (notifierCount == 0) {
UnregisterClassW(className, TclWinGetTclInstance());
}
}
LeaveCriticalSection(¬ifierMutex);
}
/*
*----------------------------------------------------------------------
*
* TclpAlertNotifier --
*
* Wake up the specified notifier from any thread. This routine is called
* by the platform independent notifier code whenever the Tcl_ThreadAlert
* routine is called. This routine is guaranteed not to be called on a
* given notifier after Tcl_FinalizeNotifier is called for that notifier.
* This routine is typically called from a thread other than the
* notifier's thread.
*
* Results:
* None.
*
* Side effects:
* Sends a message to the messaging window for the notifier if there
* isn't already one pending.
*
*----------------------------------------------------------------------
*/
void
TclpAlertNotifier(
ClientData clientData) /* Pointer to thread data. */
{
ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
/*
* Note that we do not need to lock around access to the hwnd because the
* race condition has no effect since any race condition implies that the
* notifier thread is already awake.
*/
if (tsdPtr->hwnd) {
/*
* We do need to lock around access to the pending flag.
*/
EnterCriticalSection(&tsdPtr->crit);
if (!tsdPtr->pending) {
PostMessageW(tsdPtr->hwnd, WM_WAKEUP, 0, 0);
}
tsdPtr->pending = 1;
LeaveCriticalSection(&tsdPtr->crit);
} else {
SetEvent(tsdPtr->event);
}
}
/*
*----------------------------------------------------------------------
*
* TclpSetTimer --
*
* This procedure sets the current notifier timer value. The notifier
* will ensure that Tcl_ServiceAll() is called after the specified
* interval, even if no events have occurred.
*
* Results:
* None.
*
* Side effects:
* Replaces any previous timer.
*
*----------------------------------------------------------------------
*/
void
TclpSetTimer(
const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
UINT timeout;
/*
* We only need to set up an interval timer if we're being called from an
* external event loop. If we don't have a window handle then we just
* return immediately and let Tcl_WaitForEvent handle timeouts.
*/
if (!tsdPtr->hwnd) {
return;
}
if (!timePtr) {
timeout = 0;
} else {
/*
* Make sure we pass a non-zero value into the timeout argument.
* Windows seems to get confused by zero length timers.
*/
timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
if (timeout == 0) {
timeout = 1;
}
}
if (timeout != 0) {
tsdPtr->timerActive = 1;
SetTimer(tsdPtr->hwnd, INTERVAL_TIMER, timeout, NULL);
} else {
tsdPtr->timerActive = 0;
KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
}
}
/*
*----------------------------------------------------------------------
*
* TclpServiceModeHook --
*
* This function is invoked whenever the service mode changes.
*
* Results:
* None.
*
* Side effects:
* If this is the first time the notifier is set into TCL_SERVICE_ALL,
* then the communication window is created.
*
*----------------------------------------------------------------------
*/
void
TclpServiceModeHook(
int mode) /* Either TCL_SERVICE_ALL, or
* TCL_SERVICE_NONE. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* If this is the first time that the notifier has been used from a modal
* loop, then create a communication window. Note that after this point,
* the application needs to service events in a timely fashion or Windows
* will hang waiting for the window to respond to synchronous system
* messages. At some point, we may want to consider destroying the window
* if we leave the modal loop, but for now we'll leave it around.
*/
if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) {
tsdPtr->hwnd = CreateWindowW(className, className, WS_TILED,
0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL);
/*
* Send an initial message to the window to ensure that we wake up the
* notifier once we get into the modal loop. This will force the
* notifier to recompute the timeout value and schedule a timer if one
* is needed.
*/
Tcl_AlertNotifier(tsdPtr);
}
}
/*
*----------------------------------------------------------------------
*
* TclAsyncNotifier --
*
* This procedure is a no-op on Windows.
*
* Result:
* Always true.
*
* Side effetcs:
* None.
*----------------------------------------------------------------------
*/
int
TclAsyncNotifier(
TCL_UNUSED(int), /* Signal number. */
TCL_UNUSED(Tcl_ThreadId), /* Target thread. */
TCL_UNUSED(void *), /* Notifier data. */
TCL_UNUSED(int *), /* Flag to mark. */
TCL_UNUSED(int)) /* Value of mark. */
{
return 0;
}
/*
*----------------------------------------------------------------------
*
* NotifierProc --
*
|
| ︙ | ︙ | |||
417 418 419 420 421 422 423 |
Tcl_ServiceAll();
return 0;
}
/*
*----------------------------------------------------------------------
*
| > > > > > > > > > > > > > > > > > > > > > > > | | < < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < | 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 |
Tcl_ServiceAll();
return 0;
}
/*
*----------------------------------------------------------------------
*
* TclpNotifierData --
*
* This function returns a ClientData pointer to be associated
* with a Tcl_AsyncHandler.
*
* Results:
* On Windows, returns always NULL.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
ClientData
TclpNotifierData(void)
{
return NULL;
}
/*
*----------------------------------------------------------------------
*
* TclpWaitForEvent --
*
* This function is called by Tcl_DoOneEvent to wait for new events on
* the message queue. If the block time is 0, then Tcl_WaitForEvent just
* polls the event queue without blocking.
*
* Results:
* Returns -1 if a WM_QUIT message is detected, returns 1 if a message
* was dispatched, otherwise returns 0.
*
* Side effects:
* Dispatches a message to a window procedure, which could do anything.
*
*----------------------------------------------------------------------
*/
int
TclpWaitForEvent(
const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
MSG msg;
DWORD timeout, result;
int status;
/*
* Compute the timeout in milliseconds.
*/
if (timePtr) {
/*
* TIP #233 (Virtualized Time). Convert virtual domain delay to
* real-time.
*/
Tcl_Time myTime;
myTime.sec = timePtr->sec;
myTime.usec = timePtr->usec;
if (myTime.sec != 0 || myTime.usec != 0) {
TclScaleTime(&myTime);
}
timeout = myTime.sec * 1000 + myTime.usec / 1000;
} else {
timeout = INFINITE;
}
/*
* Check to see if there are any messages in the queue before waiting
* because MsgWaitForMultipleObjects will not wake up if there are events
* currently sitting in the queue.
*/
if (!PeekMessageW(&msg, NULL, 0, 0, PM_NOREMOVE)) {
/*
* Wait for something to happen (a signal from another thread, a
* message, or timeout) or loop servicing asynchronous procedure calls
* queued to this thread.
*/
do {
result = MsgWaitForMultipleObjectsEx(1, &tsdPtr->event, timeout,
QS_ALLINPUT, MWMO_ALERTABLE);
} while (result == WAIT_IO_COMPLETION);
if (result == WAIT_FAILED) {
status = -1;
goto end;
}
}
/*
* Check to see if there are any messages to process.
*/
if (PeekMessageW(&msg, NULL, 0, 0, PM_NOREMOVE)) {
/*
* Retrieve and dispatch the first message.
*/
result = GetMessageW(&msg, NULL, 0, 0);
if (result == 0) {
/*
* We received a request to exit this thread (WM_QUIT), so
* propagate the quit message and start unwinding.
*/
PostQuitMessage((int) msg.wParam);
status = -1;
} else if (result == (DWORD) -1) {
/*
* We got an error from the system. I have no idea why this would
* happen, so we'll just unwind.
*/
status = -1;
} else {
TranslateMessage(&msg);
DispatchMessageW(&msg);
status = 1;
}
} else {
status = 0;
}
end:
ResetEvent(tsdPtr->event);
return status;
}
/*
*----------------------------------------------------------------------
*
* Tcl_Sleep --
*
|
| ︙ | ︙ | |||
584 585 586 587 588 589 590 |
desired.usec -= 1000000;
}
/*
* TIP #233: Scale delay from virtual to real-time.
*/
| | | | 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 |
desired.usec -= 1000000;
}
/*
* TIP #233: Scale delay from virtual to real-time.
*/
TclScaleTime(&vdelay);
sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000;
for (;;) {
SleepEx(sleepTime, TRUE);
Tcl_GetTime(&now);
if (now.sec > desired.sec) {
break;
} else if ((now.sec == desired.sec) && (now.usec >= desired.usec)) {
break;
}
vdelay.sec = desired.sec - now.sec;
vdelay.usec = desired.usec - now.usec;
TclScaleTime(&vdelay);
sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000;
}
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Changes to win/tclWinPipe.c.
| ︙ | ︙ | |||
545 546 547 548 549 550 551 |
case O_WRONLY:
accessMode = GENERIC_WRITE;
break;
case O_RDWR:
accessMode = (GENERIC_READ | GENERIC_WRITE);
break;
default:
| | | 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 |
case O_WRONLY:
accessMode = GENERIC_WRITE;
break;
case O_RDWR:
accessMode = (GENERIC_READ | GENERIC_WRITE);
break;
default:
Tcl_WinConvertError(ERROR_INVALID_FUNCTION);
return NULL;
}
/*
* Map the creation flags to the NT create mode.
*/
|
| ︙ | ︙ | |||
609 610 611 612 613 614 615 |
if (handle == INVALID_HANDLE_VALUE) {
DWORD err;
err = GetLastError();
if ((err & 0xFFFFL) == ERROR_OPEN_FAILED) {
err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
}
| | | 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 |
if (handle == INVALID_HANDLE_VALUE) {
DWORD err;
err = GetLastError();
if ((err & 0xFFFFL) == ERROR_OPEN_FAILED) {
err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
}
Tcl_WinConvertError(err);
return NULL;
}
/*
* Seek to the end of file if we are writing.
*/
|
| ︙ | ︙ | |||
715 716 717 718 719 720 721 |
* Free the native representation of the contents if necessary.
*/
if (contents != NULL) {
Tcl_DStringFree(&dstring);
}
| | | 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 |
* Free the native representation of the contents if necessary.
*/
if (contents != NULL) {
Tcl_DStringFree(&dstring);
}
Tcl_WinConvertError(GetLastError());
CloseHandle(handle);
DeleteFileW(name);
return NULL;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
780 781 782 783 784 785 786 |
if (CreatePipe(&readHandle, &writeHandle, NULL, 0) != 0) {
*readPipe = TclWinMakeFile(readHandle);
*writePipe = TclWinMakeFile(writeHandle);
return 1;
}
| | | 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 |
if (CreatePipe(&readHandle, &writeHandle, NULL, 0) != 0) {
*readPipe = TclWinMakeFile(readHandle);
*writePipe = TclWinMakeFile(writeHandle);
return 1;
}
Tcl_WinConvertError(GetLastError());
return 0;
}
/*
*----------------------------------------------------------------------
*
* TclpCloseFile --
|
| ︙ | ︙ | |||
821 822 823 824 825 826 827 |
if (!TclInThreadExit()
|| ((GetStdHandle(STD_INPUT_HANDLE) != filePtr->handle)
&& (GetStdHandle(STD_OUTPUT_HANDLE) != filePtr->handle)
&& (GetStdHandle(STD_ERROR_HANDLE) != filePtr->handle))) {
if (filePtr->handle != NULL &&
CloseHandle(filePtr->handle) == FALSE) {
| | | 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 |
if (!TclInThreadExit()
|| ((GetStdHandle(STD_INPUT_HANDLE) != filePtr->handle)
&& (GetStdHandle(STD_OUTPUT_HANDLE) != filePtr->handle)
&& (GetStdHandle(STD_ERROR_HANDLE) != filePtr->handle))) {
if (filePtr->handle != NULL &&
CloseHandle(filePtr->handle) == FALSE) {
Tcl_WinConvertError(GetLastError());
ckfree(filePtr);
return -1;
}
}
break;
default:
|
| ︙ | ︙ | |||
1022 1023 1024 1025 1026 1027 1028 |
CloseHandle(h);
}
} else {
DuplicateHandle(hProcess, inputHandle, hProcess, &startInfo.hStdInput,
0, TRUE, DUPLICATE_SAME_ACCESS);
}
if (startInfo.hStdInput == INVALID_HANDLE_VALUE) {
| | | 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 |
CloseHandle(h);
}
} else {
DuplicateHandle(hProcess, inputHandle, hProcess, &startInfo.hStdInput,
0, TRUE, DUPLICATE_SAME_ACCESS);
}
if (startInfo.hStdInput == INVALID_HANDLE_VALUE) {
Tcl_WinConvertError(GetLastError());
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't duplicate input handle: %s",
Tcl_PosixError(interp)));
goto end;
}
if (outputHandle == INVALID_HANDLE_VALUE) {
|
| ︙ | ︙ | |||
1051 1052 1053 1054 1055 1056 1057 |
startInfo.hStdOutput = CreateFileW(L"NUL:", GENERIC_WRITE, 0,
&secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);
} else {
DuplicateHandle(hProcess, outputHandle, hProcess,
&startInfo.hStdOutput, 0, TRUE, DUPLICATE_SAME_ACCESS);
}
if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) {
| | | | 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 |
startInfo.hStdOutput = CreateFileW(L"NUL:", GENERIC_WRITE, 0,
&secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);
} else {
DuplicateHandle(hProcess, outputHandle, hProcess,
&startInfo.hStdOutput, 0, TRUE, DUPLICATE_SAME_ACCESS);
}
if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) {
Tcl_WinConvertError(GetLastError());
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't duplicate output handle: %s",
Tcl_PosixError(interp)));
goto end;
}
if (errorHandle == INVALID_HANDLE_VALUE) {
/*
* If handle was not set, errors should be sent to an infinitely deep
* sink.
*/
startInfo.hStdError = CreateFileW(L"NUL:", GENERIC_WRITE, 0,
&secAtts, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
} else {
DuplicateHandle(hProcess, errorHandle, hProcess, &startInfo.hStdError,
0, TRUE, DUPLICATE_SAME_ACCESS);
}
if (startInfo.hStdError == INVALID_HANDLE_VALUE) {
Tcl_WinConvertError(GetLastError());
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't duplicate error handle: %s",
Tcl_PosixError(interp)));
goto end;
}
/*
|
| ︙ | ︙ | |||
1133 1134 1135 1136 1137 1138 1139 |
*/
BuildCommandLine(execPath, argc, argv, &cmdLine);
if (CreateProcessW(NULL, (WCHAR *) Tcl_DStringValue(&cmdLine),
NULL, NULL, TRUE, (DWORD) createFlags, NULL, NULL, &startInfo,
&procInfo) == 0) {
| | | 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 |
*/
BuildCommandLine(execPath, argc, argv, &cmdLine);
if (CreateProcessW(NULL, (WCHAR *) Tcl_DStringValue(&cmdLine),
NULL, NULL, TRUE, (DWORD) createFlags, NULL, NULL, &startInfo,
&procInfo) == 0) {
Tcl_WinConvertError(GetLastError());
Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s",
argv[0], Tcl_PosixError(interp)));
goto end;
}
/*
* This wait is used to force the OS to give some time to the DOS process.
|
| ︙ | ︙ | |||
1383 1384 1385 1386 1387 1388 1389 |
applType = APPL_DOS;
}
break;
}
Tcl_DStringFree(&nameBuf);
if (applType == APPL_NONE) {
| | | 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 |
applType = APPL_DOS;
}
break;
}
Tcl_DStringFree(&nameBuf);
if (applType == APPL_NONE) {
Tcl_WinConvertError(GetLastError());
Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s",
originalName, Tcl_PosixError(interp)));
return APPL_NONE;
}
if (applType == APPL_WIN3X) {
/*
|
| ︙ | ︙ | |||
1862 1863 1864 1865 1866 1867 1868 |
SECURITY_ATTRIBUTES sec;
sec.nLength = sizeof(SECURITY_ATTRIBUTES);
sec.lpSecurityDescriptor = NULL;
sec.bInheritHandle = FALSE;
if (!CreatePipe(&readHandle, &writeHandle, &sec, 0)) {
| | | 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 |
SECURITY_ATTRIBUTES sec;
sec.nLength = sizeof(SECURITY_ATTRIBUTES);
sec.lpSecurityDescriptor = NULL;
sec.bInheritHandle = FALSE;
if (!CreatePipe(&readHandle, &writeHandle, &sec, 0)) {
Tcl_WinConvertError(GetLastError());
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"pipe creation failed: %s", Tcl_PosixError(interp)));
return TCL_ERROR;
}
*rchan = Tcl_MakeFileChannel((ClientData) readHandle, TCL_READABLE);
Tcl_RegisterChannel(interp, *rchan);
|
| ︙ | ︙ | |||
2220 2221 2222 2223 2224 2225 2226 |
/*
* Ignore errors if we have data to return.
*/
return bytesRead;
}
| | | 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 |
/*
* Ignore errors if we have data to return.
*/
return bytesRead;
}
Tcl_WinConvertError(GetLastError());
if (errno == EPIPE) {
infoPtr->readFlags |= PIPE_EOF;
return 0;
}
*errorCode = errno;
return -1;
}
|
| ︙ | ︙ | |||
2279 2280 2281 2282 2283 2284 2285 |
}
/*
* Check for a background error on the last write.
*/
if (infoPtr->writeError) {
| | | 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 |
}
/*
* Check for a background error on the last write.
*/
if (infoPtr->writeError) {
Tcl_WinConvertError(infoPtr->writeError);
infoPtr->writeError = 0;
goto error;
}
if (infoPtr->flags & PIPE_ASYNC) {
/*
* The pipe is non-blocking, so copy the data into the output buffer
|
| ︙ | ︙ | |||
2314 2315 2316 2317 2318 2319 2320 |
/*
* In the blocking case, just try to write the buffer directly. This
* avoids an unnecessary copy.
*/
if (WriteFile(filePtr->handle, (LPVOID) buf, (DWORD) toWrite,
&bytesWritten, (LPOVERLAPPED) NULL) == FALSE) {
| | | 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 |
/*
* In the blocking case, just try to write the buffer directly. This
* avoids an unnecessary copy.
*/
if (WriteFile(filePtr->handle, (LPVOID) buf, (DWORD) toWrite,
&bytesWritten, (LPOVERLAPPED) NULL) == FALSE) {
Tcl_WinConvertError(GetLastError());
goto error;
}
}
return bytesWritten;
error:
*errorCode = errno;
|
| ︙ | ︙ | |||
2846 2847 2848 2849 2850 2851 2852 |
/*
* Check to see if there is any data sitting in the pipe.
*/
if (PeekNamedPipe(handle, (LPVOID) NULL, (DWORD) 0,
(LPDWORD) NULL, &count, (LPDWORD) NULL) != TRUE) {
| | | 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 |
/*
* Check to see if there is any data sitting in the pipe.
*/
if (PeekNamedPipe(handle, (LPVOID) NULL, (DWORD) 0,
(LPDWORD) NULL, &count, (LPDWORD) NULL) != TRUE) {
Tcl_WinConvertError(GetLastError());
/*
* Check to see if the peek failed because of EOF.
*/
if (errno == EPIPE) {
infoPtr->readFlags |= PIPE_EOF;
|
| ︙ | ︙ | |||
3256 3257 3258 3259 3260 3261 3262 |
TclDecrRefCount(tmpObj);
}
return Tcl_MakeFileChannel((ClientData) handle,
TCL_READABLE|TCL_WRITABLE);
gotError:
| | | 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 |
TclDecrRefCount(tmpObj);
}
return Tcl_MakeFileChannel((ClientData) handle,
TCL_READABLE|TCL_WRITABLE);
gotError:
Tcl_WinConvertError(GetLastError());
return NULL;
}
/*
*----------------------------------------------------------------------
*
* TclPipeThreadCreateTI --
|
| ︙ | ︙ |
Changes to win/tclWinSerial.c.
| ︙ | ︙ | |||
641 642 643 644 645 646 647 |
*/
if (!TclInThreadExit()
|| ((GetStdHandle(STD_INPUT_HANDLE) != serialPtr->handle)
&& (GetStdHandle(STD_OUTPUT_HANDLE) != serialPtr->handle)
&& (GetStdHandle(STD_ERROR_HANDLE) != serialPtr->handle))) {
if (CloseHandle(serialPtr->handle) == FALSE) {
| | | 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 |
*/
if (!TclInThreadExit()
|| ((GetStdHandle(STD_INPUT_HANDLE) != serialPtr->handle)
&& (GetStdHandle(STD_OUTPUT_HANDLE) != serialPtr->handle)
&& (GetStdHandle(STD_ERROR_HANDLE) != serialPtr->handle))) {
if (CloseHandle(serialPtr->handle) == FALSE) {
Tcl_WinConvertError(GetLastError());
errorCode = errno;
}
}
serialPtr->watchMask &= serialPtr->validMask;
/*
|
| ︙ | ︙ | |||
924 925 926 927 928 929 930 |
/*
* Perform blocking read. Doesn't block in non-blocking mode, because we
* checked the number of available bytes.
*/
if (SerialBlockingRead(infoPtr, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
&infoPtr->osRead) == FALSE) {
| | | 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 |
/*
* Perform blocking read. Doesn't block in non-blocking mode, because we
* checked the number of available bytes.
*/
if (SerialBlockingRead(infoPtr, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
&infoPtr->osRead) == FALSE) {
Tcl_WinConvertError(GetLastError());
*errorCode = errno;
return -1;
}
return bytesRead;
commError:
infoPtr->lastError = infoPtr->error;
|
| ︙ | ︙ | |||
1006 1007 1008 1009 1010 1011 1012 |
}
/*
* Check for a background error on the last write.
*/
if (infoPtr->writeError) {
| | | 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 |
}
/*
* Check for a background error on the last write.
*/
if (infoPtr->writeError) {
Tcl_WinConvertError(infoPtr->writeError);
infoPtr->writeError = 0;
goto error1;
}
/*
* Remember the number of bytes in output queue
*/
|
| ︙ | ︙ | |||
1065 1066 1067 1068 1069 1070 1071 |
goto error;
}
}
return (int) bytesWritten;
writeError:
| | | 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 |
goto error;
}
}
return (int) bytesWritten;
writeError:
Tcl_WinConvertError(GetLastError());
error:
/*
* Reset the output queue counter on error during blocking output
*/
/*
|
| ︙ | ︙ | |||
1932 1933 1934 1935 1936 1937 1938 |
Tcl_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", NULL);
}
return TCL_ERROR;
}
if (!SetupComm(infoPtr->handle, inSize, outSize)) {
if (interp != NULL) {
| | | 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 |
Tcl_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", NULL);
}
return TCL_ERROR;
}
if (!SetupComm(infoPtr->handle, inSize, outSize)) {
if (interp != NULL) {
Tcl_WinConvertError(GetLastError());
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't setup comm buffers: %s",
Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
infoPtr->sysBufRead = inSize;
|
| ︙ | ︙ | |||
1983 1984 1985 1986 1987 1988 1989 |
if (Tcl_GetInt(interp, value, &msec) != TCL_OK) {
return TCL_ERROR;
}
tout.ReadTotalTimeoutConstant = msec;
if (!SetCommTimeouts(infoPtr->handle, &tout)) {
if (interp != NULL) {
| | | | | 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 |
if (Tcl_GetInt(interp, value, &msec) != TCL_OK) {
return TCL_ERROR;
}
tout.ReadTotalTimeoutConstant = msec;
if (!SetCommTimeouts(infoPtr->handle, &tout)) {
if (interp != NULL) {
Tcl_WinConvertError(GetLastError());
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't set comm timeouts: %s",
Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
return TCL_OK;
}
return Tcl_BadChannelOption(interp, optionName,
"closemode mode handshake pollinterval sysbuffer timeout "
"ttycontrol xchar");
getStateFailed:
if (interp != NULL) {
Tcl_WinConvertError(GetLastError());
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't get comm state: %s", Tcl_PosixError(interp)));
}
return TCL_ERROR;
setStateFailed:
if (interp != NULL) {
Tcl_WinConvertError(GetLastError());
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't set comm state: %s", Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
/*
|
| ︙ | ︙ | |||
2091 2092 2093 2094 2095 2096 2097 |
if (len==0 || (len>2 && (strncmp(optionName, "-mode", len) == 0))) {
char parity;
const char *stop;
char buf[2 * TCL_INTEGER_SPACE + 16];
if (!GetCommState(infoPtr->handle, &dcb)) {
if (interp != NULL) {
| | | 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 |
if (len==0 || (len>2 && (strncmp(optionName, "-mode", len) == 0))) {
char parity;
const char *stop;
char buf[2 * TCL_INTEGER_SPACE + 16];
if (!GetCommState(infoPtr->handle, &dcb)) {
if (interp != NULL) {
Tcl_WinConvertError(GetLastError());
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't get comm state: %s", Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
valid = 1;
|
| ︙ | ︙ | |||
2161 2162 2163 2164 2165 2166 2167 |
}
if (len==0 || (len>1 && strncmp(optionName, "-xchar", len) == 0)) {
char buf[4];
valid = 1;
if (!GetCommState(infoPtr->handle, &dcb)) {
if (interp != NULL) {
| | | 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 |
}
if (len==0 || (len>1 && strncmp(optionName, "-xchar", len) == 0)) {
char buf[4];
valid = 1;
if (!GetCommState(infoPtr->handle, &dcb)) {
if (interp != NULL) {
Tcl_WinConvertError(GetLastError());
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't get comm state: %s", Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
buf[Tcl_UniCharToUtf(UCHAR(dcb.XonChar), buf)] = '\0';
Tcl_DStringAppendElement(dsPtr, buf);
|
| ︙ | ︙ | |||
2239 2240 2241 2242 2243 2244 2245 |
*/
if (len>4 && strncmp(optionName, "-ttystatus", len)==0) {
DWORD status;
if (!GetCommModemStatus(infoPtr->handle, &status)) {
if (interp != NULL) {
| | | 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 |
*/
if (len>4 && strncmp(optionName, "-ttystatus", len)==0) {
DWORD status;
if (!GetCommModemStatus(infoPtr->handle, &status)) {
if (interp != NULL) {
Tcl_WinConvertError(GetLastError());
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't get tty status: %s", Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
valid = 1;
SerialModemStatusStr(status, dsPtr);
|
| ︙ | ︙ |
Changes to win/tclWinSock.c.
| ︙ | ︙ | |||
878 879 880 881 882 883 884 |
/*
* Check for error condition or underflow in non-blocking case.
*/
if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING)
|| (error != WSAEWOULDBLOCK)) {
| | | 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 |
/*
* Check for error condition or underflow in non-blocking case.
*/
if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING)
|| (error != WSAEWOULDBLOCK)) {
Tcl_WinConvertError(error);
*errorCodePtr = Tcl_GetErrno();
bytesRead = -1;
break;
}
/*
* In the blocking case, wait until the file becomes readable or
|
| ︙ | ︙ | |||
992 993 994 995 996 997 998 |
CLEAR_BITS(statePtr->readyEvents, FD_WRITE);
if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) {
*errorCodePtr = EWOULDBLOCK;
written = -1;
break;
}
} else {
| | | 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 |
CLEAR_BITS(statePtr->readyEvents, FD_WRITE);
if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) {
*errorCodePtr = EWOULDBLOCK;
written = -1;
break;
}
} else {
Tcl_WinConvertError(error);
*errorCodePtr = Tcl_GetErrno();
written = -1;
break;
}
/*
* In the blocking case, wait until the file becomes writable or
|
| ︙ | ︙ | |||
1060 1061 1062 1063 1064 1065 1066 |
*/
while (statePtr->sockets != NULL) {
TcpFdList *thisfd = statePtr->sockets;
statePtr->sockets = thisfd->next;
if (closesocket(thisfd->fd) == SOCKET_ERROR) {
| | | 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 |
*/
while (statePtr->sockets != NULL) {
TcpFdList *thisfd = statePtr->sockets;
statePtr->sockets = thisfd->next;
if (closesocket(thisfd->fd) == SOCKET_ERROR) {
Tcl_WinConvertError((DWORD) WSAGetLastError());
errorCode = Tcl_GetErrno();
}
ckfree(thisfd);
}
}
if (statePtr->addrlist != NULL) {
|
| ︙ | ︙ | |||
1150 1151 1152 1153 1154 1155 1156 |
/*
* Single fd operation: Tcl_OpenTcpServer() does not set TCL_READABLE or
* TCL_WRITABLE so this should never be called for a server socket.
*/
if ((flags & TCL_CLOSE_READ) && (shutdown(statePtr->sockets->fd, SD_RECEIVE) == SOCKET_ERROR)) {
| | | | 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 |
/*
* Single fd operation: Tcl_OpenTcpServer() does not set TCL_READABLE or
* TCL_WRITABLE so this should never be called for a server socket.
*/
if ((flags & TCL_CLOSE_READ) && (shutdown(statePtr->sockets->fd, SD_RECEIVE) == SOCKET_ERROR)) {
Tcl_WinConvertError((DWORD) WSAGetLastError());
readError = Tcl_GetErrno();
}
if ((flags & TCL_CLOSE_WRITE) && (shutdown(statePtr->sockets->fd, SD_SEND) == SOCKET_ERROR)) {
Tcl_WinConvertError((DWORD) WSAGetLastError());
writeError = Tcl_GetErrno();
}
return (readError != 0) ? readError : writeError;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
1221 1222 1223 1224 1225 1226 1227 |
}
if (boolVar) {
val = TRUE;
}
rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE,
(const char *) &val, sizeof(BOOL));
if (rtn != 0) {
| | | 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 |
}
if (boolVar) {
val = TRUE;
}
rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE,
(const char *) &val, sizeof(BOOL));
if (rtn != 0) {
Tcl_WinConvertError(WSAGetLastError());
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't set socket option: %s",
Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
1243 1244 1245 1246 1247 1248 1249 |
}
if (!boolVar) {
val = TRUE;
}
rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY,
(const char *) &val, sizeof(BOOL));
if (rtn != 0) {
| | | 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 |
}
if (!boolVar) {
val = TRUE;
}
rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY,
(const char *) &val, sizeof(BOOL));
if (rtn != 0) {
Tcl_WinConvertError(WSAGetLastError());
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't set socket option: %s",
Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
1378 1379 1380 1381 1382 1383 1384 |
}
/*
* Return error message.
*/
if (err) {
| | | 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 |
}
/*
* Return error message.
*/
if (err) {
Tcl_WinConvertError(err);
Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()),
-1);
}
}
}
return TCL_OK;
}
|
| ︙ | ︙ | |||
1448 1449 1450 1451 1452 1453 1454 |
* getpeername failed - but if we were asked for all the options
* (len==0), don't flag an error at that point because it could be
* an fconfigure request on a server socket (such sockets have no
* peer). {Copied from unix/tclUnixChan.c}
*/
if (len) {
| | | 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 |
* getpeername failed - but if we were asked for all the options
* (len==0), don't flag an error at that point because it could be
* an fconfigure request on a server socket (such sockets have no
* peer). {Copied from unix/tclUnixChan.c}
*/
if (len) {
Tcl_WinConvertError((DWORD) WSAGetLastError());
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't get peername: %s",
Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
1524 1525 1526 1527 1528 1529 1530 |
if (found) {
if (len) {
return TCL_OK;
}
Tcl_DStringEndSublist(dsPtr);
} else {
if (interp) {
| | | 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 |
if (found) {
if (len) {
return TCL_OK;
}
Tcl_DStringEndSublist(dsPtr);
} else {
if (interp) {
Tcl_WinConvertError((DWORD) WSAGetLastError());
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't get sockname: %s", Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
}
|
| ︙ | ︙ | |||
1776 1777 1778 1779 1780 1781 1782 |
SetEvent(tsdPtr->socketListLock);
/*
* Continue on socket creation error.
*/
if (statePtr->sockets->fd == INVALID_SOCKET) {
| | | 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 |
SetEvent(tsdPtr->socketListLock);
/*
* Continue on socket creation error.
*/
if (statePtr->sockets->fd == INVALID_SOCKET) {
Tcl_WinConvertError((DWORD) WSAGetLastError());
continue;
}
/*
* Win-NT has a misfeature that sockets are inherited in child
* processes by default. Turn off the inherit bit.
*/
|
| ︙ | ︙ | |||
1801 1802 1803 1804 1805 1806 1807 |
/*
* Try to bind to a local port.
*/
if (bind(statePtr->sockets->fd, statePtr->myaddr->ai_addr,
statePtr->myaddr->ai_addrlen) == SOCKET_ERROR) {
| | | 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 |
/*
* Try to bind to a local port.
*/
if (bind(statePtr->sockets->fd, statePtr->myaddr->ai_addr,
statePtr->myaddr->ai_addrlen) == SOCKET_ERROR) {
Tcl_WinConvertError((DWORD) WSAGetLastError());
continue;
}
/*
* For asynchroneous connect set the socket in nonblocking mode
* and activate connect notification
*/
|
| ︙ | ︙ | |||
1872 1873 1874 1875 1876 1877 1878 | * Attempt to connect to the remote socket. */ connect(statePtr->sockets->fd, statePtr->addr->ai_addr, statePtr->addr->ai_addrlen); error = WSAGetLastError(); | | | 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 |
* Attempt to connect to the remote socket.
*/
connect(statePtr->sockets->fd, statePtr->addr->ai_addr,
statePtr->addr->ai_addrlen);
error = WSAGetLastError();
Tcl_WinConvertError(error);
if (async_connect && error == WSAEWOULDBLOCK) {
/*
* Asynchroneous connect
*
* Remember that we jump back behind this next round
*/
|
| ︙ | ︙ | |||
1904 1905 1906 1907 1908 1909 1910 |
WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
/*
* Get signaled connect error.
*/
| | | 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 |
WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
/*
* Get signaled connect error.
*/
Tcl_WinConvertError((DWORD) statePtr->notifierConnectError);
/*
* Clear eventual connect flag.
*/
CLEAR_BITS(statePtr->selectEvents, FD_CONNECT);
|
| ︙ | ︙ | |||
2233 2234 2235 2236 2237 2238 2239 |
goto error;
}
for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
sock = socket(addrPtr->ai_family, addrPtr->ai_socktype,
addrPtr->ai_protocol);
if (sock == INVALID_SOCKET) {
| | | 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 |
goto error;
}
for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
sock = socket(addrPtr->ai_family, addrPtr->ai_socktype,
addrPtr->ai_protocol);
if (sock == INVALID_SOCKET) {
Tcl_WinConvertError((DWORD) WSAGetLastError());
continue;
}
/*
* Win-NT has a misfeature that sockets are inherited in child
* processes by default. Turn off the inherit bit.
*/
|
| ︙ | ︙ | |||
2284 2285 2286 2287 2288 2289 2290 |
* Bind should not be affected by the socket having already been
* set into nonblocking mode. If there is trouble, this is one
* place to look for bugs.
*/
if (bind(sock, addrPtr->ai_addr,
addrPtr->ai_addrlen) == SOCKET_ERROR) {
| | | 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 |
* Bind should not be affected by the socket having already been
* set into nonblocking mode. If there is trouble, this is one
* place to look for bugs.
*/
if (bind(sock, addrPtr->ai_addr,
addrPtr->ai_addrlen) == SOCKET_ERROR) {
Tcl_WinConvertError((DWORD) WSAGetLastError());
closesocket(sock);
continue;
}
if (port == 0 && chosenport == 0) {
address sockname;
socklen_t namelen = sizeof(sockname);
|
| ︙ | ︙ | |||
2309 2310 2311 2312 2313 2314 2315 |
/*
* Set the maximum number of pending connect requests to the max
* value allowed on each platform (Win32 and Win32s may be
* different, and there may be differences between TCP/IP stacks).
*/
if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
| | | 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 |
/*
* Set the maximum number of pending connect requests to the max
* value allowed on each platform (Win32 and Win32s may be
* different, and there may be differences between TCP/IP stacks).
*/
if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
Tcl_WinConvertError((DWORD) WSAGetLastError());
closesocket(sock);
continue;
}
if (statePtr == NULL) {
/*
* Add this socket to the global list of sockets.
|
| ︙ | ︙ | |||
2494 2495 2496 2497 2498 2499 2500 |
windowClass.lpszMenuName = NULL;
windowClass.lpszClassName = className;
windowClass.lpfnWndProc = SocketProc;
windowClass.hIcon = NULL;
windowClass.hCursor = NULL;
if (!RegisterClassW(&windowClass)) {
| | | 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 |
windowClass.lpszMenuName = NULL;
windowClass.lpszClassName = className;
windowClass.lpfnWndProc = SocketProc;
windowClass.hIcon = NULL;
windowClass.hCursor = NULL;
if (!RegisterClassW(&windowClass)) {
Tcl_WinConvertError(GetLastError());
goto initFailure;
}
}
/*
* Check for per-thread initialization.
*/
|
| ︙ | ︙ |
Changes to win/tclWinTest.c.
| ︙ | ︙ | |||
204 205 206 207 208 209 210 |
}
found = GetVolumeInformationA(path, NULL, 0, NULL, NULL, NULL, volType,
VOL_BUF_SIZE);
if (found == 0) {
Tcl_AppendResult(interp, "could not get volume type for \"",
(path?path:""), "\"", NULL);
| | | 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 |
}
found = GetVolumeInformationA(path, NULL, 0, NULL, NULL, NULL, volType,
VOL_BUF_SIZE);
if (found == 0) {
Tcl_AppendResult(interp, "could not get volume type for \"",
(path?path:""), "\"", NULL);
Tcl_WinConvertError(GetLastError());
return TCL_ERROR;
}
Tcl_AppendResult(interp, volType, NULL);
return TCL_OK;
#undef VOL_BUF_SIZE
}
|
| ︙ | ︙ |
Changes to win/tclWinTime.c.
| ︙ | ︙ | |||
49 50 51 52 53 54 55 |
typedef struct {
CRITICAL_SECTION cs; /* Mutex guarding this structure. */
int initialized; /* Flag == 1 if this structure is
* initialized. */
int perfCounterAvailable; /* Flag == 1 if the hardware has a performance
* counter. */
| | > | 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 |
typedef struct {
CRITICAL_SECTION cs; /* Mutex guarding this structure. */
int initialized; /* Flag == 1 if this structure is
* initialized. */
int perfCounterAvailable; /* Flag == 1 if the hardware has a performance
* counter. */
DWORD calibrationInterv; /* Calibration interval in seconds (start 1
* sec) */
HANDLE calibrationThread; /* Handle to the thread that keeps the virtual
* clock calibrated. */
HANDLE readyEvent; /* System event used to trigger the requesting
* thread when the clock calibration procedure
* is initialized for the first time. */
HANDLE exitEvent; /* Event to signal out of an exit handler to
* tell the calibration loop to terminate. */
|
| ︙ | ︙ | |||
118 119 120 121 122 123 124 |
/*
* Scale to convert wide click values from the TclpGetWideClicks native
* resolution to microsecond resolution and back.
*/
static struct {
int initialized; /* 1 if initialized, 0 otherwise */
| | > | 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 |
/*
* Scale to convert wide click values from the TclpGetWideClicks native
* resolution to microsecond resolution and back.
*/
static struct {
int initialized; /* 1 if initialized, 0 otherwise */
int perfCounter; /* 1 if performance counter usable for wide
* clicks */
double microsecsScale; /* Denominator scale between clock / microsecs */
} wideClick = {0, 0, 0.0};
/*
* Declarations for functions defined later in this file.
*/
|
| ︙ | ︙ | |||
150 151 152 153 154 155 156 157 158 159 160 161 162 163 | /* * TIP #233 (Virtualized Time): Data for the time hooks, if any. */ Tcl_GetTimeProc *tclGetTimeProcPtr = NativeGetTime; Tcl_ScaleTimeProc *tclScaleTimeProcPtr = NativeScaleTime; ClientData tclTimeClientData = NULL; /* *---------------------------------------------------------------------- * * TclpGetSeconds -- * * This procedure returns the number of seconds from the epoch. On most | > > > > > > > > > > > > > > > > > | 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 |
/*
* TIP #233 (Virtualized Time): Data for the time hooks, if any.
*/
Tcl_GetTimeProc *tclGetTimeProcPtr = NativeGetTime;
Tcl_ScaleTimeProc *tclScaleTimeProcPtr = NativeScaleTime;
ClientData tclTimeClientData = NULL;
/*
* Inlined version of Tcl_GetTime.
*/
static inline void
GetTime(
Tcl_Time *timePtr)
{
tclGetTimeProcPtr(timePtr, tclTimeClientData);
}
static inline int
IsTimeNative(void)
{
return tclGetTimeProcPtr == NativeGetTime;
}
/*
*----------------------------------------------------------------------
*
* TclpGetSeconds --
*
* This procedure returns the number of seconds from the epoch. On most
|
| ︙ | ︙ | |||
173 174 175 176 177 178 179 |
*/
unsigned long
TclpGetSeconds(void)
{
long long usecSincePosixEpoch;
| > | > | | < | | 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 |
*/
unsigned long
TclpGetSeconds(void)
{
long long usecSincePosixEpoch;
/*
* Try to use high resolution timer
*/
if (IsTimeNative() && (usecSincePosixEpoch = NativeGetMicroseconds())) {
return usecSincePosixEpoch / 1000000;
} else {
Tcl_Time t;
GetTime(&t);
return t.sec;
}
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
210 211 212 213 214 215 216 |
*/
unsigned long
TclpGetClicks(void)
{
long long usecSincePosixEpoch;
| > | > | | < | | | | 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 |
*/
unsigned long
TclpGetClicks(void)
{
long long usecSincePosixEpoch;
/*
* Try to use high resolution timer.
*/
if (IsTimeNative() && (usecSincePosixEpoch = NativeGetMicroseconds())) {
return (unsigned long) usecSincePosixEpoch;
} else {
/*
* Use the Tcl_GetTime abstraction to get the time in microseconds, as
* nearly as we can, and return it.
*/
Tcl_Time now; /* Current Tcl time */
GetTime(&now);
return ((unsigned long)(now.sec)*1000000UL) + (unsigned long)(now.usec);
}
}
/*
*----------------------------------------------------------------------
*
* TclpGetWideClicks --
|
| ︙ | ︙ | |||
260 261 262 263 264 265 266 267 268 269 270 271 272 273 |
LARGE_INTEGER perfCounterFreq;
/*
* The frequency of the performance counter is fixed at system boot and
* is consistent across all processors. Therefore, the frequency need
* only be queried upon application initialization.
*/
if (QueryPerformanceFrequency(&perfCounterFreq)) {
wideClick.perfCounter = 1;
wideClick.microsecsScale = 1000000.0 / perfCounterFreq.QuadPart;
} else {
/* fallback using microseconds */
wideClick.perfCounter = 0;
wideClick.microsecsScale = 1;
| > | 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 |
LARGE_INTEGER perfCounterFreq;
/*
* The frequency of the performance counter is fixed at system boot and
* is consistent across all processors. Therefore, the frequency need
* only be queried upon application initialization.
*/
if (QueryPerformanceFrequency(&perfCounterFreq)) {
wideClick.perfCounter = 1;
wideClick.microsecsScale = 1000000.0 / perfCounterFreq.QuadPart;
} else {
/* fallback using microseconds */
wideClick.perfCounter = 0;
wideClick.microsecsScale = 1;
|
| ︙ | ︙ | |||
306 307 308 309 310 311 312 |
*----------------------------------------------------------------------
*/
double
TclpWideClickInMicrosec(void)
{
if (!wideClick.initialized) {
| | | 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 |
*----------------------------------------------------------------------
*/
double
TclpWideClickInMicrosec(void)
{
if (!wideClick.initialized) {
(void) TclpGetWideClicks(); /* initialize */
}
return wideClick.microsecsScale;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
333 334 335 336 337 338 339 |
*/
long long
TclpGetMicroseconds(void)
{
long long usecSincePosixEpoch;
| > | > | | < | | | | | | 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 |
*/
long long
TclpGetMicroseconds(void)
{
long long usecSincePosixEpoch;
/*
* Try to use high resolution timer.
*/
if (IsTimeNative() && (usecSincePosixEpoch = NativeGetMicroseconds())) {
return usecSincePosixEpoch;
} else {
/*
* Use the Tcl_GetTime abstraction to get the time in microseconds, as
* nearly as we can, and return it.
*/
Tcl_Time now;
GetTime(&now);
return (((long long) now.sec) * 1000000) + now.usec;
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetTime --
|
| ︙ | ︙ | |||
379 380 381 382 383 384 385 |
void
Tcl_GetTime(
Tcl_Time *timePtr) /* Location to store time information. */
{
long long usecSincePosixEpoch;
| > | > | | < | | 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 |
void
Tcl_GetTime(
Tcl_Time *timePtr) /* Location to store time information. */
{
long long usecSincePosixEpoch;
/*
* Try to use high resolution timer.
*/
if (IsTimeNative() && (usecSincePosixEpoch = NativeGetMicroseconds())) {
timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
} else {
GetTime(timePtr);
}
}
/*
*----------------------------------------------------------------------
*
* NativeScaleTime --
|
| ︙ | ︙ | |||
420 421 422 423 424 425 426 427 428 429 430 431 432 433 |
* Native scale is 1:1. Nothing is done.
*/
}
/*
*----------------------------------------------------------------------
*
* NativeGetMicroseconds --
*
* Gets the current system time in microseconds since the beginning
* of the epoch: 00:00 UCT, January 1, 1970.
*
* Results:
* Returns the wide integer with number of microseconds from the epoch, or
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
* Native scale is 1:1. Nothing is done.
*/
}
/*
*----------------------------------------------------------------------
*
* IsPerfCounterAvailable --
*
* Tests whether the performance counter is available, which is a gnarly
* problem on 32-bit systems. Also retrieves the nominal frequency of the
* performance counter.
*
* Results:
* 1 if the counter is available, 0 if not.
*
* Side effects:
* Updates fields of the timeInfo global. Make sure you hold the lock
* before calling this.
*
*----------------------------------------------------------------------
*/
static inline int
IsPerfCounterAvailable(void)
{
timeInfo.perfCounterAvailable =
QueryPerformanceFrequency(&timeInfo.nominalFreq);
/*
* Some hardware abstraction layers use the CPU clock in place of the
* real-time clock as a performance counter reference. This results in:
* - inconsistent results among the processors on multi-processor
* systems.
* - unpredictable changes in performance counter frequency on
* "gearshift" processors such as Transmeta and SpeedStep.
*
* There seems to be no way to test whether the performance counter is
* reliable, but a useful heuristic is that if its frequency is 1.193182
* MHz or 3.579545 MHz, it's derived from a colorburst crystal and is
* therefore the RTC rather than the TSC.
*
* A sloppier but serviceable heuristic is that the RTC crystal is
* normally less than 15 MHz while the TSC crystal is virtually assured to
* be greater than 100 MHz. Since Win98SE appears to fiddle with the
* definition of the perf counter frequency (perhaps in an attempt to
* calibrate the clock?), we use the latter rule rather than an exact
* match.
*
* We also assume (perhaps questionably) that the vendors have gotten
* their act together on Win64, so bypass all this rubbish on that
* platform.
*/
#if !defined(_WIN64)
if (timeInfo.perfCounterAvailable &&
/*
* The following lines would do an exact match on crystal
* frequency:
*
* timeInfo.nominalFreq.QuadPart != (long long) 1193182 &&
* timeInfo.nominalFreq.QuadPart != (long long) 3579545 &&
*/
timeInfo.nominalFreq.QuadPart > (long long) 15000000) {
/*
* As an exception, if every logical processor on the system is on the
* same chip, we use the performance counter anyway, presuming that
* everyone's TSC is locked to the same oscillator.
*/
SYSTEM_INFO systemInfo;
int regs[4];
GetSystemInfo(&systemInfo);
if (TclWinCPUID(0, regs) == TCL_OK
&& regs[1] == 0x756E6547 /* "Genu" */
&& regs[3] == 0x49656E69 /* "ineI" */
&& regs[2] == 0x6C65746E /* "ntel" */
&& TclWinCPUID(1, regs) == TCL_OK
&& ((regs[0]&0x00000F00) == 0x00000F00 /* Pentium 4 */
|| ((regs[0] & 0x00F00000) /* Extended family */
&& (regs[3] & 0x10000000))) /* Hyperthread */
&& (((regs[1]&0x00FF0000) >> 16)/* CPU count */
== (int)systemInfo.dwNumberOfProcessors)) {
timeInfo.perfCounterAvailable = TRUE;
} else {
timeInfo.perfCounterAvailable = FALSE;
}
}
#endif /* above code is Win32 only */
return timeInfo.perfCounterAvailable;
}
/*
*----------------------------------------------------------------------
*
* NativeGetMicroseconds --
*
* Gets the current system time in microseconds since the beginning
* of the epoch: 00:00 UCT, January 1, 1970.
*
* Results:
* Returns the wide integer with number of microseconds from the epoch, or
|
| ︙ | ︙ | |||
445 446 447 448 449 450 451 |
*/
static inline long long
NativeCalc100NsTicks(
ULONGLONG fileTimeLastCall,
LONGLONG perfCounterLastCall,
LONGLONG curCounterFreq,
| | < > | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | 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 |
*/
static inline long long
NativeCalc100NsTicks(
ULONGLONG fileTimeLastCall,
LONGLONG perfCounterLastCall,
LONGLONG curCounterFreq,
LONGLONG curCounter)
{
return fileTimeLastCall +
((curCounter - perfCounterLastCall) * 10000000 / curCounterFreq);
}
static long long
NativeGetMicroseconds(void)
{
/*
* Initialize static storage on the first trip through.
*
* Note: Outer check for 'initialized' is a performance win since it
* avoids an extra mutex lock in the common case.
*/
if (!timeInfo.initialized) {
TclpInitLock();
if (!timeInfo.initialized) {
timeInfo.posixEpoch.LowPart = 0xD53E8000;
timeInfo.posixEpoch.HighPart = 0x019DB1DE;
/*
* If the performance counter is available, start a thread to
* calibrate it.
*/
if (IsPerfCounterAvailable()) {
DWORD id;
InitializeCriticalSection(&timeInfo.cs);
timeInfo.readyEvent = CreateEventW(NULL, FALSE, FALSE, NULL);
timeInfo.exitEvent = CreateEventW(NULL, FALSE, FALSE, NULL);
timeInfo.calibrationThread = CreateThread(NULL, 256,
CalibrationThread, (LPVOID) NULL, 0, &id);
|
| ︙ | ︙ | |||
574 575 576 577 578 579 580 | /* * Query the performance counter and use it to calculate the current * time. */ ULONGLONG fileTimeLastCall; LONGLONG perfCounterLastCall, curCounterFreq; | | > > > > | > > | < > | > > | > | 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 |
/*
* Query the performance counter and use it to calculate the current
* time.
*/
ULONGLONG fileTimeLastCall;
LONGLONG perfCounterLastCall, curCounterFreq;
/* Copy with current data of calibration
* cycle. */
LARGE_INTEGER curCounter;
/* Current performance counter. */
QueryPerformanceCounter(&curCounter);
/*
* Hold time section locked as short as possible
*/
EnterCriticalSection(&timeInfo.cs);
fileTimeLastCall = timeInfo.fileTimeLastCall.QuadPart;
perfCounterLastCall = timeInfo.perfCounterLastCall.QuadPart;
curCounterFreq = timeInfo.curCounterFreq.QuadPart;
LeaveCriticalSection(&timeInfo.cs);
/*
* If calibration cycle occurred after we get curCounter
*/
if (curCounter.QuadPart <= perfCounterLastCall) {
/*
* Calibrated file-time is saved from posix in 100-ns ticks
*/
return fileTimeLastCall / 10;
}
/*
* If it appears to be more than 1.1 seconds since the last trip
* through the calibration loop, the performance counter may have
* jumped forward. (See MSDN Knowledge Base article Q274323 for a
* description of the hardware problem that makes this test
* necessary.) If the counter jumps, we don't want to use it directly.
* Instead, we must return system time. Eventually, the calibration
* loop should recover.
*/
if (curCounter.QuadPart - perfCounterLastCall <
11 * curCounterFreq * timeInfo.calibrationInterv / 10) {
/*
* Calibrated file-time is saved from posix in 100-ns ticks.
*/
return NativeCalc100NsTicks(fileTimeLastCall,
perfCounterLastCall, curCounterFreq,
curCounter.QuadPart) / 10;
}
}
/*
* High resolution timer is not available.
*/
return 0;
|
| ︙ | ︙ | |||
652 653 654 655 656 657 658 |
TCL_UNUSED(ClientData))
{
long long usecSincePosixEpoch;
/*
* Try to use high resolution timer.
*/
| > | > | | | | 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 |
TCL_UNUSED(ClientData))
{
long long usecSincePosixEpoch;
/*
* Try to use high resolution timer.
*/
usecSincePosixEpoch = NativeGetMicroseconds();
if (usecSincePosixEpoch) {
timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
} else {
/*
* High resolution timer is not available. Just use ftime.
*/
struct _timeb t;
_ftime(&t);
timePtr->sec = (long) t.time;
timePtr->usec = t.millitm * 1000;
}
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
731 732 733 734 735 736 737 |
TclpGetDate(
const time_t *t,
int useGMT)
{
struct tm *tmPtr;
time_t time;
#if defined(_WIN64) || (defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400))
| | | | 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 |
TclpGetDate(
const time_t *t,
int useGMT)
{
struct tm *tmPtr;
time_t time;
#if defined(_WIN64) || (defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400))
# define t2 *t /* no need to cripple time to 32-bit */
#else
time_t t2 = *(__time32_t *) t;
#endif
if (!useGMT) {
#if defined(_MSC_VER) && (_MSC_VER >= 1900)
# undef timezone /* prevent conflict with timezone() function */
long timezone = 0;
#endif
|
| ︙ | ︙ | |||
785 786 787 788 789 790 791 |
time = tmPtr->tm_sec - timezone;
tmPtr->tm_sec = (int)(time % 60);
if (tmPtr->tm_sec < 0) {
tmPtr->tm_sec += 60;
time -= 60;
}
| | | | | | | 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 |
time = tmPtr->tm_sec - timezone;
tmPtr->tm_sec = (int)(time % 60);
if (tmPtr->tm_sec < 0) {
tmPtr->tm_sec += 60;
time -= 60;
}
time = tmPtr->tm_min + time / 60;
tmPtr->tm_min = (int)(time % 60);
if (tmPtr->tm_min < 0) {
tmPtr->tm_min += 60;
time -= 60;
}
time = tmPtr->tm_hour + time / 60;
tmPtr->tm_hour = (int)(time % 24);
if (tmPtr->tm_hour < 0) {
tmPtr->tm_hour += 24;
time -= 24;
}
time /= 24;
tmPtr->tm_mday += (int) time;
tmPtr->tm_yday += (int) time;
tmPtr->tm_wday = (tmPtr->tm_wday + (int) time) % 7;
}
} else {
tmPtr = ComputeGMT(&t2);
}
return tmPtr;
}
|
| ︙ | ︙ | |||
843 844 845 846 847 848 849 |
tmPtr = &tsdPtr->tm;
/*
* Compute the 4 year span containing the specified time.
*/
| | | | 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 |
tmPtr = &tsdPtr->tm;
/*
* Compute the 4 year span containing the specified time.
*/
tmp = (long) (*tp / SECSPER4YEAR);
rem = (long) (*tp % SECSPER4YEAR);
/*
* Correct for weird mod semantics so the remainder is always positive.
*/
if (rem < 0) {
tmp--;
|
| ︙ | ︙ | |||
911 912 913 914 915 916 917 |
tmPtr->tm_mon = --tmp;
tmPtr->tm_mday = tmPtr->tm_yday - days[tmp];
/*
* Compute day of week. Epoch started on a Thursday.
*/
| | | 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 |
tmPtr->tm_mon = --tmp;
tmPtr->tm_mday = tmPtr->tm_yday - days[tmp];
/*
* Compute day of week. Epoch started on a Thursday.
*/
tmPtr->tm_wday = (long) (*tp / SECSPERDAY) + 4;
if ((*tp % SECSPERDAY) < 0) {
tmPtr->tm_wday--;
}
tmPtr->tm_wday %= 7;
if (tmPtr->tm_wday < 0) {
tmPtr->tm_wday += 7;
}
|
| ︙ | ︙ | |||
966 967 968 969 970 971 972 |
*/
GetSystemTimeAsFileTime(&curFileTime);
QueryPerformanceCounter(&timeInfo.perfCounterLastCall);
QueryPerformanceFrequency(&timeInfo.curCounterFreq);
timeInfo.fileTimeLastCall.LowPart = curFileTime.dwLowDateTime;
timeInfo.fileTimeLastCall.HighPart = curFileTime.dwHighDateTime;
| > > | > > | 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 |
*/
GetSystemTimeAsFileTime(&curFileTime);
QueryPerformanceCounter(&timeInfo.perfCounterLastCall);
QueryPerformanceFrequency(&timeInfo.curCounterFreq);
timeInfo.fileTimeLastCall.LowPart = curFileTime.dwLowDateTime;
timeInfo.fileTimeLastCall.HighPart = curFileTime.dwHighDateTime;
/*
* Calibrated file-time will be saved from posix in 100-ns ticks.
*/
timeInfo.fileTimeLastCall.QuadPart -= timeInfo.posixEpoch.QuadPart;
ResetCounterSamples(timeInfo.fileTimeLastCall.QuadPart,
timeInfo.perfCounterLastCall.QuadPart,
timeInfo.curCounterFreq.QuadPart);
/*
|
| ︙ | ︙ | |||
1026 1027 1028 1029 1030 1031 1032 |
static void
UpdateTimeEachSecond(void)
{
LARGE_INTEGER curPerfCounter;
/* Current value returned from
* QueryPerformanceCounter. */
FILETIME curSysTime; /* Current system time. */
| | > | > > | > | | | < > | > > | 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 |
static void
UpdateTimeEachSecond(void)
{
LARGE_INTEGER curPerfCounter;
/* Current value returned from
* QueryPerformanceCounter. */
FILETIME curSysTime; /* Current system time. */
static LARGE_INTEGER lastFileTime;
/* File time of the previous calibration */
LARGE_INTEGER curFileTime; /* File time at the time this callback was
* scheduled. */
long long estFreq; /* Estimated perf counter frequency. */
long long vt0; /* Tcl time right now. */
long long vt1; /* Tcl time one second from now. */
long long tdiff; /* Difference between system clock and Tcl
* time. */
long long driftFreq; /* Frequency needed to drift virtual time into
* step over 1 second. */
/*
* Sample performance counter and system time (from posix epoch).
*/
GetSystemTimeAsFileTime(&curSysTime);
curFileTime.LowPart = curSysTime.dwLowDateTime;
curFileTime.HighPart = curSysTime.dwHighDateTime;
curFileTime.QuadPart -= timeInfo.posixEpoch.QuadPart;
/*
* If calibration still not needed (check for possible time switch)
*/
if (curFileTime.QuadPart > lastFileTime.QuadPart && curFileTime.QuadPart <
lastFileTime.QuadPart + (timeInfo.calibrationInterv * 10000000)) {
/*
* Look again in next one second.
*/
return;
}
QueryPerformanceCounter(&curPerfCounter);
lastFileTime.QuadPart = curFileTime.QuadPart;
/*
|
| ︙ | ︙ | |||
1106 1107 1108 1109 1110 1111 1112 |
* vt1 = 20000000 + curFileTime
*
* The frequency that we need to use to drift the counter back into place
* is estFreq * 20000000 / (vt1 - vt0)
*/
vt0 = NativeCalc100NsTicks(timeInfo.fileTimeLastCall.QuadPart,
| | | > > | > > > | > > > | | | > > | > > | > > | | | | | | | > > | | | | > | > | > > > > | > > > > | > > > | > > > | > > > | > > | 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 |
* vt1 = 20000000 + curFileTime
*
* The frequency that we need to use to drift the counter back into place
* is estFreq * 20000000 / (vt1 - vt0)
*/
vt0 = NativeCalc100NsTicks(timeInfo.fileTimeLastCall.QuadPart,
timeInfo.perfCounterLastCall.QuadPart,
timeInfo.curCounterFreq.QuadPart, curPerfCounter.QuadPart);
/*
* If we've gotten more than a second away from system time, then drifting
* the clock is going to be pretty hopeless. Just let it jump. Otherwise,
* compute the drift frequency and fill in everything.
*/
tdiff = vt0 - curFileTime.QuadPart;
if (tdiff > 10000000 || tdiff < -10000000) {
/*
* Jump to current system time, use curent estimated frequency.
*/
vt0 = curFileTime.QuadPart;
} else {
/*
* Calculate new frequency and estimate drift to the next second.
*/
vt1 = 20000000 + curFileTime.QuadPart;
driftFreq = (estFreq * 20000000 / (vt1 - vt0));
/*
* Avoid too large drifts (only half of the current difference), that
* allows also be more accurate (aspire to the smallest tdiff), so
* then we can prolong calibration interval by tdiff < 100000
*/
driftFreq = timeInfo.curCounterFreq.QuadPart +
(driftFreq - timeInfo.curCounterFreq.QuadPart) / 2;
/*
* Average between estimated, 2 current and 5 drifted frequencies,
* (do the soft drifting as possible)
*/
estFreq = (estFreq + 2 * timeInfo.curCounterFreq.QuadPart +
5 * driftFreq) / 8;
}
/*
* Avoid too large discrepancy from nominal frequency.
*/
if (estFreq > 1003 * timeInfo.nominalFreq.QuadPart / 1000) {
estFreq = 1003 * timeInfo.nominalFreq.QuadPart / 1000;
vt0 = curFileTime.QuadPart;
} else if (estFreq < 997 * timeInfo.nominalFreq.QuadPart / 1000) {
estFreq = 997 * timeInfo.nominalFreq.QuadPart / 1000;
vt0 = curFileTime.QuadPart;
} else if (vt0 != curFileTime.QuadPart) {
/*
* Be sure the clock ticks never backwards (avoid it by negative
* drifting). Just compare native time (in 100-ns) before and
* hereafter using new calibrated values) and do a small adjustment
* (short time freeze).
*/
LARGE_INTEGER newPerfCounter;
long long nt0, nt1;
QueryPerformanceCounter(&newPerfCounter);
nt0 = NativeCalc100NsTicks(timeInfo.fileTimeLastCall.QuadPart,
timeInfo.perfCounterLastCall.QuadPart,
timeInfo.curCounterFreq.QuadPart, newPerfCounter.QuadPart);
nt1 = NativeCalc100NsTicks(vt0,
curPerfCounter.QuadPart, estFreq, newPerfCounter.QuadPart);
if (nt0 > nt1) {
/*
* Drifted backwards, try to compensate with new base.
*
* First adjust with a micro jump (short frozen time is
* acceptable).
*/
vt0 += nt0 - nt1;
/*
* If drift unavoidable (e. g. we had a time switch), then reset
* it.
*/
vt1 = vt0 - curFileTime.QuadPart;
if (vt1 > 10000000 || vt1 < -10000000) {
/*
* Larger jump resp. shift relative new file-time.
*/
vt0 = curFileTime.QuadPart;
}
}
}
/*
* In lock commit new values to timeInfo (hold lock as short as possible)
*/
EnterCriticalSection(&timeInfo.cs);
/*
* Grow calibration interval up to 10 seconds (if still precise enough)
*/
if (tdiff < -100000 || tdiff > 100000) {
/*
* Too long drift. Reset calibration interval to 1000 second.
*/
timeInfo.calibrationInterv = 1;
} else if (timeInfo.calibrationInterv < 10) {
timeInfo.calibrationInterv++;
}
timeInfo.fileTimeLastCall.QuadPart = vt0;
timeInfo.curCounterFreq.QuadPart = estFreq;
|
| ︙ | ︙ | |||
1211 1212 1213 1214 1215 1216 1217 | * given frequency. * *---------------------------------------------------------------------- */ static void ResetCounterSamples( | | | | > | 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 |
* given frequency.
*
*----------------------------------------------------------------------
*/
static void
ResetCounterSamples(
unsigned long long fileTime,/* Current file time */
long long perfCounter, /* Current performance counter */
long long perfFreq) /* Target performance frequency */
{
int i;
for (i = SAMPLES - 1 ; i >= 0 ; --i) {
timeInfo.perfCounterSample[i] = perfCounter;
timeInfo.fileTimeSample[i] = fileTime;
perfCounter -= perfFreq;
fileTime -= 10000000;
}
timeInfo.sampleNo = 0;
}
|
| ︙ | ︙ | |||
1256 1257 1258 1259 1260 1261 1262 |
*/
static long long
AccumulateSample(
long long perfCounter,
unsigned long long fileTime)
{
| | > | > | | 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 |
*/
static long long
AccumulateSample(
long long perfCounter,
unsigned long long fileTime)
{
unsigned long long workFTSample;
/* File time sample being removed from or
* added to the circular buffer. */
long long workPCSample; /* Performance counter sample being removed
* from or added to the circular buffer. */
unsigned long long lastFTSample;
/* Last file time sample recorded */
long long lastPCSample; /* Last performance counter sample recorded */
long long FTdiff; /* Difference between last FT and current */
long long PCdiff; /* Difference between last PC and current */
long long estFreq; /* Estimated performance counter frequency */
/*
* Test for jumps and reset the samples if we have one.
*/
if (timeInfo.sampleNo == 0) {
lastPCSample =
|
| ︙ | ︙ | |||
1343 1344 1345 1346 1347 1348 1349 |
* time in a block of thread-local storage, and Windows does not provide a
* Posix gmtime_r function.
*/
#if defined(_WIN64) || defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400)
return gmtime(timePtr);
#else
| | | | 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 |
* time in a block of thread-local storage, and Windows does not provide a
* Posix gmtime_r function.
*/
#if defined(_WIN64) || defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400)
return gmtime(timePtr);
#else
return _gmtime32((const __time32_t *) timePtr);
#endif /* _WIN64 || _USE_64BIT_TIME_T || _MSC_VER < 1400 */
}
/*
*----------------------------------------------------------------------
*
* TclpLocaltime --
*
|
| ︙ | ︙ | |||
1378 1379 1380 1381 1382 1383 1384 |
* the time in a block of thread-local storage, and Windows does not
* provide a Posix localtime_r function.
*/
#if defined(_WIN64) || defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400)
return localtime(timePtr);
#else
| | | | 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 |
* the time in a block of thread-local storage, and Windows does not
* provide a Posix localtime_r function.
*/
#if defined(_WIN64) || defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400)
return localtime(timePtr);
#else
return _localtime32((const __time32_t *) timePtr);
#endif /* _WIN64 || _USE_64BIT_TIME_T || _MSC_VER < 1400 */
}
#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
*
* Tcl_SetTimeProc --
|
| ︙ | ︙ |
Changes to win/tclsh.exe.manifest.in.
| ︙ | ︙ | |||
31 32 33 34 35 36 37 38 39 40 41 42 43 44 |
</application>
</compatibility>
<asmv3:application>
<asmv3:windowsSettings
xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">
<dpiAware>true</dpiAware>
</asmv3:windowsSettings>
</asmv3:application>
<dependency>
<dependentAssembly>
<assemblyIdentity
type="win32"
name="Microsoft.Windows.Common-Controls"
version="6.0.0.0"
| > > > > | 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 |
</application>
</compatibility>
<asmv3:application>
<asmv3:windowsSettings
xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">
<dpiAware>true</dpiAware>
</asmv3:windowsSettings>
<asmv3:windowsSettings
xmlns="http://schemas.microsoft.com/SMI/2019/WindowsSettings">
<activeCodePage>UTF-8</activeCodePage>
</asmv3:windowsSettings>
</asmv3:application>
<dependency>
<dependentAssembly>
<assemblyIdentity
type="win32"
name="Microsoft.Windows.Common-Controls"
version="6.0.0.0"
|
| ︙ | ︙ |
Added win/x86_64-w64-mingw32-nmakehlp.exe.
cannot compute difference between binary files